diff --git a/.bzrignore b/.bzrignore index 727d65d1..2085d00c 100644 --- a/.bzrignore +++ b/.bzrignore @@ -1,4 +1,6 @@ config/NaturalDocs/Data docs/dev/* docs/user/html +docs/test-coverage/db +docs/test-coverage/html .DS_Store diff --git a/bin/pt-align b/bin/pt-align index 31be7718..d64a8e97 100755 --- a/bin/pt-align +++ b/bin/pt-align @@ -75,7 +75,7 @@ how wide each column should be, and then prints them out. This is useful for things like aligning the output of vmstat or iostat so it is easier to read. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-archiver b/bin/pt-archiver index 3cf890ad..ba627245 100755 --- a/bin/pt-archiver +++ b/bin/pt-archiver @@ -5536,7 +5536,7 @@ A sample module might look like this: 1; -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-checksum-filter b/bin/pt-checksum-filter index 09eff749..8ed6e01b 100755 --- a/bin/pt-checksum-filter +++ b/bin/pt-checksum-filter @@ -1301,7 +1301,7 @@ Show version and exit. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-collect b/bin/pt-collect index 1b080b84..6f145518 100755 --- a/bin/pt-collect +++ b/bin/pt-collect @@ -298,7 +298,7 @@ Usage: pt-collect [OPTION...] pt-collect focuses on gathering diagnostic data during a MySQL performance problem. It is typically executed by C. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-config-diff b/bin/pt-config-diff index 7265b1c5..08ca2414 100755 --- a/bin/pt-config-diff +++ b/bin/pt-config-diff @@ -3162,7 +3162,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-deadlock-logger b/bin/pt-deadlock-logger index 33528716..541f3eeb 100755 --- a/bin/pt-deadlock-logger +++ b/bin/pt-deadlock-logger @@ -2641,7 +2641,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-diskstats b/bin/pt-diskstats index 427127d8..02103661 100755 --- a/bin/pt-diskstats +++ b/bin/pt-diskstats @@ -656,7 +656,7 @@ The file read should look like this: ... et cetera TS <-- must end with a TS line. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-duplicate-key-checker b/bin/pt-duplicate-key-checker index 1955e886..19eccc8c 100755 --- a/bin/pt-duplicate-key-checker +++ b/bin/pt-duplicate-key-checker @@ -4175,7 +4175,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-fifo-split b/bin/pt-fifo-split index 4d5621fe..66ff5b45 100755 --- a/bin/pt-fifo-split +++ b/bin/pt-fifo-split @@ -1448,7 +1448,7 @@ Show version and exit. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-find b/bin/pt-find index 9b403b5d..928c8a67 100755 --- a/bin/pt-find +++ b/bin/pt-find @@ -3723,7 +3723,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-fk-error-logger b/bin/pt-fk-error-logger index bb885859..90b803d8 100755 --- a/bin/pt-fk-error-logger +++ b/bin/pt-fk-error-logger @@ -2361,7 +2361,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-heartbeat b/bin/pt-heartbeat index bced8d73..67c92322 100755 --- a/bin/pt-heartbeat +++ b/bin/pt-heartbeat @@ -4206,7 +4206,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-index-usage b/bin/pt-index-usage index 8d6defe9..c82397b2 100755 --- a/bin/pt-index-usage +++ b/bin/pt-index-usage @@ -6091,7 +6091,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-kill b/bin/pt-kill index 5aeb2abb..d0c53dec 100755 --- a/bin/pt-kill +++ b/bin/pt-kill @@ -4106,12 +4106,6 @@ short form: -P; type: int Port number to use for connection. -=item --[no]strip-comments - -default: yes - -Remove SQL comments from queries in the Info column of the PROCESSLIST. - =item --run-time type: time @@ -4152,6 +4146,12 @@ Causes pt-kill to create the sentinel file specified by L<"--sentinel"> and exit. This should have the effect of stopping all running instances which are watching the same sentinel file. +=item --[no]strip-comments + +default: yes + +Remove SQL comments from queries in the Info column of the PROCESSLIST. + =item --user short form: -u; type: string @@ -4226,23 +4226,6 @@ See also L<"GROUP, MATCH AND KILL">. =over -=item --match-all - -group: Query Matches - -Match all queries that are not ignored. If no ignore options are specified, -then every query matches (except replication threads, unless -L<"--replication-threads"> is also specified). This option allows you to -specify negative matches, i.e. "match every query I..." where the -exceptions are defined by specifying various C<--ignore> options. - -This option is I the same as L<"--victims"> C. This option matches -all queries within a class, whereas L<"--victims"> C specifies that all -matching queries in a class (however they matched) will be killed. Normally, -however, the two are used together because if, for example, you specify -L<"--victims"> C, then although all queries may match, only the oldest -will be killed. - =item --busy-time type: time; group: Query Matches @@ -4314,6 +4297,23 @@ Ignore queries whose user matches this Perl regex. See L<"--match-user">. +=item --match-all + +group: Query Matches + +Match all queries that are not ignored. If no ignore options are specified, +then every query matches (except replication threads, unless +L<"--replication-threads"> is also specified). This option allows you to +specify negative matches, i.e. "match every query I..." where the +exceptions are defined by specifying various C<--ignore> options. + +This option is I the same as L<"--victims"> C. This option matches +all queries within a class, whereas L<"--victims"> C specifies that all +matching queries in a class (however they matched) will be killed. Normally, +however, the two are used together because if, for example, you specify +L<"--victims"> C, then although all queries may match, only the oldest +will be killed. + =item --match-command type: string; group: Query Matches @@ -4581,7 +4581,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-log-player b/bin/pt-log-player index bf032808..4fda3680 100755 --- a/bin/pt-log-player +++ b/bin/pt-log-player @@ -3517,7 +3517,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-mext b/bin/pt-mext index e0bda7be..0fa977d8 100755 --- a/bin/pt-mext +++ b/bin/pt-mext @@ -112,7 +112,7 @@ Usage: pt-mext [OPTION...] pt-mext aggregates and summarizes mysqladmin extended output. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-mysql-summary b/bin/pt-mysql-summary index 73dc2fc5..28e98f89 100755 --- a/bin/pt-mysql-summary +++ b/bin/pt-mysql-summary @@ -1289,7 +1289,7 @@ you would use to connect to MySQL, such as "./mysql-summary --user=foo" * Parse queries out of processlist and aggregate them. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-online-schema-change b/bin/pt-online-schema-change index 278a2e64..4c935e02 100755 --- a/bin/pt-online-schema-change +++ b/bin/pt-online-schema-change @@ -5203,7 +5203,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-pmp b/bin/pt-pmp index 7416feee..dc127935 100755 --- a/bin/pt-pmp +++ b/bin/pt-pmp @@ -205,7 +205,7 @@ Usage: pt-pmp [OPTION...] pt-pmp aggregates stack traces. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-profile-compact b/bin/pt-profile-compact index cfef30c5..335f09f4 100755 --- a/bin/pt-profile-compact +++ b/bin/pt-profile-compact @@ -1266,7 +1266,7 @@ Show version and exit. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-query-advisor b/bin/pt-query-advisor index 723af3d2..8c75a14b 100755 --- a/bin/pt-query-advisor +++ b/bin/pt-query-advisor @@ -7191,7 +7191,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-query-digest b/bin/pt-query-digest index b78c1bf6..9e8b8dda 100755 --- a/bin/pt-query-digest +++ b/bin/pt-query-digest @@ -15635,7 +15635,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-query-profiler b/bin/pt-query-profiler index 4fcda12a..a265902a 100755 --- a/bin/pt-query-profiler +++ b/bin/pt-query-profiler @@ -2751,7 +2751,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-rel b/bin/pt-rel index 0c83ba07..1dae7436 100755 --- a/bin/pt-rel +++ b/bin/pt-rel @@ -84,7 +84,7 @@ The output will be Mutex spin waits 0, rounds 6645565, OS waits 34159 RW-shared spins 14648, OS waits 882; RW-excl spins 13146 -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-show-grants b/bin/pt-show-grants index 723a718a..0cb7b49f 100755 --- a/bin/pt-show-grants +++ b/bin/pt-show-grants @@ -2129,7 +2129,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-sift b/bin/pt-sift index 61c794b3..f296a523 100755 --- a/bin/pt-sift +++ b/bin/pt-sift @@ -481,7 +481,7 @@ Usage: pt-sift [OPTION...] pt-sift browses the files created by the collect tool. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-slave-delay b/bin/pt-slave-delay index a21ecb7f..639cd582 100755 --- a/bin/pt-slave-delay +++ b/bin/pt-slave-delay @@ -2613,7 +2613,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-slave-find b/bin/pt-slave-find index c33f0bf8..851a175a 100755 --- a/bin/pt-slave-find +++ b/bin/pt-slave-find @@ -3093,7 +3093,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart index f37a439f..513e4937 100755 --- a/bin/pt-slave-restart +++ b/bin/pt-slave-restart @@ -3264,7 +3264,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-stalk b/bin/pt-stalk index 9051070c..1f7fefa7 100755 --- a/bin/pt-stalk +++ b/bin/pt-stalk @@ -183,7 +183,7 @@ and restarting this one. The name 'stalk' is because 'watch' is already taken, and 'stalk' is fun. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-summary b/bin/pt-summary index 5fbac094..5874d9a3 100755 --- a/bin/pt-summary +++ b/bin/pt-summary @@ -1203,7 +1203,7 @@ Options: NETWORK: Don't print out information on network controllers & config. PROCESS: Don't print out top processes and vmstat information. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-table-checksum b/bin/pt-table-checksum index 40a0ebfe..690575e4 100755 --- a/bin/pt-table-checksum +++ b/bin/pt-table-checksum @@ -8645,7 +8645,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-table-sync b/bin/pt-table-sync index aef012c5..f97fe5e9 100755 --- a/bin/pt-table-sync +++ b/bin/pt-table-sync @@ -9970,7 +9970,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-tcp-model b/bin/pt-tcp-model index b67c1bc4..af16052c 100755 --- a/bin/pt-tcp-model +++ b/bin/pt-tcp-model @@ -2318,7 +2318,7 @@ number. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-trend b/bin/pt-trend index bb5c0251..bd4b8f35 100755 --- a/bin/pt-trend +++ b/bin/pt-trend @@ -1992,7 +1992,7 @@ Show version and exit. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-upgrade b/bin/pt-upgrade index d28ddc9c..c7a13871 100755 --- a/bin/pt-upgrade +++ b/bin/pt-upgrade @@ -11732,7 +11732,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-usl b/bin/pt-usl index 9a84f9be..75d290bc 100755 --- a/bin/pt-usl +++ b/bin/pt-usl @@ -794,7 +794,7 @@ This tool is based on Neil Gunther's book Guerrilla Capacity Planning. other samples; it will introduce skew into the throughput for that sample, too. -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-variable-advisor b/bin/pt-variable-advisor index 54bfd82f..dbe6ae0f 100755 --- a/bin/pt-variable-advisor +++ b/bin/pt-variable-advisor @@ -3806,7 +3806,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/bin/pt-visual-explain b/bin/pt-visual-explain index eb8bc129..c4d76e8f 100755 --- a/bin/pt-visual-explain +++ b/bin/pt-visual-explain @@ -2996,7 +2996,7 @@ User for login if not current user. =back -=head1 DOWNLOADING +=head1 DOWNLOADING Visit L to download the latest release of Percona Toolkit. Or, to get the latest release from the command line: diff --git a/util/aspell.en.pws b/util/aspell.en.pws new file mode 100644 index 00000000..22a4205f --- /dev/null +++ b/util/aspell.en.pws @@ -0,0 +1,90 @@ +personal_ws-1.1 en 86 +STDOUT +MKDEBUG +PTDEBUG +timestamp +perlgpl +perlartistic +Ver +Distrib +Nichter +Percona +binmode +config +PID +MySQL +mysql +Maatkit +processlist +PROCESSLIST +STDIN +login +STDERR +wget +DSN +SQL +charset +daemonize +daemonized +POSIX +regex +cron +DBI +DBD +Freenode +IRC +MERCHANTABILITY +whitespace +manpage +binlog +runtime +OLTP +mojibake +archiver +INFILE +OUTFILE +umask +InnoDB +transactional +MyISAM +checksum +checksums +checksumming +checksummed +chunking +chunked +chunkable +hostname +PostgreSQL +Continuent +LLC +sakila +gzip +lossless +mysqldump +mysqlbinlog +mysqlimport +fifo +recurse +wildcard +bool +boolean +subquery +subqueries +memcached +cardinality +Apdex +sparkline +cryptographic +tcpdump +timeline +profiler +canonicalize +prefetch +unresolvable +incrementing +scalability +IP +runnable +online +Aspersa diff --git a/util/check-dev-env b/util/check-dev-env new file mode 100755 index 00000000..6f812d22 --- /dev/null +++ b/util/check-dev-env @@ -0,0 +1,40 @@ +#!/usr/bin/env perl + +# This pseudo-script is for developers to see if their box has all +# the modules necessary for testing Maatkit. Any missing modules +# will cause an error like "Can't locate Foo.pm in @INC ...". Else +# the version for each module used by this script will be printed. + +use Data::Dumper; +use DBD::mysql; +use DBI; +use Digest::MD5; +use File::Basename; +use File::Find; +use File::Spec; +use File::Temp; +use Getopt::Long; +use IO::Compress::Gzip; +use IO::File; +use IO::Uncompress::Inflate; +use List::Util; +use POSIX; +use Socket; +use Term::ReadKey; +use Test::More; +use threads; +use Thread::Queue; +use Time::HiRes; +use Time::Local; +#use Digest::Crc32; + +my $file = __FILE__; +my $m = `cat $file | grep '^use'`; +my @modules = map { m/use (.+?);/; $1 } split("\n", $m); + +foreach my $module ( @modules ) { + my $version = "${module}::VERSION"; + print "$module " . ${$version} . "\n"; +} + +exit; diff --git a/util/check-spelling b/util/check-spelling new file mode 100755 index 00000000..8f375716 --- /dev/null +++ b/util/check-spelling @@ -0,0 +1,45 @@ +#!/usr/bin/env perl + +# You must run the program from util/. +if ( !(-f 'aspell.en.pws' && -f 'parse-aspell-output') ) { + die "This script must be run from the util/ directory of a branch\n" +} + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); + +# These programs should be in your PATH. +my $pod2text = 'pod2text'; +my $aspell = 'aspell'; + +my $tool_file = shift @ARGV; +if ( !$tool_file ) { + die "Usage: $PROGRAM_NAME TOOL\n"; +} + +my ($tool_name) = $tool_file =~ m{([a-z-]+)$}; +if ( !$tool_name ) { + die "Cannot parse tool name from $tool_file"; +} + +# Temp files. +my $pod_file = "/tmp/$tool_name-pod"; +my $bad_words_file = "/tmp/$tool_name-misspelled-words"; + +# Convert tool's POD to text. +`$pod2text $tool_file > $pod_file`; + +# Spell check the text file. +`cat $pod_file | $aspell --pipe --lang en_US --personal ./aspell.en.pws > $bad_words_file`; + +# Parse and match the aspell output to the text file. +print "$tool_name:\n\n"; +print `./parse-aspell-output $bad_words_file $pod_file`; +print "\n"; + +# Cleanup. +`rm -rf $pod_file`; +`rm -rf $bad_words_file`; + +exit; diff --git a/util/check-tool b/util/check-tool new file mode 100755 index 00000000..e795b03a --- /dev/null +++ b/util/check-tool @@ -0,0 +1,435 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); +use constant MKDEBUG => $ENV{MKDEBUG} || 0; + +use Data::Dumper; +$Data::Dumper::Indent = 1; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Quotekeys = 0; + +my @tool_files = @ARGV; +if ( !@tool_files ) { + die "Usage: $PROGRAM_NAME [TOOL...]\n"; +} + +my $exit_status = 0; # 0 no problems, 1 any problems +my $tool_file; # bin/pt-archiver +my $tool_name; # pt-archiver (no path) + +my @check_subs = (qw( + check_alpha_order + check_module_usage + check_option_types + check_pod_header_order + check_pod_formatting + check_option_usage +)); + +TOOL: +while ( defined($tool_file = shift @ARGV) ) { + my $fh; + eval { + open $fh, "<", $tool_file; + }; + if ( $EVAL_ERROR ) { + $exit_status = 1; + warn "Cannot open $tool_file: $OS_ERROR"; + next TOOL; + } + + ($tool_name) = $tool_file =~ m{/([a-z-]+)$}; + if ( !$tool_name ) { + $exit_status = 1; + warn "Cannot parse tool name from $tool_file"; + next TOOL; + } + + foreach my $check_sub ( @check_subs ) { + seek $fh, 0, 0; + print "# $check_sub ", ('#' x (70 - length $check_sub)), "\n"; + my $sub = \&$check_sub; + eval { + &$sub($fh); + }; + if ( $EVAL_ERROR ) { + $exit_status = 1; + warn "Error while checking $tool_name: $EVAL_ERROR"; + } + } +} + +exit $exit_status; + +# ############################################################################ +# Subroutines +# ############################################################################ + +# Check that options in the tool's POD are in alphabetical order. Only the +# head1 OPTIONS section and any head2 subsections are checked. Subsections +# are considered independent. The "[no]" part of negatable options is not +# part of the base option name, so it's ignored. +sub check_alpha_order { + my ($fh) = @_; + local $INPUT_RECORD_SEPARATOR = ''; + my $para; + my $section; + while ( $para = <$fh> ) { + last if ($section) = $para =~ m/^=head1 (OPTIONS)/; + } + die "Cannot find =head1 OPTIONS" unless $section; + parse_options($fh, $section); + return; +} + +sub parse_options { + my ($fh, $section) = @_; + my $para; + my @opts; + while ( $para = <$fh> ) { + last if $para =~ m/^=head1/; + + if ( my ($option) = $para =~ m/^=item --(?:\[no\])?(.*)/ ) { + push @opts, $option; + } + elsif ( $para =~ m/^=head2 (.+)/ ) { + parse_options($fh, $1); + } + } + + my $fmt = "%-20s %-20s\n"; + my @sorted = sort @opts; + for my $i ( 0..$#sorted ) { + if ( $opts[$i] ne $sorted[$i] ) { + $exit_status = 1; + printf "$tool_name has unsorted options in $section\n"; + printf $fmt, 'ACTUAL', 'CORRECT'; + printf $fmt, '=' x 20, '=' x 20; + map { printf $fmt, $opts[$_], $sorted[$_] } + grep { $opts[$_] ne $sorted[$_] } + ($i..$#sorted); + last; + } + } + + return; +} + +sub check_module_usage { + my ($fh) = @_; + + # These modules are not instantiated as objects. + my %not_obj = ( + Transformers => 1, + ); + + # Many tools dyanmically instantiate objs like $plugin="WatchStatus", + # $plugin->new(). So this script can't detect that. + my %dynamic = ( + 'pt-loadavg' => { + WatchStatus => 1, + WatchProcesslist => 1, + WatchServer => 1, + }, + 'pt-query-advisor' => { + SlowLogParser => 1, + GeneralLogParser => 1, + }, + 'pt-query-digest' => { + TcpdumpParser => 1, + MySQLProtocolParser => 1, + PgLogParser => 1, + SlowLogParser => 1, + MemcachedProtocolParser => 1, + MemcachedEvent => 1, + BinaryLogParser => 1, + GeneralLogParser => 1, + ProtocolParser => 1, + HTTPProtocolParser => 1, + }, + 'pt-table-sync' => { + TableSyncStream => 1, + TableSyncChunk => 1, + TableSyncNibble => 1, + TableSyncGroupBy => 1, + }, + 'pt-table-usage' => { + SlowLogParser => 1, + }, + ); + + # If these base-class modules are present, they should be accompanied + # by a subclass. + my %base_class = ( + 'AdvisorRules' => [ qw(QueryAdvisorRules VariableAdvisorRules) ], + ); + + # Nearly every tool has or needs these modules. + my %ignore = ( + OptionParser => 1, + DSNParser => 1, + ); + + my $contents = do { local $/ = undef; <$fh> }; + my %uses = map { $_ => 1 } $contents =~ m/new ([A-Z]\w+)(?:\(|;)/gm; + my @unused = grep { + my $module = $_; + my $unused = 0; + if ( $not_obj{$module} ) { + # MaatkitCommon::_d + chomp(my $g = `grep -c '${_}::' $tool_file`); + # Transformers->import + chomp(my $i = `grep -c '${_}->import' $tool_file`); + $g ||= 0; + $i ||= 0; + $unused = 1 if $g + $i == 0; + } + elsif ( $dynamic{$tool_name}->{$module} ) { + # Can't detect these. + } + elsif ( $base_class{$module} ) { + $unused = 1 unless grep { $uses{$_} } @{$base_class{$module}}; + } + else { + $unused = 1 unless $uses{$module}; + } + $unused; + } + grep { !$ignore{$_} } $contents =~ m/^# (\w+) package$/gm; + + if ( @unused ) { + print "$tool_name has unused modules:\n" + . join('', map { "\t$_\n" } @unused); + $exit_status = 1; + } + + return; +} + +sub check_option_types { + my ($fh) = @_; + + # Standard options: http://code.google.com/p/maatkit/wiki/CommandLineOptions + my $sop = { + 'defaults-file' => {type => 's', short => 'F' }, + 'host' => {type => 's', short => 'h' }, + 'password' => {type => 's', short => 'p' }, + 'port' => {type => 'i', short => 'P' }, + 'socket' => {type => 's', short => 'S' }, + 'user' => {type => 's', short => 'u' }, + 'charset' => {type => 's', short => 'A' }, + 'ask-pass' => {type => '', short => '', }, + 'database' => {type => 's', short => 'D' }, + 'set-vars' => {type => 's', short => '', }, + 'where' => {type => 's', short => '', }, + 'databases' => {type => 'h', short => 'd' }, + 'tables' => {type => 'h', short => 't' }, + 'columns' => {type => 'a', short => 'c' }, + 'engines' => {type => 'h', short => 'e' }, + 'ignore-databases'=> {type => 'H', short => '', }, + 'ignore-tables' => {type => 'H', short => '', }, + 'ignore-columns' => {type => 'H', short => '', }, + 'ignore-engines' => {type => 'H', short => '', }, + 'config' => {type => 'A', short => '', }, + 'daemonize' => {type => '', short => '', }, + 'dry-run' => {type => '', short => '', }, + 'log' => {type => 's', short => '', }, + 'pid' => {type => 's', short => '', }, + # --progress is not standard. Some older tools had their own special + # progress, whereas newer tools use Progress. + # 'progress' => {type => 'a', short => '', }, + 'quiet' => {type => '', short => 'q' }, + 'sentinel' => {type => 's', short => '', }, + 'stop' => {type => '', short => '', }, + 'run-time' => {type => 'm', short => '', }, + 'threads' => {type => 'i', short => '', }, + 'verbose' => {type => '', short => 'v' }, + 'wait' => {type => 'm', short => 'w' }, + 'recurse' => {type => 'i', short => '' }, + }; + + # Exceptions are inevitable. E.g., pt-deadlock-logger --columns is not the + # standard filter --columns (e.g. same family as --databases, --tables, etc.) + # These exceptions are good candidates for change, so our standard options + # really are standard across all tools. + my $exception = { + 'pt-deadlock-logger' => { # not standard filter + columns => { + type => 'h', + short => '', + }, + }, + 'pt-checksum-filter' => { # not standard filter + 'ignore-databases' => { + type => '', + short => '', + }, + }, + }; + + my $help = `$tool_file --help`; + + # Options are listed after the line "Options:" (default group). + # Each line is like: + # --defaults-file=s -F Only read mysql options from the given file + # The short form (-F) is optional. The list is terminated at + # the line "Option types:". Problem is: there's a second list + # of options. The second list shows each option's value. So + # we stop parsing when we get an option that we already have. + my $opt = {}; + while ( $help =~ m/^\s{2,}--(\S+?)(?:=(.))?\s+(?:-([a-zA-Z]))?\s+\w+/mg ) { + my ($long, $type, $short) = ($1, $2, $3); + die "Failed to parse $help" unless $long; + last if $opt->{$long}; + $opt->{$long} = 1; + + if ( $sop->{$long} ) { + # Check option type. + my $expected_type = $sop->{$long}->{type}; + $expected_type = $exception->{$tool_name}->{$long}->{type} + if exists $exception->{$tool_name}->{$long}->{type}; + $expected_type = '' unless defined $expected_type; + if ( ($type || '') ne $expected_type ) { + $exit_status = 1; + print "$tool_name --$long " + . ($type ? "is type $type" : "has no type") + . " but should " + . ($expected_type ? "be type $expected_type" + : "have no type") + . "\n"; + } + + # Check short form. + my $expected_short = $sop->{$long}->{short}; + $expected_short = $exception->{$tool_name}->{$long}->{short} + if exists $exception->{$tool_name}->{$long}->{short}; + $expected_short = '' unless defined $expected_short; + if ( ($short || '') ne $expected_short ) { + print "$tool_name --$long " + . ($short ? "has short form -$short" : "has no short form") + . " but should have " + . ($expected_short ? "short form -$expected_short" + : "no short form") + . "\n"; + } + } + } + + return; +} + +# Check that the POD headers are in standard order. Only major, required +# headers are checked. For example, there maybe be other headers between +# DESCRIPTION and OPTIONS, but these are ignored. +sub check_pod_header_order { + my @std_hdrs = ( + 'NAME', + 'SYNOPSIS', + 'RISKS', + 'DESCRIPTION', + 'OPTIONS', + 'DOWNLOADING', + 'ENVIRONMENT', + 'SYSTEM REQUIREMENTS', + 'BUGS', + 'AUTHORS', + 'COPYRIGHT, LICENSE, AND WARRANTY', + 'VERSION', + ); + + my @hdrs; + foreach my $hdr ( split(/\n/, `grep '^=head1' $tool_file`) ) { + $hdr =~ s/^=head1 //; + if ( $hdr =~ s/\s+$// ) { + print "Extra space after $hdr\n"; + } + push @hdrs, $hdr if grep { $hdr eq $_ } @std_hdrs; + } + + my $fmt = "%-32s %-32s\n"; + for my $i ( 0..$#std_hdrs ) { + if ( ($hdrs[$i] || '') ne $std_hdrs[$i] ) { + $exit_status = 1; + print "$tool_name has missing or out-of-order standard headers:\n"; + printf $fmt, 'ACTUAL', 'CORRECT'; + printf $fmt, '=' x 32, '=' x 32; + map { printf $fmt, ($hdrs[$_] || ''), $std_hdrs[$_] } + grep { ($hdrs[$_] || '') ne $std_hdrs[$_] } + ($i..$#std_hdrs); + last; + } + } + + return; +} + +sub check_pod_formatting { + my ($fh) = @_; + + my $output = `perldoc -T $tool_file 2>&1`; + # unlike() will print the whole POD if this fails; ok() is more terse. + if ( $output =~ m/can't break/ ) { + $exit_status = 1; + print "$tool_name POD has lines that are too long\n"; + } + + chomp(my $podchecker = `which podchecker`); + if ( $podchecker ) { + $output = `$podchecker $tool_file 2>&1`; + if ( $output !~ m/pod syntax OK/ ) { + $exit_status = 1; + print "$output\n"; + } + } + + return; +} + +sub check_option_usage { + my ($fh) = @_; + + # help and version are special opts, intrinsic to OptionParser. + # The other opts are usually processed all at once by calling + # DSNParser::parse_options(). + my %ignore = qw( + version 1 + help 1 + charset 1 + defaults-file 1 + host 1 + password 1 + port 1 + socket 1 + user 1 + ); + + my $contents = do { local $/ = undef; <$fh> }; + my @options = grep { !$ignore{$_} } + map { s/^\[no\]//; $_; } + $contents =~ m/^=item --(.+)$/gm; + my @unused = grep { + chomp(my $get = `grep -c "get('$_')" $tool_file`); + chomp(my $got = `grep -c "got('$_')" $tool_file`); + $get ||= 0; + $got ||= 0; + my $used = $get + $got; + !$used; + } @options; + + if ( @unused ) { + $exit_status = 1; + print "$tool_name has unused options:\n" + . join('', map { "\t--$_\n" } @unused); + } + + (my $pkg = $tool_name) =~ s/-/_/g; + my $main = `grep -A 1000 $pkg $tool_file`; + if ( $main !~ m/->parse_options\(/ ) { + $exit_status = 1; + print "$tool_name does not call DSNParser::parse_options()\n"; + } + + return; +} diff --git a/util/parse-aspell-output b/util/parse-aspell-output new file mode 100755 index 00000000..82cfed95 --- /dev/null +++ b/util/parse-aspell-output @@ -0,0 +1,89 @@ +#!/usr/bin/env perl + +# This script parses the output of ispell/aspell --pipe into something +# meaningful. The output is like: +# +# @(#) International Ispell Version 3.1.20 (but really Aspell 0.60.6) +# & mk 50 0: Mk, km, mks, ml, K, M, k, ... +# * +# * +# * +# * +# +# * +# * +# & mk 50 6: Mk, km, mks, ml, K, M, k, ... +# +# Spelling errors are the "& WORD COUNT OFFSET: SUGGESTIONS" lines. We +# don't care about COUNT and OFFSET is per-word (or so it seems), so it's +# not helpful to us either. We also don't care about the suggestions. +# +# What we care about is on which line the bad WORD appears. Lines are +# separated by blank lines in the output; so that output reflects 2 lines +# in the input. The asterisk lines are good/spelled correctly words. + +use strict; +use warnings FATAL => 'all'; + +use English qw(-no_match_vars); +use Data::Dumper; + +my ($ispell_output, $pod_text) = @ARGV; +die "No ispell output file given" unless $ispell_output && -f $ispell_output; +die "No POD text file given" unless $pod_text && -f $pod_text; + +my $fh; + +open $fh, '<', $pod_text or die "Cannot open $pod_text: $OS_ERROR"; +my @pod = <$fh>; +close $fh; + +open $fh, '<', $ispell_output or die "Cannot open $ispell_output: $OS_ERROR"; + +my $pod_lineno = 1; +my $i = 0; +my $j = 0; +LINE: +while ( defined(my $line = <$fh>) ) { + if ( $line =~ m/^\s*$/ ) { + $pod_lineno++; + next LINE; + } + + my ($word, $correct) = $line =~ m/^& (\w+) \d+ \d+: (.+)/; + next LINE unless $word; + + next LINE if $word eq 'mk'; + + if ( $i < $pod_lineno ) { + for my $pod_line ( $j..$#pod ) { + $i++ if $pod[$j++] ne "\n"; + last if $i == $pod_lineno; + } + } + + my $pod_line = $pod[$j - 1]; + + next LINE if $pod_line =~ m/^\s*(?:type|short form): [\w-]+/; + + next LINE if $word =~ m/utf/i && $pod_line =~ m/utf8/i; + + next LINE if $pod_line =~ m/^\s+--$word$/; + + next LINE if $word eq 'maatkit' && $pod_line =~ m/maatkit manpage/; + next LINE if $word eq 'maatkit' && $pod_line =~ m{http://code.google.com/p/maatkit/}; + next LINE if $word eq 'dsn' && $pod_line =~ m/dsn: \w+/; + next LINE if $word eq 'tmp' && $pod_line =~ m/tmp table/; + next LINE if $word eq 'toolname' && $pod_line =~ m/Where "toolname"/; + + $pod_line =~ s/^\s+//; + my @correct = map { s/^s+//g; s/\s+$//g; $_ } split(',', $correct); + + print " Misspelled: $word\n" + . " Suggestions: " . join(', ', + grep { defined $_ } map { $correct[$_] } (0..2)) . "\n" + . " Line: $pod_line\n"; +} + +close $fh; +exit;