From d1bd7a9f3baf0eca09e04794aef1df3e0a026d3a Mon Sep 17 00:00:00 2001 From: Daniel Nichter Date: Fri, 30 Dec 2011 09:23:41 -0700 Subject: [PATCH] Change MKDEBUG to PTDEBUG. Remove 1.0.2 from release notes. --- bin/pt-archiver | 390 +++---- bin/pt-config-diff | 234 ++--- bin/pt-deadlock-logger | 190 ++-- bin/pt-duplicate-key-checker | 412 ++++---- bin/pt-fifo-split | 106 +- bin/pt-find | 268 ++--- bin/pt-fk-error-logger | 178 ++-- bin/pt-heartbeat | 388 +++---- bin/pt-index-usage | 540 +++++----- bin/pt-kill | 378 +++---- bin/pt-log-player | 312 +++--- bin/pt-online-schema-change | 430 ++++---- bin/pt-query-advisor | 630 +++++------ bin/pt-query-digest | 1342 ++++++++++++------------ bin/pt-show-grants | 168 +-- bin/pt-slave-delay | 210 ++-- bin/pt-slave-find | 264 ++--- bin/pt-slave-restart | 276 ++--- bin/pt-table-checksum | 752 ++++++------- bin/pt-table-sync | 914 ++++++++-------- bin/pt-tcp-model | 152 +-- bin/pt-trend | 134 +-- bin/pt-upgrade | 1064 +++++++++---------- bin/pt-variable-advisor | 220 ++-- bin/pt-visual-explain | 148 +-- docs/release_notes.rst | 28 - t/lib/DSNParser.t | 2 +- t/lib/Daemon.t | 2 +- t/lib/ExecutionThrottler.t | 2 +- t/lib/ExplainAnalyzer.t | 2 +- t/lib/FileIterator.t | 2 +- t/lib/IndexUsage.t | 2 +- t/lib/NibbleIterator.t | 2 +- t/lib/OobNibbleIterator.t | 2 +- t/lib/Progress.t | 2 +- t/lib/SchemaIterator.t | 2 +- t/lib/TableSyncer.t | 10 +- t/lib/samples/daemonizes.pl | 2 +- t/pt-deadlock-logger/clear_deadlocks.t | 4 +- t/pt-query-digest/issue_1186.t | 4 +- t/pt-query-digest/issue_232.t | 2 +- t/pt-query-digest/mirror.t | 4 +- t/pt-table-sync/basics.t | 16 +- t/pt-table-sync/force_index.t | 4 +- 44 files changed, 5083 insertions(+), 5111 deletions(-) diff --git a/bin/pt-archiver b/bin/pt-archiver index 2d0a07b7..22519de4 100755 --- a/bin/pt-archiver +++ b/bin/pt-archiver @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1092,7 +1092,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -1153,7 +1153,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -1171,7 +1171,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -1180,25 +1180,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -1212,66 +1212,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -1287,7 +1287,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -1313,7 +1313,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -1335,7 +1335,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -1403,7 +1403,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -1413,7 +1413,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -1448,7 +1448,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1471,7 +1471,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1489,7 +1489,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1498,10 +1498,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1513,23 +1513,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1560,7 +1560,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1610,7 +1610,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1655,7 +1655,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1665,21 +1665,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1691,15 +1691,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1717,7 +1717,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1743,7 +1743,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1804,7 +1804,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1814,7 +1814,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1825,7 +1825,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1843,7 +1843,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1855,7 +1855,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1887,7 +1887,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1964,7 +1964,7 @@ package TableNibbler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1993,11 +1993,11 @@ sub generate_asc_stmt { my @asc_slice; @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; - MKDEBUG && _d('Will ascend index', $index); - MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); + PTDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); if ( $args{asc_first} ) { @asc_cols = $asc_cols[0]; - MKDEBUG && _d('Ascending only first column'); + PTDEBUG && _d('Ascending only first column'); } my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; @@ -2008,7 +2008,7 @@ sub generate_asc_stmt { } push @asc_slice, $col_posn{$col}; } - MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); + PTDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); my $asc_stmt = { cols => \@cols, @@ -2129,7 +2129,7 @@ sub generate_del_stmt { else { @del_cols = @{$tbl->{cols}}; } - MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); + PTDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; foreach my $col ( @del_cols ) { @@ -2139,7 +2139,7 @@ sub generate_del_stmt { } push @del_slice, $col_posn{$col}; } - MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); + PTDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); my $del_stmt = { cols => \@cols, @@ -2223,7 +2223,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -2317,11 +2317,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -2333,12 +2333,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -2348,15 +2348,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -2366,11 +2366,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -2391,7 +2391,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -2403,11 +2403,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -2420,7 +2420,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -2439,7 +2439,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -2457,7 +2457,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -2483,7 +2483,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -2528,7 +2528,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2546,17 +2546,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2598,19 +2598,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2628,7 +2628,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2648,7 +2648,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2661,7 +2661,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2670,10 +2670,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2714,7 +2714,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2735,7 +2735,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -2744,15 +2744,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -2768,7 +2768,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -2786,23 +2786,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -2831,11 +2831,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -2864,7 +2864,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -2875,11 +2875,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -2894,7 +2894,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -2954,7 +2954,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -2963,7 +2963,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -2972,21 +2972,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -3007,17 +3007,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -3030,7 +3030,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -3039,13 +3039,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -3058,12 +3058,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -3075,7 +3075,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -3083,7 +3083,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -3091,7 +3091,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -3134,7 +3134,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -3196,12 +3196,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -3222,7 +3222,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -3232,14 +3232,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -3280,7 +3280,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -3334,7 +3334,7 @@ use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # Global variables; as few as possible. my $oktorun = 1; @@ -3505,7 +3505,7 @@ sub main { } my $dbh = $dp->get_dbh( $dp->get_cxn_params($table), { AutoCommit => $ac }); - MKDEBUG && _d('Inspecting table on', $dp->as_string($table)); + PTDEBUG && _d('Inspecting table on', $dp->as_string($table)); # Set options that can enable removing data on the master and archiving it # on the slaves. @@ -3551,7 +3551,7 @@ sub main { if ( $o->get('check-charset') ) { my $sql = 'SELECT CONCAT(/*!40100 @@session.character_set_connection, */ "")'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($dbh_charset) = $table->{dbh}->selectrow_array($sql); if ( ($dbh_charset || "") ne ($table->{info}->{charset} || "") ) { $src->{dbh}->disconnect() if $src && $src->{dbh}; @@ -3637,7 +3637,7 @@ sub main { my @sel_cols = $o->get('columns') ? @{$o->get('columns')} # Explicit : $o->get('primary-key-only') ? @{$src->{info}->{keys}->{PRIMARY}->{cols}} : @{$src->{info}->{cols}}; # All - MKDEBUG && _d("sel cols: ", @sel_cols); + PTDEBUG && _d("sel cols: ", @sel_cols); $del_stmt = $nibbler->generate_del_stmt( tbl_struct => $src->{info}, @@ -3711,7 +3711,7 @@ sub main { } } - MKDEBUG && _d("Index for DELETE:", $del_stmt->{index}); + PTDEBUG && _d("Index for DELETE:", $del_stmt->{index}); if ( !$bulk_del ) { # The LIMIT might be 1 here, because even though a SELECT can return # many rows, an INSERT only does one at a time. It would not be safe to @@ -3726,10 +3726,10 @@ sub main { . " FROM $src->{db_tbl} WHERE $del_stmt->{where}"; if ( $src->{info}->{keys}->{$del_stmt->{index}}->{is_unique} ) { - MKDEBUG && _d("DELETE index is unique; LIMIT 1 is not needed"); + PTDEBUG && _d("DELETE index is unique; LIMIT 1 is not needed"); } else { - MKDEBUG && _d("Adding LIMIT 1 to DELETE because DELETE index " + PTDEBUG && _d("Adding LIMIT 1 to DELETE because DELETE index " . "is not unique"); $del_sql .= " LIMIT 1"; } @@ -3761,7 +3761,7 @@ sub main { ins_tbl => $dst->{info}, sel_cols => \@sel_cols, ); - MKDEBUG && _d("inst stmt: ", Dumper($ins_stmt)); + PTDEBUG && _d("inst stmt: ", Dumper($ins_stmt)); @ins_slice = @{$ins_stmt->{slice}}; if ( $o->get('bulk-insert') ) { $ins_sql = 'LOAD DATA' @@ -3788,7 +3788,7 @@ sub main { $ins_sql = ''; } - if ( MKDEBUG ) { + if ( PTDEBUG ) { _d("get first sql:", $first_sql); _d("get next sql:", $next_sql); _d("del row sql:", $del_sql); @@ -3857,7 +3857,7 @@ sub main { $statistics{SELECT} += $get_sth->rows; }); my $row = $get_sth->fetchrow_arrayref(); - MKDEBUG && _d("First row: ", Dumper($row), 'rows:', $get_sth->rows); + PTDEBUG && _d("First row: ", Dumper($row), 'rows:', $get_sth->rows); if ( !$row ) { $get_sth->finish; $src->{dbh}->disconnect(); @@ -3945,7 +3945,7 @@ sub main { $ins_sth ||= $ins_row; # Default to the sth decided before. my $success = do_with_retries($o, 'inserting', sub { $ins_sth->execute(@{$row}[@ins_slice]); - MKDEBUG && _d('Inserted', $del_row->rows, 'rows'); + PTDEBUG && _d('Inserted', $del_row->rows, 'rows'); $statistics{INSERT} += $ins_sth->rows; }); if ( $success == $OUT_OF_RETRIES ) { @@ -3968,7 +3968,7 @@ sub main { if ( !$o->get('no-delete') ) { my $success = do_with_retries($o, 'deleting', sub { $del_row->execute(@{$row}[@del_slice]); - MKDEBUG && _d('Deleted', $del_row->rows, 'rows'); + PTDEBUG && _d('Deleted', $del_row->rows, 'rows'); $statistics{DELETE} += $del_row->rows; }); if ( $success == $OUT_OF_RETRIES ) { @@ -4020,7 +4020,7 @@ sub main { $row = $get_sth->fetchrow_arrayref(); } if ( !$row ) { - MKDEBUG && _d('No more rows in this chunk; doing bulk operations'); + PTDEBUG && _d('No more rows in this chunk; doing bulk operations'); # ################################################################### # This code is for the bulk archiving functionality. @@ -4049,7 +4049,7 @@ sub main { $ins_sth ||= $ins_row; # Default to the sth decided before. my $success = do_with_retries($o, 'bulk_inserting', sub { $ins_sth->execute($bulkins_file->filename()); - MKDEBUG && _d('Bulk inserted', $del_row->rows, 'rows'); + PTDEBUG && _d('Bulk inserted', $del_row->rows, 'rows'); $statistics{INSERT} += $ins_sth->rows; }); if ( $success != $ALL_IS_WELL ) { @@ -4073,7 +4073,7 @@ sub main { @{$first_row}[@bulkdel_slice], @{$lastrow}[@bulkdel_slice], ); - MKDEBUG && _d('Bulk deleted', $del_row->rows, 'rows'); + PTDEBUG && _d('Bulk deleted', $del_row->rows, 'rows'); $statistics{DELETE} += $del_row->rows; }); if ( $success != $ALL_IS_WELL ) { @@ -4089,12 +4089,12 @@ sub main { commit($o, 1) if $commit_each; $get_sth = $get_next; - MKDEBUG && _d('Fetching rows in next chunk'); + PTDEBUG && _d('Fetching rows in next chunk'); trace('select', sub { my $select_start = time; $get_sth->execute(@{$lastrow}[@asc_slice]); $last_select_time = time - $select_start; - MKDEBUG && _d('Fetched', $get_sth->rows, 'rows'); + PTDEBUG && _d('Fetched', $get_sth->rows, 'rows'); $statistics{SELECT} += $get_sth->rows; }); @@ -4109,14 +4109,14 @@ sub main { } } # no next row (do bulk operations) else { - MKDEBUG && _d('Got another row in this chunk'); + PTDEBUG && _d('Got another row in this chunk'); } # Check slave lag and wait if slave is too far behind. if ( $lag_dbh ) { my $lag = $ms->get_slave_lag($lag_dbh); while ( !defined $lag || $lag > $o->get('max-lag') ) { - MKDEBUG && _d('Sleeping: slave lag is', $lag); + PTDEBUG && _d('Sleeping: slave lag is', $lag); sleep($o->get('check-interval')); $lag = $ms->get_slave_lag($lag_dbh); } @@ -4126,13 +4126,13 @@ sub main { if( my $sleep_time = $o->get('sleep') ) { $sleep_time = $last_select_time * $o->get('sleep-coef') if $o->get('sleep-coef'); - MKDEBUG && _d('Sleeping', $sleep_time); + PTDEBUG && _d('Sleeping', $sleep_time); trace('sleep', sub { sleep($sleep_time); }); } } # ROW - MKDEBUG && _d('Done fetching rows'); + PTDEBUG && _d('Done fetching rows'); # Transactions might still be open, etc commit($o, $txnsize || $commit_each); diff --git a/bin/pt-config-diff b/bin/pt-config-diff index 176d9748..2e680006 100755 --- a/bin/pt-config-diff +++ b/bin/pt-config-diff @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1070,7 +1070,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1088,7 +1088,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1097,10 +1097,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1112,23 +1112,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1159,7 +1159,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1209,7 +1209,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1254,7 +1254,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1264,21 +1264,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1290,15 +1290,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1316,7 +1316,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1342,7 +1342,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1403,7 +1403,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1421,17 +1421,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1473,19 +1473,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1503,7 +1503,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1523,7 +1523,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1536,7 +1536,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1545,10 +1545,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1589,7 +1589,7 @@ package TextResultSetParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1642,19 +1642,19 @@ sub parse { my $result_set; if ( $text =~ m/^\+---/m ) { # standard "tabular" output - MKDEBUG && _d('Result set text is standard tabular'); + PTDEBUG && _d('Result set text is standard tabular'); my $line_pattern = qr/^(\| .*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tabular); } elsif ( $text =~ m/^\w+\t\w+/m ) { # tab-separated - MKDEBUG && _d('Result set text is tab-separated'); + PTDEBUG && _d('Result set text is tab-separated'); my $line_pattern = qr/^(.*?\t.*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tab_sep); } elsif ( $text =~ m/\*\*\* \d+\. row/ ) { # "vertical" output - MKDEBUG && _d('Result set text is vertical (\G)'); + PTDEBUG && _d('Result set text is vertical (\G)'); foreach my $row ( split_vertical_rows($text) ) { push @$result_set, $self->parse_vertical_row($row); } @@ -1733,7 +1733,7 @@ package MySQLConfig; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my %can_be_duplicate = ( replicate_wild_do_table => 1, @@ -1791,7 +1791,7 @@ sub _parse_config { elsif ( my $dbh = $args{dbh} ) { $config_data{format} = $args{format} || 'show_variables'; my $sql = "SHOW /*!40103 GLOBAL*/ VARIABLES"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $rows = $dbh->selectall_arrayref($sql); $config_data{vars} = { map { @$_ } @$rows }; $config_data{mysql_version} = _get_version($dbh); @@ -1810,7 +1810,7 @@ sub _parse_config_output { die "I need a $arg arugment" unless $args{$arg}; } my ($output) = @args{@required_args}; - MKDEBUG && _d("Parsing config output"); + PTDEBUG && _d("Parsing config output"); my $format = $args{format} || detect_config_output_format(%args); if ( !$format ) { @@ -1868,22 +1868,22 @@ sub detect_config_output_format { || $output =~ m/Variable_name:\s+\w+/ || $output =~ m/Variable_name\s+Value$/m ) { - MKDEBUG && _d('show variables format'); + PTDEBUG && _d('show variables format'); $format = 'show_variables'; } elsif ( $output =~ m/Starts the MySQL database server/ || $output =~ m/Default options are read from / || $output =~ m/^help\s+TRUE /m ) { - MKDEBUG && _d('mysqld format'); + PTDEBUG && _d('mysqld format'); $format = 'mysqld'; } elsif ( $output =~ m/^--\w+/m ) { - MKDEBUG && _d('my_print_defaults format'); + PTDEBUG && _d('my_print_defaults format'); $format = 'my_print_defaults'; } elsif ( $output =~ m/^\s*\[[a-zA-Z]+\]\s*$/m ) { - MKDEBUG && _d('option file format'); + PTDEBUG && _d('option file format'); $format = 'option_file', } @@ -1918,14 +1918,14 @@ sub parse_mysqld { my ($opt_files) = $output =~ m/\G^(.+)\n/m; my %seen; my @opt_files = grep { !$seen{$_} } split(' ', $opt_files); - MKDEBUG && _d('Option files:', @opt_files); + PTDEBUG && _d('Option files:', @opt_files); } else { - MKDEBUG && _d("mysqld help output doesn't list option files"); + PTDEBUG && _d("mysqld help output doesn't list option files"); } if ( $output !~ m/^-+ -+$/mg ) { - MKDEBUG && _d("mysqld help output doesn't list vars and vals"); + PTDEBUG && _d("mysqld help output doesn't list vars and vals"); return; } @@ -1996,13 +1996,13 @@ sub _parse_varvals { $var =~ s/-/_/g; if ( exists $config{$var} && !$can_be_duplicate{$var} ) { - MKDEBUG && _d("Duplicate var:", $var); + PTDEBUG && _d("Duplicate var:", $var); $duplicate_var = 1; # flag on, save all the var's values } } else { my $val = $item; - MKDEBUG && _d("Var:", $var, "val:", $val); + PTDEBUG && _d("Var:", $var, "val:", $val); if ( !defined $val ) { $val = ''; @@ -2063,7 +2063,7 @@ sub _mimic_show_variables { sub _slurp_file { my ( $file ) = @_; die "I need a file argument" unless $file; - MKDEBUG && _d("Reading", $file); + PTDEBUG && _d("Reading", $file); open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR"; my $contents = do { local $/ = undef; <$fh> }; close $fh; @@ -2075,7 +2075,7 @@ sub _get_version { return unless $dbh; my $version = $dbh->selectrow_arrayref('SELECT VERSION()')->[0]; $version =~ s/(\d\.\d{1,2}.\d{1,2})/$1/; - MKDEBUG && _d('MySQL version', $version); + PTDEBUG && _d('MySQL version', $version); return $version; } @@ -2149,7 +2149,7 @@ package MySQLConfigComparer; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my %alt_val_for = ( ON => 1, @@ -2233,7 +2233,7 @@ sub diff { my ($configs) = @args{@required_args}; if ( @$configs < 2 ) { - MKDEBUG && _d("Less than two MySQLConfig objects; nothing to compare"); + PTDEBUG && _d("Less than two MySQLConfig objects; nothing to compare"); return; } @@ -2281,7 +2281,7 @@ sub diff { } } - MKDEBUG && _d("Different", $var, "values:", $val0, $valN); + PTDEBUG && _d("Different", $var, "values:", $val0, $valN); $diffs->{$var} = [ map { $_->value_of($var) } @$configs ]; last CONFIG; } # CONFIG @@ -2308,7 +2308,7 @@ sub missing { my ($configs) = @args{@required_args}; if ( @$configs < 2 ) { - MKDEBUG && _d("Less than two MySQLConfig objects; nothing to compare"); + PTDEBUG && _d("Less than two MySQLConfig objects; nothing to compare"); return; } @@ -2387,7 +2387,7 @@ package ReportFormatter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use POSIX qw(ceil); @@ -2420,7 +2420,7 @@ sub new { . "is not installed" unless $have_term; ($self->{line_width}) = GetTerminalSize(); } - MKDEBUG && _d('Line width:', $self->{line_width}); + PTDEBUG && _d('Line width:', $self->{line_width}); return bless $self, $class; } @@ -2445,7 +2445,7 @@ sub set_columns { if ( $col->{width} ) { $col->{width_pct} = ceil(($col->{width} * 100) / $self->{line_width}); - MKDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', + PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', $col->{width_pct}, '%'); } @@ -2453,7 +2453,7 @@ sub set_columns { $used_width += $col->{width_pct}; } else { - MKDEBUG && _d('Auto width col:', $col_name); + PTDEBUG && _d('Auto width col:', $col_name); $col->{auto_width} = 1; push @auto_width_cols, $i; } @@ -2482,15 +2482,15 @@ sub set_columns { if ( @auto_width_cols ) { my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols); - MKDEBUG && _d('Line width left:', (100-$used_width), '%;', + PTDEBUG && _d('Line width left:', (100-$used_width), '%;', 'each auto width col:', $wid_per_col, '%'); map { $self->{cols}->[$_]->{width_pct} = $wid_per_col } @auto_width_cols; } $min_hdr_wid += ($self->{n_cols} - 1) * length $self->{column_spacing}; - MKDEBUG && _d('min header width:', $min_hdr_wid); + PTDEBUG && _d('min header width:', $min_hdr_wid); if ( $min_hdr_wid > $self->{line_width} ) { - MKDEBUG && _d('Will truncate headers because min header width', + PTDEBUG && _d('Will truncate headers because min header width', $min_hdr_wid, '> line width', $self->{line_width}); $self->{truncate_headers} = 1; } @@ -2531,7 +2531,7 @@ sub get_report { my @col_fmts = $self->_make_column_formats(); my $fmt = ($self->{line_prefix} || '') . join($self->{column_spacing}, @col_fmts); - MKDEBUG && _d('Format:', $fmt); + PTDEBUG && _d('Format:', $fmt); (my $hdr_fmt = $fmt) =~ s/%([^-])/%-$1/g; @@ -2583,7 +2583,7 @@ sub truncate_value { $val = $mark . substr($val, -1 * $width + length $mark); } else { - MKDEBUG && _d("I don't know how to", $side, "truncate values"); + PTDEBUG && _d("I don't know how to", $side, "truncate values"); } return $val; } @@ -2595,27 +2595,27 @@ sub _calculate_column_widths { foreach my $col ( @{$self->{cols}} ) { my $print_width = int($self->{line_width} * ($col->{width_pct} / 100)); - MKDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, + PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, 'char width:', $print_width, 'min val:', $col->{min_val}, 'max val:', $col->{max_val}); if ( $col->{auto_width} ) { if ( $col->{min_val} && $print_width < $col->{min_val} ) { - MKDEBUG && _d('Increased to min val width:', $col->{min_val}); + PTDEBUG && _d('Increased to min val width:', $col->{min_val}); $print_width = $col->{min_val}; } elsif ( $col->{max_val} && $print_width > $col->{max_val} ) { - MKDEBUG && _d('Reduced to max val width:', $col->{max_val}); + PTDEBUG && _d('Reduced to max val width:', $col->{max_val}); $extra_space += $print_width - $col->{max_val}; $print_width = $col->{max_val}; } } $col->{print_width} = $print_width; - MKDEBUG && _d('print width:', $col->{print_width}); + PTDEBUG && _d('print width:', $col->{print_width}); } - MKDEBUG && _d('Extra space:', $extra_space); + PTDEBUG && _d('Extra space:', $extra_space); while ( $extra_space-- ) { foreach my $col ( @{$self->{cols}} ) { if ( $col->{auto_width} @@ -2638,7 +2638,7 @@ sub _truncate_headers { my $print_width = $col->{print_width}; next if length $col_name <= $print_width; $col->{name} = $self->truncate_value($col, $col_name, $print_width, $side); - MKDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, + PTDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, 'max width:', $print_width); } return; @@ -2663,7 +2663,7 @@ sub _truncate_line_values { my $print_width = $col->{print_width}; $val = $callback ? $callback->($col, $val, $print_width) : $self->truncate_value($col, $val, $print_width); - MKDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, + PTDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, '; max width:', $print_width); $vals->[$i] = $val; } @@ -2741,7 +2741,7 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub main { @ARGV = @_; # set global ARGV for this package @@ -2787,7 +2787,7 @@ sub main { my @config_names; # Human-readable names for those ^ objs foreach my $config_src ( @ARGV ) { if ( -f $config_src ) { - MKDEBUG && _d('Config source', $config_src, 'is a file'); + PTDEBUG && _d('Config source', $config_src, 'is a file'); push @configs, new MySQLConfig( file => $config_src, %common_modules, @@ -2795,7 +2795,7 @@ sub main { push @config_names, $config_src; # filename } else { - MKDEBUG && _d('Config source', $config_src, 'is a DSN'); + PTDEBUG && _d('Config source', $config_src, 'is a DSN'); my $dsn = $dp->parse($config_src, $last_dsn, $dsn_defaults); my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), {AutoCommit => 1}); $dp->fill_in_dsn($dbh, $dsn); @@ -2818,7 +2818,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -2850,10 +2850,10 @@ sub main { # }; } - MKDEBUG && _d("Comparing", scalar @configs, "configs"); + PTDEBUG && _d("Comparing", scalar @configs, "configs"); my $diffs = $config_cmp->diff(configs=>\@configs); my $n_diffs = scalar keys %$diffs; - MKDEBUG && _d($n_diffs, "differences found:", Dumper($diffs)); + PTDEBUG && _d($n_diffs, "differences found:", Dumper($diffs)); if ( $n_diffs ) { if ( $o->get('report') ) { foreach my $var ( sort keys %$diffs ) { diff --git a/bin/pt-deadlock-logger b/bin/pt-deadlock-logger index 4d6fa94a..53cc00c9 100755 --- a/bin/pt-deadlock-logger +++ b/bin/pt-deadlock-logger @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1057,7 +1057,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1068,7 +1068,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1086,7 +1086,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1098,7 +1098,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1130,7 +1130,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1207,7 +1207,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1230,7 +1230,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1248,7 +1248,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1257,10 +1257,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1272,23 +1272,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1319,7 +1319,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1369,7 +1369,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1414,7 +1414,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1424,21 +1424,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1450,15 +1450,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1476,7 +1476,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1502,7 +1502,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1563,7 +1563,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1581,17 +1581,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1633,19 +1633,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1663,7 +1663,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1683,7 +1683,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1696,7 +1696,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1705,10 +1705,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1750,7 +1750,7 @@ use List::Util qw(max); use Socket qw(inet_aton); use sigtrap qw(handler finish untrapped normal-signals); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $o; my $oktorun; @@ -1863,7 +1863,7 @@ sub main { # try to extract it from the $dbh if ( !$source_dsn->{h} ) { ($source_dsn->{h}) = $dbh->{mysql_hostinfo} =~ m/(\w+) via/; - MKDEBUG && _d('Got source host from dbh:', $source_dsn->{h}); + PTDEBUG && _d('Got source host from dbh:', $source_dsn->{h}); } my @cols = qw( server ts thread txn_id txn_time user hostname ip db tbl idx @@ -1882,14 +1882,14 @@ sub main { my $cols = join(',', map { $q->quote($_) } @cols); my $parms = join(',', map { '?' } @cols); my $sql = "INSERT IGNORE INTO $db_tbl($cols) VALUES($parms)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $ins_sth = $dest_dbh->prepare($sql); if ( $o->get('create-dest-table') ) { my $db_tbl = $q->quote($dest_dsn->{D}, $dest_dsn->{t}); $sql = $o->read_para_after(__FILE__, qr/MAGIC_dest_table/); $sql =~ s/deadlocks/IF NOT EXISTS $db_tbl/; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dest_dbh->do($sql); } } @@ -1899,7 +1899,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -1930,7 +1930,7 @@ sub main { } if ( $fingerprint ne $last_fingerprint ) { - MKDEBUG && _d('New deadlock'); + PTDEBUG && _d('New deadlock'); if ( $o->got('print') || !$o->got('dest') ) { my $sep = $o->get('tab') ? "\t" : ' '; print join($sep, @cols), "\n"; @@ -1945,14 +1945,14 @@ sub main { } } else { - MKDEBUG && _d('Same deadlock, not printing'); + PTDEBUG && _d('Same deadlock, not printing'); } # Save deadlock's fingerprint for next interval. $last_fingerprint = $fingerprint; # If specified, clear the deadlock... if ( my $db_tbl = $o->get('clear-deadlocks') ) { - MKDEBUG && _d('Creating --clear-deadlocks table', $db_tbl); + PTDEBUG && _d('Creating --clear-deadlocks table', $db_tbl); $dbh->{AutoCommit} = 0; my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/); @@ -1960,10 +1960,10 @@ sub main { $sql =~ s/ENGINE=/TYPE=/; } $sql =~ s/test.deadlock_maker/$db_tbl/; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); $sql = "INSERT INTO $db_tbl(a) VALUES(1)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); # I'm holding locks on the table now. # Fork off a child to try to take a lock on the table. @@ -1971,11 +1971,11 @@ sub main { if ( defined($pid) && $pid == 0 ) { # I am a child my $dbh_child = get_cxn($source_dsn, 0); $sql = "SELECT * FROM $db_tbl FOR UPDATE"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh_child->do($sql); }; # Should block against parent. - MKDEBUG && _d($EVAL_ERROR); # Parent inserted value 0. + PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0. $sql = "DROP TABLE $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh_child->do($sql); exit; } @@ -1984,9 +1984,9 @@ sub main { } sleep 1; $sql = "INSERT INTO $db_tbl(a) VALUES(0)";# Will make child deadlock - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); waitpid($pid, 0); } @@ -2146,7 +2146,7 @@ sub fingerprint { $fingerprint = $fingerprint . join('', map { $txn->{$_} } qw(server ts thread) ); } - MKDEBUG && _d('Deadlock fingerprint:', $fingerprint); + PTDEBUG && _d('Deadlock fingerprint:', $fingerprint); return $fingerprint; } diff --git a/bin/pt-duplicate-key-checker b/bin/pt-duplicate-key-checker index ce9625e4..ad2a53b9 100755 --- a/bin/pt-duplicate-key-checker +++ b/bin/pt-duplicate-key-checker @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # VersionParser package @@ -22,7 +22,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -32,7 +32,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -43,7 +43,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -61,7 +61,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -73,7 +73,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -105,7 +105,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -182,7 +182,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -227,7 +227,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -288,7 +288,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -306,7 +306,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -315,25 +315,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -347,66 +347,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -422,7 +422,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -448,7 +448,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -470,7 +470,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -538,7 +538,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -548,7 +548,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -583,7 +583,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -677,11 +677,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -693,12 +693,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -708,15 +708,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -726,11 +726,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -751,7 +751,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -763,11 +763,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -780,7 +780,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -799,7 +799,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -817,7 +817,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -843,7 +843,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -888,7 +888,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -911,7 +911,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -929,7 +929,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -938,10 +938,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -953,23 +953,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1000,7 +1000,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1050,7 +1050,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1095,7 +1095,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1105,21 +1105,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1131,15 +1131,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1157,7 +1157,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1183,7 +1183,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1244,7 +1244,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -1328,7 +1328,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -1372,7 +1372,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -1409,7 +1409,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -1418,7 +1418,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -1437,7 +1437,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -1445,7 +1445,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -1483,7 +1483,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -1496,7 +1496,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -1522,14 +1522,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -1538,13 +1538,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -1552,17 +1552,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -1576,7 +1576,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -1586,7 +1586,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -1600,7 +1600,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -1623,7 +1623,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -1652,7 +1652,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -1683,7 +1683,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -1750,7 +1750,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1799,7 +1799,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1823,12 +1823,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1837,23 +1837,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1862,7 +1862,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1872,7 +1872,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1946,11 +1946,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -2165,7 +2165,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -2175,7 +2175,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -2199,7 +2199,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -2212,7 +2212,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -2239,7 +2239,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -2269,7 +2269,7 @@ package KeySize; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2296,7 +2296,7 @@ sub get_key_size { } my $key_exists = $self->_key_exists(%args); - MKDEBUG && _d('Key', $name, 'exists in', $args{tbl_name}, ':', + PTDEBUG && _d('Key', $name, 'exists in', $args{tbl_name}, ':', $key_exists ? 'yes': 'no'); my $sql = 'EXPLAIN SELECT ' . join(', ', @cols) @@ -2312,7 +2312,7 @@ sub get_key_size { } $sql .= join(' OR ', @where_cols); $self->{query} = $sql; - MKDEBUG && _d('sql:', $sql); + PTDEBUG && _d('sql:', $sql); my $explain; my $sth = $dbh->prepare($sql); @@ -2328,7 +2328,7 @@ sub get_key_size { my $key_len = $explain->{key_len}; my $rows = $explain->{rows}; my $chosen_key = $explain->{key}; # May differ from $name - MKDEBUG && _d('MySQL chose key:', $chosen_key, 'len:', $key_len, + PTDEBUG && _d('MySQL chose key:', $chosen_key, 'len:', $key_len, 'rows:', $rows); my $key_size = 0; @@ -2404,7 +2404,7 @@ package DuplicateKeyFinder; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2431,14 +2431,14 @@ sub get_duplicate_keys { if ( $key->{name} eq 'PRIMARY' || ($args{clustered_key} && $key->{name} eq $args{clustered_key}) ) { $primary_key = $key; - MKDEBUG && _d('primary key:', $key->{name}); + PTDEBUG && _d('primary key:', $key->{name}); next KEY; } my $is_fulltext = $key->{type} eq 'FULLTEXT' ? 1 : 0; if ( $args{ignore_order} || $is_fulltext ) { my $ordered_cols = join(',', sort(split(/,/, $key->{colnames}))); - MKDEBUG && _d('Reordered', $key->{name}, 'cols from', + PTDEBUG && _d('Reordered', $key->{name}, 'cols from', $key->{colnames}, 'to', $ordered_cols); $key->{colnames} = $ordered_cols; } @@ -2453,42 +2453,42 @@ sub get_duplicate_keys { push @normal_keys, $self->unconstrain_keys($primary_key, \@unique_keys); if ( $primary_key ) { - MKDEBUG && _d('Comparing PRIMARY KEY to UNIQUE keys'); + PTDEBUG && _d('Comparing PRIMARY KEY to UNIQUE keys'); push @dupes, $self->remove_prefix_duplicates([$primary_key], \@unique_keys, %args); - MKDEBUG && _d('Comparing PRIMARY KEY to normal keys'); + PTDEBUG && _d('Comparing PRIMARY KEY to normal keys'); push @dupes, $self->remove_prefix_duplicates([$primary_key], \@normal_keys, %args); } - MKDEBUG && _d('Comparing UNIQUE keys to normal keys'); + PTDEBUG && _d('Comparing UNIQUE keys to normal keys'); push @dupes, $self->remove_prefix_duplicates(\@unique_keys, \@normal_keys, %args); - MKDEBUG && _d('Comparing normal keys'); + PTDEBUG && _d('Comparing normal keys'); push @dupes, $self->remove_prefix_duplicates(\@normal_keys, \@normal_keys, %args); - MKDEBUG && _d('Comparing FULLTEXT keys'); + PTDEBUG && _d('Comparing FULLTEXT keys'); push @dupes, $self->remove_prefix_duplicates(\@fulltext_keys, \@fulltext_keys, %args, exact_duplicates => 1); my $clustered_key = $args{clustered_key} ? $keys{$args{clustered_key}} : undef; - MKDEBUG && _d('clustered key:', $clustered_key->{name}, + PTDEBUG && _d('clustered key:', $clustered_key->{name}, $clustered_key->{colnames}); if ( $clustered_key && $args{clustered} && $args{tbl_info}->{engine} && $args{tbl_info}->{engine} =~ m/InnoDB/i ) { - MKDEBUG && _d('Removing UNIQUE dupes of clustered key'); + PTDEBUG && _d('Removing UNIQUE dupes of clustered key'); push @dupes, $self->remove_clustered_duplicates($clustered_key, \@unique_keys, %args); - MKDEBUG && _d('Removing ordinary dupes of clustered key'); + PTDEBUG && _d('Removing ordinary dupes of clustered key'); push @dupes, $self->remove_clustered_duplicates($clustered_key, \@normal_keys, %args); } @@ -2588,25 +2588,25 @@ sub remove_prefix_duplicates { my $right_cols = $right_keys->[$right_index]->{colnames}; my $right_len_cols = $right_keys->[$right_index]->{len_cols}; - MKDEBUG && _d('Comparing left', $left_name, '(',$left_cols,')', + PTDEBUG && _d('Comparing left', $left_name, '(',$left_cols,')', 'to right', $right_name, '(',$right_cols,')'); if ( substr($left_cols, 0, $right_len_cols) eq substr($right_cols, 0, $right_len_cols) ) { if ( $args{exact_duplicates} && ($right_len_cols<$left_len_cols) ) { - MKDEBUG && _d($right_name, 'not exact duplicate of', $left_name); + PTDEBUG && _d($right_name, 'not exact duplicate of', $left_name); next RIGHT_KEY; } if ( exists $right_keys->[$right_index]->{unique_col} ) { - MKDEBUG && _d('Cannot remove', $right_name, + PTDEBUG && _d('Cannot remove', $right_name, 'because is constrains col', $right_keys->[$right_index]->{cols}->[0]); next RIGHT_KEY; } - MKDEBUG && _d('Remove', $right_name); + PTDEBUG && _d('Remove', $right_name); my $reason; if ( $right_keys->[$right_index]->{unconstrained} ) { $reason .= "Uniqueness of $right_name ignored because " @@ -2634,12 +2634,12 @@ sub remove_prefix_duplicates { $args{callback}->($dupe, %args) if $args{callback}; } else { - MKDEBUG && _d($right_name, 'not left-prefix of', $left_name); + PTDEBUG && _d($right_name, 'not left-prefix of', $left_name); next LEFT_KEY; } } # RIGHT_KEY } # LEFT_KEY - MKDEBUG && _d('No more keys'); + PTDEBUG && _d('No more keys'); @$left_keys = grep { defined $_; } @$left_keys; @$right_keys = grep { defined $_; } @$right_keys; @@ -2658,7 +2658,7 @@ sub remove_clustered_duplicates { for my $i ( 0 .. @$keys - 1 ) { my $key = $keys->[$i]->{colnames}; if ( $key =~ m/$ck_cols$/ ) { - MKDEBUG && _d("clustered key dupe:", $keys->[$i]->{name}, + PTDEBUG && _d("clustered key dupe:", $keys->[$i]->{name}, $keys->[$i]->{colnames}); my $dupe = { key => $keys->[$i]->{name}, @@ -2681,7 +2681,7 @@ sub remove_clustered_duplicates { $args{callback}->($dupe, %args) if $args{callback}; } } - MKDEBUG && _d('No more keys'); + PTDEBUG && _d('No more keys'); @$keys = grep { defined $_; } @$keys; @@ -2704,14 +2704,14 @@ sub unconstrain_keys { my %unconstrain; my @unconstrained_keys; - MKDEBUG && _d('Unconstraining redundantly unique keys'); + PTDEBUG && _d('Unconstraining redundantly unique keys'); UNIQUE_KEY: foreach my $unique_key ( $primary_key, @$unique_keys ) { next unless $unique_key; # primary key may be undefined my $cols = $unique_key->{cols}; if ( @$cols == 1 ) { - MKDEBUG && _d($unique_key->{name},'defines unique column:',$cols->[0]); + PTDEBUG && _d($unique_key->{name},'defines unique column:',$cols->[0]); if ( !exists $unique_cols{$cols->[0]} ) { $unique_cols{$cols->[0]} = $unique_key; $unique_key->{unique_col} = 1; @@ -2719,7 +2719,7 @@ sub unconstrain_keys { } else { local $LIST_SEPARATOR = '-'; - MKDEBUG && _d($unique_key->{name}, 'defines unique set:', @$cols); + PTDEBUG && _d($unique_key->{name}, 'defines unique set:', @$cols); push @unique_sets, { cols => $cols, key => $unique_key }; } } @@ -2730,14 +2730,14 @@ sub unconstrain_keys { COL: foreach my $col ( @{$unique_set->{cols}} ) { if ( exists $unique_cols{$col} ) { - MKDEBUG && _d('Unique set', $unique_set->{key}->{name}, + PTDEBUG && _d('Unique set', $unique_set->{key}->{name}, 'has unique col', $col); last COL if ++$n_unique_cols > 1; $unique_set->{constraining_key} = $unique_cols{$col}; } } if ( $n_unique_cols && $unique_set->{key}->{name} ne 'PRIMARY' ) { - MKDEBUG && _d('Will unconstrain unique set', + PTDEBUG && _d('Will unconstrain unique set', $unique_set->{key}->{name}, 'because it is redundantly constrained by key', $unique_set->{constraining_key}->{name}, @@ -2749,7 +2749,7 @@ sub unconstrain_keys { for my $i ( 0..(scalar @$unique_keys-1) ) { if ( exists $unconstrain{$unique_keys->[$i]->{name}} ) { - MKDEBUG && _d('Unconstraining', $unique_keys->[$i]->{name}); + PTDEBUG && _d('Unconstraining', $unique_keys->[$i]->{name}); $unique_keys->[$i]->{unconstrained} = 1; $unique_keys->[$i]->{constraining_key} = $unconstrain{$unique_keys->[$i]->{name}}; @@ -2758,7 +2758,7 @@ sub unconstrain_keys { } } - MKDEBUG && _d('No more keys'); + PTDEBUG && _d('No more keys'); return @unconstrained_keys; } @@ -2790,7 +2790,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2808,17 +2808,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2860,19 +2860,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2890,7 +2890,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2910,7 +2910,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2923,7 +2923,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2932,10 +2932,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2976,7 +2976,7 @@ package Schema; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3038,7 +3038,7 @@ sub find_column { my ($col, $tbl, $db); if ( my $col_name = $args{col_name} ) { ($col, $tbl, $db) = reverse map { s/`//g; $_ } split /[.]/, $col_name; - MKDEBUG && _d('Column', $col_name, 'has db', $db, 'tbl', $tbl, + PTDEBUG && _d('Column', $col_name, 'has db', $db, 'tbl', $tbl, 'col', $col); } else { @@ -3050,18 +3050,18 @@ sub find_column { $col = lc $col; if ( !$col ) { - MKDEBUG && _d('No column specified or parsed'); + PTDEBUG && _d('No column specified or parsed'); return; } - MKDEBUG && _d('Finding column', $col, 'in', $db, $tbl); + PTDEBUG && _d('Finding column', $col, 'in', $db, $tbl); if ( $db && !$schema->{$db} ) { - MKDEBUG && _d('Database', $db, 'does not exist'); + PTDEBUG && _d('Database', $db, 'does not exist'); return; } if ( $db && $tbl && !$schema->{$db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'does not exist in database', $db); + PTDEBUG && _d('Table', $tbl, 'does not exist in database', $db); return; } @@ -3078,13 +3078,13 @@ sub find_column { if ( $ignore && grep { $_->{db} eq $search_db && $_->{tbl} eq $search_tbl } @$ignore ) { - MKDEBUG && _d('Ignoring', $search_db, $search_tbl, $col); + PTDEBUG && _d('Ignoring', $search_db, $search_tbl, $col); next TABLE; } my $tbl = $schema->{$search_db}->{$search_tbl}; if ( $tbl->{tbl_struct}->{is_col}->{$col} ) { - MKDEBUG && _d('Column', $col, 'exists in', $tbl->{db}, $tbl->{tbl}); + PTDEBUG && _d('Column', $col, 'exists in', $tbl->{db}, $tbl->{tbl}); push @tbls, $tbl; } } @@ -3101,7 +3101,7 @@ sub find_table { my ($tbl, $db); if ( my $tbl_name = $args{tbl_name} ) { ($tbl, $db) = reverse map { s/`//g; $_ } split /[.]/, $tbl_name; - MKDEBUG && _d('Table', $tbl_name, 'has db', $db, 'tbl', $tbl); + PTDEBUG && _d('Table', $tbl_name, 'has db', $db, 'tbl', $tbl); } else { ($tbl, $db) = @args{qw(tbl db)}; @@ -3111,18 +3111,18 @@ sub find_table { $tbl = lc $tbl; if ( !$tbl ) { - MKDEBUG && _d('No table specified or parsed'); + PTDEBUG && _d('No table specified or parsed'); return; } - MKDEBUG && _d('Finding table', $tbl, 'in', $db); + PTDEBUG && _d('Finding table', $tbl, 'in', $db); if ( $db && !$schema->{$db} ) { - MKDEBUG && _d('Database', $db, 'does not exist'); + PTDEBUG && _d('Database', $db, 'does not exist'); return; } if ( $db && $tbl && !$schema->{$db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'does not exist in database', $db); + PTDEBUG && _d('Table', $tbl, 'does not exist in database', $db); return; } @@ -3131,12 +3131,12 @@ sub find_table { DATABASE: foreach my $search_db ( @search_dbs ) { if ( $ignore && grep { $_->{db} eq $search_db } @$ignore ) { - MKDEBUG && _d('Ignoring', $search_db); + PTDEBUG && _d('Ignoring', $search_db); next DATABASE; } if ( exists $schema->{$search_db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'exists in', $search_db); + PTDEBUG && _d('Table', $tbl, 'exists in', $search_db); push @dbs, $search_db; } } @@ -3172,7 +3172,7 @@ package SchemaIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -3234,11 +3234,11 @@ sub _make_filters { if ( $is_table ) { my ($db, $tbl) = $q->split_unquote($obj); $db ||= '*'; - MKDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); + PTDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); $filters{$filter}->{$tbl} = $db; } else { # database - MKDEBUG && _d('Filter', $filter, 'value:', $obj); + PTDEBUG && _d('Filter', $filter, 'value:', $obj); $filters{$filter}->{$obj} = 1; } } @@ -3254,11 +3254,11 @@ sub _make_filters { my $pat = $o->get($filter); next REGEX_FILTER unless $pat; $filters{$filter} = qr/$pat/; - MKDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); + PTDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); } } - MKDEBUG && _d('Schema object filters:', Dumper(\%filters)); + PTDEBUG && _d('Schema object filters:', Dumper(\%filters)); return \%filters; } @@ -3286,7 +3286,7 @@ sub next_schema_object { } } - MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); + PTDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); return $schema_obj; } @@ -3296,14 +3296,14 @@ sub _iterate_files { if ( !$self->{fh} ) { my ($fh, $file) = $self->{file_itr}->(); if ( !$fh ) { - MKDEBUG && _d('No more files to iterate'); + PTDEBUG && _d('No more files to iterate'); return; } $self->{fh} = $fh; $self->{file} = $file; } my $fh = $self->{fh}; - MKDEBUG && _d('Getting next schema object from', $self->{file}); + PTDEBUG && _d('Getting next schema object from', $self->{file}); local $INPUT_RECORD_SEPARATOR = ''; CHUNK: @@ -3318,7 +3318,7 @@ sub _iterate_files { } elsif ($self->{db} && $chunk =~ m/CREATE TABLE/) { if ($chunk =~ m/DROP VIEW IF EXISTS/) { - MKDEBUG && _d('Table is a VIEW, skipping'); + PTDEBUG && _d('Table is a VIEW, skipping'); next CHUNK; } @@ -3346,7 +3346,7 @@ sub _iterate_files { } } # CHUNK - MKDEBUG && _d('No more schema objects in', $self->{file}); + PTDEBUG && _d('No more schema objects in', $self->{file}); close $self->{fh}; $self->{fh} = undef; @@ -3357,26 +3357,26 @@ sub _iterate_dbh { my ( $self ) = @_; my $q = $self->{Quoter}; my $dbh = $self->{dbh}; - MKDEBUG && _d('Getting next schema object from dbh', $dbh); + PTDEBUG && _d('Getting next schema object from dbh', $dbh); if ( !defined $self->{dbs} ) { my $sql = 'SHOW DATABASES'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @dbs = grep { $self->database_is_allowed($_) } @{$dbh->selectcol_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @dbs, 'databases'); + PTDEBUG && _d('Found', scalar @dbs, 'databases'); $self->{dbs} = \@dbs; } if ( !$self->{db} ) { $self->{db} = shift @{$self->{dbs}}; - MKDEBUG && _d('Next database:', $self->{db}); + PTDEBUG && _d('Next database:', $self->{db}); return unless $self->{db}; } if ( !defined $self->{tbls} ) { my $sql = 'SHOW /*!50002 FULL*/ TABLES FROM ' . $q->quote($self->{db}); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @tbls = map { $_->[0]; # (tbl, type) } @@ -3386,7 +3386,7 @@ sub _iterate_dbh { && (!$type || ($type ne 'VIEW')); } @{$dbh->selectall_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); + PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); $self->{tbls} = \@tbls; } @@ -3396,9 +3396,9 @@ sub _iterate_dbh { || $self->{filters}->{'ignore-engines'} ) { my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db}) . " LIKE \'$tbl\'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $engine = $dbh->selectrow_hashref($sql)->{engine}; - MKDEBUG && _d($tbl, 'uses', $engine, 'engine'); + PTDEBUG && _d($tbl, 'uses', $engine, 'engine'); } @@ -3416,7 +3416,7 @@ sub _iterate_dbh { } } - MKDEBUG && _d('No more tables in database', $self->{db}); + PTDEBUG && _d('No more tables in database', $self->{db}); $self->{db} = undef; $self->{tbls} = undef; @@ -3432,30 +3432,30 @@ sub database_is_allowed { my $filter = $self->{filters}; if ( $db =~ m/information_schema|performance_schema|lost\+found/ ) { - MKDEBUG && _d('Database', $db, 'is a system database, ignoring'); + PTDEBUG && _d('Database', $db, 'is a system database, ignoring'); return 0; } if ( $self->{filters}->{'ignore-databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is in --ignore-databases list'); + PTDEBUG && _d('Database', $db, 'is in --ignore-databases list'); return 0; } if ( $filter->{'ignore-databases-regex'} && $db =~ $filter->{'ignore-databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); + PTDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); return 0; } if ( $filter->{'databases'} && !$filter->{'databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); + PTDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); return 0; } if ( $filter->{'databases-regex'} && $db !~ $filter->{'databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); + PTDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); return 0; } @@ -3475,25 +3475,25 @@ sub table_is_allowed { if ( $filter->{'ignore-tables'}->{$tbl} && ($filter->{'ignore-tables'}->{$tbl} eq '*' || $filter->{'ignore-tables'}->{$tbl} eq $db) ) { - MKDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); + PTDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); return 0; } if ( $filter->{'ignore-tables-regex'} && $tbl =~ $filter->{'ignore-tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); + PTDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); return 0; } if ( $filter->{'tables'} && !$filter->{'tables'}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); + PTDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); return 0; } if ( $filter->{'tables-regex'} && $tbl !~ $filter->{'tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); + PTDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); return 0; } @@ -3501,7 +3501,7 @@ sub table_is_allowed { && $filter->{'tables'}->{$tbl} && $filter->{'tables'}->{$tbl} ne '*' && $filter->{'tables'}->{$tbl} ne $db ) { - MKDEBUG && _d('Table', $tbl, 'is only allowed in database', + PTDEBUG && _d('Table', $tbl, 'is only allowed in database', $filter->{'tables'}->{$tbl}); return 0; } @@ -3518,13 +3518,13 @@ sub engine_is_allowed { my $filter = $self->{filters}; if ( $filter->{'ignore-engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); + PTDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); return 0; } if ( $filter->{'engines'} && !$filter->{'engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); + PTDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); return 0; } @@ -3558,7 +3558,7 @@ package pt_duplicate_key_checker; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); @@ -3662,7 +3662,7 @@ sub main { print_all_keys($fks, $tbl, \%seen_tbl) if $fks; } else { - MKDEBUG && _d('Getting duplicate keys on', $tbl->{db}, $tbl->{tbl}); + PTDEBUG && _d('Getting duplicate keys on', $tbl->{db}, $tbl->{tbl}); eval { if ( $keys ) { $dk->get_duplicate_keys( @@ -3746,7 +3746,7 @@ sub print_duplicate_key { foreach my $arg ( qw(tbl_info dbh is_fk o ks q tp seen_tbl) ) { die "I need a $arg argument" unless exists $args{$arg}; } - MKDEBUG && _d('Printing duplicate key', $dupe->{key}); + PTDEBUG && _d('Printing duplicate key', $dupe->{key}); my $db = $args{tbl_info}->{db}; my $tbl = $args{tbl_info}->{tbl}; my $dbh = $args{dbh}; @@ -3776,7 +3776,7 @@ sub print_duplicate_key { my %seen; # print each column only once foreach my $col ( @{$dupe->{cols}}, @{$dupe->{duplicate_of_cols}} ) { next if $seen{$col}++; - MKDEBUG && _d('col', $col); + PTDEBUG && _d('col', $col); print "#\t" . lc($struct->{defs}->{lc $col}) . "\n"; } diff --git a/bin/pt-fifo-split b/bin/pt-fifo-split index ee32e061..3f6a497f 100755 --- a/bin/pt-fifo-split +++ b/bin/pt-fifo-split @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1065,17 +1065,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1117,19 +1117,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1147,7 +1147,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1167,7 +1167,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1180,7 +1180,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1189,10 +1189,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1233,7 +1233,7 @@ use English qw(-no_match_vars); use POSIX qw(mkfifo); use IO::File; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub main { @ARGV = @_; # set global ARGV for this package diff --git a/bin/pt-find b/bin/pt-find index abeb2de9..c493674e 100755 --- a/bin/pt-find +++ b/bin/pt-find @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -184,7 +184,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -229,7 +229,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -239,21 +239,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -265,15 +265,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -291,7 +291,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -317,7 +317,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -378,7 +378,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -462,7 +462,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -506,7 +506,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -543,7 +543,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -552,7 +552,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -571,7 +571,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -579,7 +579,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -617,7 +617,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -630,7 +630,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -656,14 +656,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -672,13 +672,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -686,17 +686,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -710,7 +710,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -720,7 +720,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -734,7 +734,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -757,7 +757,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -786,7 +786,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -817,7 +817,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -884,7 +884,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -933,7 +933,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -957,12 +957,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -971,23 +971,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -996,7 +996,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1006,7 +1006,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1080,11 +1080,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1299,7 +1299,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1309,7 +1309,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1333,7 +1333,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1346,7 +1346,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1373,7 +1373,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1403,7 +1403,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1480,7 +1480,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1490,7 +1490,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1501,7 +1501,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1519,7 +1519,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1531,7 +1531,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1563,7 +1563,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1608,7 +1608,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -1669,7 +1669,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -1687,7 +1687,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -1696,25 +1696,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -1728,66 +1728,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -1803,7 +1803,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -1829,7 +1829,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -1851,7 +1851,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -1919,7 +1919,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -1929,7 +1929,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -1964,7 +1964,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -2058,11 +2058,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -2074,12 +2074,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -2089,15 +2089,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -2107,11 +2107,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -2132,7 +2132,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -2144,11 +2144,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -2161,7 +2161,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -2180,7 +2180,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -2198,7 +2198,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -2224,7 +2224,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -2269,7 +2269,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2287,17 +2287,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2339,19 +2339,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2369,7 +2369,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2389,7 +2389,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2402,7 +2402,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2411,10 +2411,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2455,7 +2455,7 @@ use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; $OUTPUT_AUTOFLUSH = 1; @@ -2669,7 +2669,7 @@ my %action_for = ( my $sql = sprintf($fmt_for{exec}->{str}, map { defined $_ ? $_ : '' } @{$table}{@{$fmt_for{exec}->{arg_names}}}); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $exec_dbh->do($sql); }, printf => sub { @@ -2763,7 +2763,7 @@ sub main { # Discover if we need to parse SHOW CREATE TABLE. my $need_table_struct = grep { $o->got($_); } @table_struct_tests; - MKDEBUG && _d('Need table struct:', $need_table_struct); + PTDEBUG && _d('Need table struct:', $need_table_struct); if ( $need_table_struct ) { $du = new MySQLDump(); $tp = new TableParser(Quoter => $q); @@ -2842,7 +2842,7 @@ sub main { my $need_stored_code = $vp->version_ge($dbh, '5.0.0'); $need_stored_code = grep { $o->got($_); } @stored_code_tests if $need_stored_code; - MKDEBUG && _d('Need stored code:', $need_stored_code); + PTDEBUG && _d('Need stored code:', $need_stored_code); # ######################################################################## # Go do it. @@ -2889,14 +2889,14 @@ sub main { $table->{Database} = $database; if ( $need_table_struct ) { - MKDEBUG && _d('Getting table struct for', + PTDEBUG && _d('Getting table struct for', $database, '.', $table->{Name}); my $ddl = $du->get_create_table($dbh,$q, $database, $table->{Name}); if ( $ddl->[0] eq 'table' ) { my $table_struct; eval { $table_struct = $tp->parse($ddl) }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Failed to parse table:', $EVAL_ERROR); + PTDEBUG && _d('Failed to parse table:', $EVAL_ERROR); } $table->{struct} = $table_struct; } @@ -2913,7 +2913,7 @@ sub main { . " FROM INFORMATION_SCHEMA.ROUTINES " . " WHERE ROUTINE_SCHEMA = '$database' " . " AND ROUTINE_TYPE = '$type'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $codes = $dbh->selectall_arrayref($sql); foreach my $code ( @$codes ) { push @tables, { @@ -2931,7 +2931,7 @@ sub main { . " EVENT_MANIPULATION AS type " . " FROM INFORMATION_SCHEMA.TRIGGERS " . " WHERE EVENT_OBJECT_SCHEMA = '$database'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $trigs = $dbh->selectall_arrayref($sql); my $codes = $dbh->selectall_arrayref($sql); foreach my $trig ( @$trigs ) { diff --git a/bin/pt-fk-error-logger b/bin/pt-fk-error-logger index ac1c4c38..41b6f3db 100755 --- a/bin/pt-fk-error-logger +++ b/bin/pt-fk-error-logger @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1124,7 +1124,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1147,7 +1147,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1165,7 +1165,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1174,10 +1174,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1189,23 +1189,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1236,7 +1236,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1286,7 +1286,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1331,7 +1331,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1341,21 +1341,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1367,15 +1367,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1393,7 +1393,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1419,7 +1419,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1480,7 +1480,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1498,17 +1498,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1550,19 +1550,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1580,7 +1580,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1600,7 +1600,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1613,7 +1613,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1622,10 +1622,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1666,7 +1666,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1846,36 +1846,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1921,7 +1921,7 @@ package pt_fk_error_logger; use English qw(-no_match_vars); use sigtrap qw(handler finish untrapped normal-signals); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(parse_timestamp)); @@ -1990,7 +1990,7 @@ sub main { # try to extract it from the $dbh if ( !$src_dsn->{h} ) { ($src_dsn->{h}) = $dbh->{mysql_hostinfo} =~ m/(\w+) via/; - MKDEBUG && _d('Got source host from dbh:', $src_dsn->{h}); + PTDEBUG && _d('Got source host from dbh:', $src_dsn->{h}); } if ( $dst_dsn ) { @@ -2000,7 +2000,7 @@ sub main { ( $dst_dsn->{D}, $dst_dsn->{t} )); $dst_dbh = get_cxn($dst_dsn, 1, %modules); my $sql = "INSERT IGNORE INTO $db_tbl VALUES (?, ?)"; - MKDEBUG && _d('insert sql:', $sql); + PTDEBUG && _d('insert sql:', $sql); $ins_sth = $dst_dbh->prepare($sql); } @@ -2009,7 +2009,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -2029,13 +2029,13 @@ sub main { # Save and/or print the foreign key error. if ( $ins_sth ) { my $fk_ts = parse_timestamp($ts); - MKDEBUG && _d('Saving fk error', $ts, $fk_error); + PTDEBUG && _d('Saving fk error', $ts, $fk_error); eval { $ins_sth->execute($fk_ts, $fk_error); }; if ( $EVAL_ERROR ) { warn $EVAL_ERROR; - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } } print "$ts $fk_error\n\n" if $o->get('print') || !$o->got('dest'); @@ -2069,7 +2069,7 @@ sub get_fk_error { my ($ts, $fke) = $text =~ m/LATEST FOREIGN KEY ERROR.+?$idb_ts\s*(.+?)---/ms; chomp $fke if $fke; - MKDEBUG && _d('Latest fk error:', $ts, $fke); + PTDEBUG && _d('Latest fk error:', $ts, $fke); return $ts, $fke; } diff --git a/bin/pt-heartbeat b/bin/pt-heartbeat index 5db1947c..de6f1da9 100755 --- a/bin/pt-heartbeat +++ b/bin/pt-heartbeat @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # MasterSlave package @@ -22,7 +22,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -43,7 +43,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -52,15 +52,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -76,7 +76,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -94,23 +94,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -139,11 +139,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -172,7 +172,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -183,11 +183,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -202,7 +202,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -262,7 +262,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -271,7 +271,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -280,21 +280,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -315,17 +315,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -338,7 +338,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -347,13 +347,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -366,12 +366,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -383,7 +383,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -391,7 +391,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -399,7 +399,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -442,7 +442,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -504,12 +504,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -530,7 +530,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -540,14 +540,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -588,7 +588,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -637,7 +637,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -721,7 +721,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -765,7 +765,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -802,7 +802,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -811,7 +811,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -830,7 +830,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -838,7 +838,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -876,7 +876,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -889,7 +889,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -915,14 +915,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -931,13 +931,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -945,17 +945,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -969,7 +969,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -979,7 +979,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -993,7 +993,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -1016,7 +1016,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -1045,7 +1045,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -1076,7 +1076,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -1143,7 +1143,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1192,7 +1192,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1216,12 +1216,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1230,23 +1230,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1255,7 +1255,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1265,7 +1265,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1339,11 +1339,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1558,7 +1558,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1568,7 +1568,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1592,7 +1592,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1605,7 +1605,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1632,7 +1632,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1662,7 +1662,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1685,7 +1685,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1703,7 +1703,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1712,10 +1712,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1727,23 +1727,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1774,7 +1774,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1824,7 +1824,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1869,7 +1869,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1879,21 +1879,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1905,15 +1905,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1931,7 +1931,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1957,7 +1957,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -2018,7 +2018,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2036,17 +2036,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2088,19 +2088,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2118,7 +2118,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2138,7 +2138,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2151,7 +2151,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2160,10 +2160,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2204,7 +2204,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2281,7 +2281,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -2291,7 +2291,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -2302,7 +2302,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -2320,7 +2320,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -2332,7 +2332,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -2364,7 +2364,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2409,7 +2409,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -2470,7 +2470,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -2488,7 +2488,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -2497,25 +2497,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -2529,66 +2529,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -2604,7 +2604,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -2630,7 +2630,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -2652,7 +2652,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -2720,7 +2720,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -2730,7 +2730,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -2765,7 +2765,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -2945,36 +2945,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -3022,7 +3022,7 @@ use List::Util qw(min max sum); use Time::HiRes qw(gettimeofday time sleep usleep); use IO::File; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import qw(ts unix_timestamp); @@ -3103,7 +3103,7 @@ sub main { # Create --sentinel file if --stop was given, and possibly exit. # ######################################################################## if ( $o->get('stop') ) { - MKDEBUG && _d('Creating sentinel file', $sentinel); + PTDEBUG && _d('Creating sentinel file', $sentinel); my $file = IO::File->new($sentinel, ">>") or die "Cannot open $sentinel: $OS_ERROR\n"; print $file "Remove this file to permit pt-heartbeat to run\n" @@ -3113,16 +3113,16 @@ sub main { print STDOUT "Successfully created file $sentinel\n"; # Exit only if no other action (update, monitor, check) is given. if ( !$o->get('update') && !$o->get('check') && !$o->get('monitor') ) { - MKDEBUG && _d("Nothing more to do, quitting"); + PTDEBUG && _d("Nothing more to do, quitting"); return 0; } else { # Wait for all other running instances to quit, assuming they have the # same --interval as this invocation. Then remove the file and # continue. - MKDEBUG && _d("Waiting for other instances to quit"); + PTDEBUG && _d("Waiting for other instances to quit"); sleep $interval ; - MKDEBUG && _d("Unlinking", $sentinel); + PTDEBUG && _d("Unlinking", $sentinel); unlink $sentinel or die "Cannot unlink $sentinel: $OS_ERROR"; } @@ -3151,11 +3151,11 @@ sub main { if ( $o->get('create-table') ) { my $sql = $o->read_para_after(__FILE__, qr/MAGIC_create_heartbeat/); $sql =~ s/heartbeat/IF NOT EXISTS $db_tbl/; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); $sql = "INSERT INTO $db_tbl (ts, server_id) VALUES (NOW(), $server_id)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); # This may fail if the table already existed and already had this row. # We eval to ignore this possibility. eval { $dbh->do($sql); }; @@ -3171,7 +3171,7 @@ sub main { unless $tbl_struct->{is_col}->{ts}; my $hires_ts = $tbl_struct->{type_for}->{ts} =~ m/char/i ? 1 : 0; - MKDEBUG && _d("Hi-res ts:", ($hires_ts ? 'yes' : 'no')); + PTDEBUG && _d("Hi-res ts:", ($hires_ts ? 'yes' : 'no')); my $id = $tbl_struct->{is_col}->{id}; # legacy table struct die "Heartbeat table $db_tbl does not have a server_id or id column" @@ -3216,7 +3216,7 @@ sub main { $master_dbh->disconnect; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Error determining master id:", $EVAL_ERROR); + PTDEBUG && _d("Error determining master id:", $EVAL_ERROR); } } if ( !$master_server_id ) { @@ -3233,20 +3233,20 @@ sub main { else { die "Heartbeat table $db_tbl does not have a server_id or id column"; } - MKDEBUG && _d('Heartbeat row primary key:', $pk_col, '=', $pk_val); + PTDEBUG && _d('Heartbeat row primary key:', $pk_col, '=', $pk_val); # Check that heartbeat table has at least 1 row unless --replace because # --replace will create the row if it doesn't exist. if ( !$o->get('replace') ) { my $sql = "SELECT 1 FROM $db_tbl WHERE $pk_col='$pk_val' LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row = $dbh->selectall_arrayref($sql); if ( scalar @$row == 0 ) { - MKDEBUG && _d('No heartbeat row in table'); + PTDEBUG && _d('No heartbeat row in table'); if ( $o->get('insert-heartbeat-row') ) { my $sql = "INSERT INTO $db_tbl ($pk_col, ts) " . "VALUES ('$pk_val', NOW())"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } else { @@ -3275,11 +3275,11 @@ sub main { if ( $o->get('update') ) { my @master_status_cols = grep { $tbl_struct->{is_col}->{$_} } qw(file position); - MKDEBUG && _d("Master status columns:", join(', ', @master_status_cols)); + PTDEBUG && _d("Master status columns:", join(', ', @master_status_cols)); my @slave_status_cols = grep { $tbl_struct->{is_col}->{$_} } qw(relay_master_log_file exec_master_log_pos); - MKDEBUG && _d("Slave status columns:", join(', ', @slave_status_cols)); + PTDEBUG && _d("Slave status columns:", join(', ', @slave_status_cols)); # Just a shortcut so I don't have to check both arrays when creating # SQL statement below. @@ -3299,7 +3299,7 @@ sub main { . (@extra_cols ? ", " . join(', ', map { "$_=?" } @extra_cols) : "") . " WHERE $pk_col='$pk_val'"; } - MKDEBUG && _d("UPDATE SQL:", $heartbeat_sql); + PTDEBUG && _d("UPDATE SQL:", $heartbeat_sql); $heartbeat_sth = $dbh->prepare($heartbeat_sql); @@ -3310,10 +3310,10 @@ sub main { my $sql; if ( @master_status_cols ) { $sql = "SHOW MASTER STATUS"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_hashref($sql); if ( !$row ) { - MKDEBUG && _d("No row from", $sql); + PTDEBUG && _d("No row from", $sql); push @vals, map { undef } @master_status_cols; } else { @@ -3323,10 +3323,10 @@ sub main { if ( @slave_status_cols ) { $sql = "SHOW SLAVE STATUS"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_hashref($sql); if ( !$row ) { - MKDEBUG && _d("No row from", $sql); + PTDEBUG && _d("No row from", $sql); push @vals, map { undef } @slave_status_cols; } else { @@ -3335,7 +3335,7 @@ sub main { } $sth->execute(ts(time), @vals); - MKDEBUG && _d($sth->{Statement}); + PTDEBUG && _d($sth->{Statement}); $sth->finish(); return; @@ -3351,22 +3351,22 @@ sub main { . " FROM $db_tbl " . "WHERE $pk_col='$pk_val' " . "LIMIT 1"; - MKDEBUG && _d("SELECT SQL:", $heartbeat_sql); + PTDEBUG && _d("SELECT SQL:", $heartbeat_sql); $heartbeat_sth = $dbh->prepare($heartbeat_sql); $get_delay = sub { my ($sth) = @_; $sth->execute(); - MKDEBUG && _d($sth->{Statement}); + PTDEBUG && _d($sth->{Statement}); my ($ts, $hostname, $server_id) = $sth->fetchrow_array(); my $now = time; - MKDEBUG && _d("Heartbeat from server", $server_id, "\n", + PTDEBUG && _d("Heartbeat from server", $server_id, "\n", " now:", ts($now), "\n", " ts:", $ts, "\n", "skew:", $skew); my $delay = $now - unix_timestamp($ts) - $skew; - MKDEBUG && _d('Delay', sprintf('%.6f', $delay), 'on', $hostname); + PTDEBUG && _d('Delay', sprintf('%.6f', $delay), 'on', $hostname); # Because we adjust for skew, if the ts are less than skew seconds # apart (i.e. replication is very fast) then delay will be negative. @@ -3395,7 +3395,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -3407,7 +3407,7 @@ sub main { # --check and exit if --check was given. # ######################################################################## if ( $o->get('check') ) { - MKDEBUG && _d('--check and exit'); + PTDEBUG && _d('--check and exit'); check_delay( dsn => $dsn, dbh => $dbh, @@ -3440,7 +3440,7 @@ sub main { # Monitor or update the heartbeat table. # ######################################################################## my $end = $o->get('run-time') ? int(time + $o->get('run-time')) : 0; - MKDEBUG && _d($end ? ('Will exit at', ts($end)) : 'Running forever'); + PTDEBUG && _d($end ? ('Will exit at', ts($end)) : 'Running forever'); my $get_next_interval = make_interval_iter($interval, $skew); @@ -3453,11 +3453,11 @@ sub main { if ( time >= $next_interval ) { do { $next_interval = $get_next_interval->() } until $next_interval > time; - MKDEBUG && _d("Missed last interval; next interval:", + PTDEBUG && _d("Missed last interval; next interval:", ts($next_interval)); } sleep $next_interval - time; - MKDEBUG && _d('Woke up at', ts(time)); + PTDEBUG && _d('Woke up at', ts(time)); # Connect or reconnect if necessary. if ( !$dbh->ping() ) { @@ -3528,11 +3528,11 @@ sub check_delay { } my ($dsn, $dbh, $sth, $sql, $get_delay, $interval, $skew, $o, $dp) = @args{@required_args}; - MKDEBUG && _d('Checking slave delay'); + PTDEBUG && _d('Checking slave delay'); # Collect a list of connections to the slaves. if ( $o->get('recurse') ) { - MKDEBUG && _d('Recursing to slaves'); + PTDEBUG && _d('Recursing to slaves'); my $vp = new VersionParser(); my $ms = new MasterSlave(VersionParser => $vp); $ms->recurse_to_slaves( @@ -3543,7 +3543,7 @@ sub check_delay { callback => sub { my ( $dsn, $dbh, $level ) = @_; push @dbhs, $dbh; - MKDEBUG && _d("Found slave", $dp->as_string($dsn)); + PTDEBUG && _d("Found slave", $dp->as_string($dsn)); push @sths, [ $dsn, $dbh->prepare($sql) ]; }, method => $o->get('recursion-method'), @@ -3568,17 +3568,17 @@ sub check_delay { SLAVE: foreach my $thing ( @sths ) { my ( $dsn, $sth ) = @$thing; - MKDEBUG && _d('Checking slave', $dp->as_string($dsn)); + PTDEBUG && _d('Checking slave', $dp->as_string($dsn)); my $next_interval = $get_next_interval->(); if ( time >= $next_interval ) { do { $next_interval = $get_next_interval->() } until $next_interval > time; - MKDEBUG && _d("Missed last interval; next interval:", + PTDEBUG && _d("Missed last interval; next interval:", ts($next_interval)); } sleep $next_interval - time; - MKDEBUG && _d('Woke up at', ts(time)); + PTDEBUG && _d('Woke up at', ts(time)); my ($delay, $hostname, $master_server_id) = $get_delay->($sth); if ( $o->get('recurse') ) { @@ -3623,7 +3623,7 @@ sub make_interval_iter { sub disconnect { my ( $dbh, $sth ) = @_; - MKDEBUG && _d('Disconnecting'); + PTDEBUG && _d('Disconnecting'); $sth->finish() if $sth; foreach my $handle ( @sths ) { my $sth = $handle->[1]; @@ -4091,7 +4091,7 @@ soon as possible after the beginning of the second on the master, this allows one half second of replication delay before reporting that the slave lags the master by one second. If your clocks are not completely accurate or there is some other reason you'd like to delay the slave more or less, you can tweak this -value. Try setting the C environment variable to see the effect this +value. Try setting the C environment variable to see the effect this has. =item --socket diff --git a/bin/pt-index-usage b/bin/pt-index-usage index fc6af344..d6c6bc72 100755 --- a/bin/pt-index-usage +++ b/bin/pt-index-usage @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -184,7 +184,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -229,7 +229,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -239,21 +239,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -265,15 +265,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -291,7 +291,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -317,7 +317,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -378,7 +378,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -455,7 +455,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -539,7 +539,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -583,7 +583,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -620,7 +620,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -629,7 +629,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -648,7 +648,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -656,7 +656,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -694,7 +694,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -707,7 +707,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -733,14 +733,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -749,13 +749,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -763,17 +763,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -787,7 +787,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -797,7 +797,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -811,7 +811,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -834,7 +834,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -863,7 +863,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -894,7 +894,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -961,7 +961,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1010,7 +1010,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1034,12 +1034,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1048,23 +1048,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1073,7 +1073,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1083,7 +1083,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1157,11 +1157,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1376,7 +1376,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1386,7 +1386,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1410,7 +1410,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1423,7 +1423,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1450,7 +1450,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1480,7 +1480,7 @@ package PodParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my %parse_items_from = ( 'OPTIONS' => 1, @@ -1525,7 +1525,7 @@ sub get_magic { sub parse_from_file { my ( $self, $file ) = @_; return unless $file; - MKDEBUG && _d('Parsing POD in', $file); + PTDEBUG && _d('Parsing POD in', $file); open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs my $para; @@ -1537,7 +1537,7 @@ sub parse_from_file { if ( $para =~ m/^=(head|item|over|back)/ ) { my ($cmd, $name) = $para =~ m/^=(\w+)(?:\s+(.+))?/; $name ||= ''; - MKDEBUG && _d('cmd:', $cmd, 'name:', $name); + PTDEBUG && _d('cmd:', $cmd, 'name:', $name); $self->command($cmd, $name); } elsif ( $parse_items_from{$self->{current_section}} ) { @@ -1554,12 +1554,12 @@ sub command { $name =~ s/\s+\Z//m; # Remove \n and blank line after name. if ( $cmd eq 'head1' ) { - MKDEBUG && _d('In section', $name); + PTDEBUG && _d('In section', $name); $self->{current_section} = $name; } elsif ( $cmd eq 'over' ) { if ( $parse_items_from{$name} ) { - MKDEBUG && _d('Start items in', $self->{current_section}); + PTDEBUG && _d('Start items in', $self->{current_section}); $self->{items}->{$self->{current_section}} = {}; } } @@ -1567,7 +1567,7 @@ sub command { my $pat = $item_pattern_for{ $self->{current_section} }; my ($item) = $name =~ m/$pat/; if ( $item ) { - MKDEBUG && _d($self->{current_section}, 'item:', $item); + PTDEBUG && _d($self->{current_section}, 'item:', $item); $self->{items}->{ $self->{current_section} }->{$item} = { desc => '', # every item should have a desc }; @@ -1579,7 +1579,7 @@ sub command { } elsif ( $cmd eq 'back' ) { if ( $parse_items_from{$self->{current_section}} ) { - MKDEBUG && _d('End items in', $self->{current_section}); + PTDEBUG && _d('End items in', $self->{current_section}); } } else { @@ -1600,7 +1600,7 @@ sub textblock { $para =~ s/\s+\Z//; if ( $para =~ m/^[a-z]\w+[:;] / ) { - MKDEBUG && _d('Item attributes:', $para); + PTDEBUG && _d('Item attributes:', $para); map { my ($attrib, $val) = split(/: /, $_); $item->{$attrib} = defined $val ? $val : 1; @@ -1614,26 +1614,26 @@ sub textblock { if ( $indent ) { $para =~ s/^\s{$indent}//mg; $para =~ s/\s+$//; - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); $self->{magic}->{$self->{current_section}}->{$self->{magic_ident}} = $para; } else { - MKDEBUG && _d("MAGIC", $self->{magic_ident}, + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para is not indented; treating as normal para"); } $self->{magic_ident} = ''; # must unset this! } - MKDEBUG && _d('Item desc:', substr($para, 0, 40), + PTDEBUG && _d('Item desc:', substr($para, 0, 40), length($para) > 40 ? '...' : ''); $para =~ s/\n+/ /g; $item->{desc} .= $para; if ( $para =~ m/MAGIC_(\w+)/ ) { $self->{magic_ident} = $1; # XXX - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); } } @@ -1673,7 +1673,7 @@ package QueryParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $tbl_ident = qr/(?:`[^`]+`|\w+)(?:\.(?:`[^`]+`|\w+))?/; our $tbl_regex = qr{ @@ -1701,33 +1701,33 @@ sub new { sub get_tables { my ( $self, $query ) = @_; return unless $query; - MKDEBUG && _d('Getting tables for', $query); + PTDEBUG && _d('Getting tables for', $query); my ( $ddl_stmt ) = $query =~ m/^\s*($data_def_stmts)\b/i; if ( $ddl_stmt ) { - MKDEBUG && _d('Special table type:', $ddl_stmt); + PTDEBUG && _d('Special table type:', $ddl_stmt); $query =~ s/IF\s+(?:NOT\s+)?EXISTS//i; if ( $query =~ m/$ddl_stmt DATABASE\b/i ) { - MKDEBUG && _d('Query alters a database, not a table'); + PTDEBUG && _d('Query alters a database, not a table'); return (); } if ( $ddl_stmt =~ m/CREATE/i && $query =~ m/$ddl_stmt\b.+?\bSELECT\b/i ) { my ($select) = $query =~ m/\b(SELECT\b.+)/is; - MKDEBUG && _d('CREATE TABLE ... SELECT:', $select); + PTDEBUG && _d('CREATE TABLE ... SELECT:', $select); return $self->get_tables($select); } my ($tbl) = $query =~ m/TABLE\s+($tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches table:', $tbl); + PTDEBUG && _d('Matches table:', $tbl); return ($tbl); } $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; if ( $query =~ /^\s*LOCK TABLES/i ) { - MKDEBUG && _d('Special table type: LOCK TABLES'); + PTDEBUG && _d('Special table type: LOCK TABLES'); $query =~ s/^(\s*LOCK TABLES\s+)//; $query =~ s/\s+(?:READ|WRITE|LOCAL)+\s*//g; - MKDEBUG && _d('Locked tables:', $query); + PTDEBUG && _d('Locked tables:', $query); $query = "FROM $query"; } @@ -1737,7 +1737,7 @@ sub get_tables { my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { - MKDEBUG && _d('Match tables:', $tbls); + PTDEBUG && _d('Match tables:', $tbls); next if $tbls =~ m/\ASELECT\b/i; @@ -1745,7 +1745,7 @@ sub get_tables { $tbl =~ s/\s*($tbl_ident)(\s+.*)?/$1/gio; if ( $tbl !~ m/[a-zA-Z]/ ) { - MKDEBUG && _d('Skipping suspicious table name:', $tbl); + PTDEBUG && _d('Skipping suspicious table name:', $tbl); next; } @@ -1758,7 +1758,7 @@ sub get_tables { sub has_derived_table { my ( $self, $query ) = @_; my $match = $query =~ m/$has_derived/; - MKDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); + PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); return $match; } @@ -1791,7 +1791,7 @@ sub get_aliases { $tbl_refs =~ s/\([^\)]+\)\s*//; } - MKDEBUG && _d('tbl refs:', $tbl_refs); + PTDEBUG && _d('tbl refs:', $tbl_refs); my $before_tbl = qr/(?:,|JOIN|\s|$from)+/i; @@ -1807,12 +1807,12 @@ sub get_aliases { }xgio ) { my ( $tbl_ref, $db_tbl, $alias ) = ($1, $2, $3); - MKDEBUG && _d('Match table:', $tbl_ref); + PTDEBUG && _d('Match table:', $tbl_ref); push @tbl_refs, $tbl_ref; $alias = $self->trim_identifier($alias); if ( $tbl_ref =~ m/^AS\s+\w+/i ) { - MKDEBUG && _d('Subquery', $tbl_ref); + PTDEBUG && _d('Subquery', $tbl_ref); $result->{TABLE}->{$alias} = undef; next; } @@ -1825,7 +1825,7 @@ sub get_aliases { } } else { - MKDEBUG && _d("No tables ref in", $query); + PTDEBUG && _d("No tables ref in", $query); } if ( $list ) { @@ -1840,7 +1840,7 @@ sub split { my ( $self, $query ) = @_; return unless $query; $query = $self->clean_query($query); - MKDEBUG && _d('Splitting', $query); + PTDEBUG && _d('Splitting', $query); my $verbs = qr{SELECT|INSERT|UPDATE|DELETE|REPLACE|UNION|CREATE}i; @@ -1860,7 +1860,7 @@ sub split { } } - MKDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); + PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); return @statements; } @@ -1886,12 +1886,12 @@ sub split_subquery { while ( $query =~ m/(\S+)(?:\s+|\Z)/g ) { $pos = pos($query); my $word = $1; - MKDEBUG && _d($word, $sqno); + PTDEBUG && _d($word, $sqno); if ( $word =~ m/^\(?SELECT\b/i ) { my $start_pos = $pos - length($word) - 1; if ( $start_pos ) { $sqno++; - MKDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); + PTDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); $subqueries[$sqno] = { start_pos => $start_pos, end_pos => 0, @@ -1903,25 +1903,25 @@ sub split_subquery { }; } else { - MKDEBUG && _d('Main SELECT at pos 0'); + PTDEBUG && _d('Main SELECT at pos 0'); } } else { next unless $sqno; # next unless we're in a subquery - MKDEBUG && _d('In subquery', $sqno); + PTDEBUG && _d('In subquery', $sqno); my $sq = $subqueries[$sqno]; if ( $sq->{done} ) { - MKDEBUG && _d('This subquery is done; SQL is for', + PTDEBUG && _d('This subquery is done; SQL is for', ($sqno - 1 ? "subquery $sqno" : "the main SELECT")); next; } push @{$sq->{words}}, $word; my $lp = ($word =~ tr/\(//) || 0; my $rp = ($word =~ tr/\)//) || 0; - MKDEBUG && _d('parentheses left', $lp, 'right', $rp); + PTDEBUG && _d('parentheses left', $lp, 'right', $rp); if ( ($sq->{lp} + $lp) - ($sq->{rp} + $rp) == 0 ) { my $end_pos = $pos - 1; - MKDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); + PTDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); $sq->{end_pos} = $end_pos; $sq->{len} = $end_pos - $sq->{start_pos}; } @@ -1987,7 +1987,7 @@ sub get_columns { ($cols_def) = $query =~ m/\(([^\)]+)\)\s*VALUE/i; } - MKDEBUG && _d('Columns:', $cols_def); + PTDEBUG && _d('Columns:', $cols_def); if ( $cols_def ) { @$cols = split(',', $cols_def); map { @@ -2028,7 +2028,7 @@ sub extract_tables { my $default_db = $args{default_db}; my $q = $self->{Quoter} || $args{Quoter}; return unless $query; - MKDEBUG && _d('Extracting tables'); + PTDEBUG && _d('Extracting tables'); my @tables; my %seen; foreach my $db_tbl ( $self->get_tables($query) ) { @@ -2077,7 +2077,7 @@ package QueryRewriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; @@ -2226,7 +2226,7 @@ sub distill_verbs { $query = $self->strip_comments($query); if ( $query =~ m/\A\s*SHOW\s+/i ) { - MKDEBUG && _d($query); + PTDEBUG && _d($query); $query = uc $query; $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; @@ -2236,7 +2236,7 @@ sub distill_verbs { $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; $query =~ s/\s+/ /g; - MKDEBUG && _d($query); + PTDEBUG && _d($query); return $query; } @@ -2246,10 +2246,10 @@ sub distill_verbs { if ( $dds) { my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; $obj = uc $obj if $obj; - MKDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); + PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); my ($db_or_tbl) = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches db or table:', $db_or_tbl); + PTDEBUG && _d('Matches db or table:', $db_or_tbl); return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; } @@ -2260,7 +2260,7 @@ sub distill_verbs { }; if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - MKDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); + PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); my $union = grep { $_ eq 'UNION' } @verbs; @verbs = $union ? qw(SELECT UNION) : qw(SELECT); } @@ -2387,12 +2387,12 @@ sub __delete_to_select { sub __insert_to_select { my ( $tbl, $cols, $vals ) = @_; - MKDEBUG && _d('Args:', @_); + PTDEBUG && _d('Args:', @_); my @cols = split(/,/, $cols); - MKDEBUG && _d('Cols:', @cols); + PTDEBUG && _d('Cols:', @cols); $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - MKDEBUG && _d('Vals:', @vals); + PTDEBUG && _d('Vals:', @vals); if ( @cols == @vals ) { return "select * from $tbl where " . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); @@ -2451,7 +2451,7 @@ package SlowLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2503,7 +2503,7 @@ sub parse_event { if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); if ( @chunks > 1 ) { - MKDEBUG && _d("Found multiple chunks"); + PTDEBUG && _d("Found multiple chunks"); $stmt = shift @chunks; unshift @$pending, @chunks; } @@ -2521,18 +2521,18 @@ sub parse_event { while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - MKDEBUG && _d("Got ts", $time); + PTDEBUG && _d("Got ts", $time); push @properties, 'ts', $time; ++$got_ts; if ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } @@ -2541,13 +2541,13 @@ sub parse_event { elsif ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - MKDEBUG && _d("Got admin command"); + PTDEBUG && _d("Got admin command"); $line =~ s/^#\s+//; # string leading "# ". push @properties, 'cmd', 'Admin', 'arg', $line; push @properties, 'bytes', length($properties[-1]); @@ -2556,12 +2556,12 @@ sub parse_event { } elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - MKDEBUG && _d("Got some line with properties"); + PTDEBUG && _d("Got some line with properties"); if ( $line =~ m/Schema:\s+\w+: / ) { - MKDEBUG && _d('Removing empty Schema attrib'); + PTDEBUG && _d('Removing empty Schema attrib'); $line =~ s/Schema:\s+//; - MKDEBUG && _d($line); + PTDEBUG && _d($line); } my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; @@ -2569,36 +2569,36 @@ sub parse_event { } elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; ++$got_db; } elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, split(/,|\s*=\s*/, $setting); ++$got_set; } if ( !$found_arg && $pos == $len ) { - MKDEBUG && _d("Did not find arg, looking for special cases"); + PTDEBUG && _d("Did not find arg, looking for special cases"); local $INPUT_RECORD_SEPARATOR = ";\n"; if ( defined(my $l = $next_event->()) ) { chomp $l; $l =~ s/^\s+//; - MKDEBUG && _d("Found admin statement", $l); + PTDEBUG && _d("Found admin statement", $l); push @properties, 'cmd', 'Admin', 'arg', $l; push @properties, 'bytes', length($properties[-1]); $found_arg++; } else { - MKDEBUG && _d("I can't figure out what to do with this line"); + PTDEBUG && _d("I can't figure out what to do with this line"); next EVENT; } } } else { - MKDEBUG && _d("Got the query/arg line"); + PTDEBUG && _d("Got the query/arg line"); my $arg = substr($stmt, $pos - length($line)); push @properties, 'arg', $arg, 'bytes', length($arg); if ( $args{misc} && $args{misc}->{embed} @@ -2610,7 +2610,7 @@ sub parse_event { } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -2652,7 +2652,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2697,7 +2697,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -2758,7 +2758,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -2776,7 +2776,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -2785,25 +2785,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -2817,66 +2817,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -2892,7 +2892,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -2918,7 +2918,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -2940,7 +2940,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -3008,7 +3008,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -3018,7 +3018,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -3053,7 +3053,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -3233,36 +3233,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -3309,7 +3309,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -3319,7 +3319,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -3330,7 +3330,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -3348,7 +3348,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -3360,7 +3360,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -3392,7 +3392,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -3486,11 +3486,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -3502,12 +3502,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -3517,15 +3517,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -3535,11 +3535,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -3560,7 +3560,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -3572,11 +3572,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -3589,7 +3589,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -3608,7 +3608,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -3626,7 +3626,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -3652,7 +3652,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -3697,7 +3697,7 @@ package Schema; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3759,7 +3759,7 @@ sub find_column { my ($col, $tbl, $db); if ( my $col_name = $args{col_name} ) { ($col, $tbl, $db) = reverse map { s/`//g; $_ } split /[.]/, $col_name; - MKDEBUG && _d('Column', $col_name, 'has db', $db, 'tbl', $tbl, + PTDEBUG && _d('Column', $col_name, 'has db', $db, 'tbl', $tbl, 'col', $col); } else { @@ -3771,18 +3771,18 @@ sub find_column { $col = lc $col; if ( !$col ) { - MKDEBUG && _d('No column specified or parsed'); + PTDEBUG && _d('No column specified or parsed'); return; } - MKDEBUG && _d('Finding column', $col, 'in', $db, $tbl); + PTDEBUG && _d('Finding column', $col, 'in', $db, $tbl); if ( $db && !$schema->{$db} ) { - MKDEBUG && _d('Database', $db, 'does not exist'); + PTDEBUG && _d('Database', $db, 'does not exist'); return; } if ( $db && $tbl && !$schema->{$db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'does not exist in database', $db); + PTDEBUG && _d('Table', $tbl, 'does not exist in database', $db); return; } @@ -3799,13 +3799,13 @@ sub find_column { if ( $ignore && grep { $_->{db} eq $search_db && $_->{tbl} eq $search_tbl } @$ignore ) { - MKDEBUG && _d('Ignoring', $search_db, $search_tbl, $col); + PTDEBUG && _d('Ignoring', $search_db, $search_tbl, $col); next TABLE; } my $tbl = $schema->{$search_db}->{$search_tbl}; if ( $tbl->{tbl_struct}->{is_col}->{$col} ) { - MKDEBUG && _d('Column', $col, 'exists in', $tbl->{db}, $tbl->{tbl}); + PTDEBUG && _d('Column', $col, 'exists in', $tbl->{db}, $tbl->{tbl}); push @tbls, $tbl; } } @@ -3822,7 +3822,7 @@ sub find_table { my ($tbl, $db); if ( my $tbl_name = $args{tbl_name} ) { ($tbl, $db) = reverse map { s/`//g; $_ } split /[.]/, $tbl_name; - MKDEBUG && _d('Table', $tbl_name, 'has db', $db, 'tbl', $tbl); + PTDEBUG && _d('Table', $tbl_name, 'has db', $db, 'tbl', $tbl); } else { ($tbl, $db) = @args{qw(tbl db)}; @@ -3832,18 +3832,18 @@ sub find_table { $tbl = lc $tbl; if ( !$tbl ) { - MKDEBUG && _d('No table specified or parsed'); + PTDEBUG && _d('No table specified or parsed'); return; } - MKDEBUG && _d('Finding table', $tbl, 'in', $db); + PTDEBUG && _d('Finding table', $tbl, 'in', $db); if ( $db && !$schema->{$db} ) { - MKDEBUG && _d('Database', $db, 'does not exist'); + PTDEBUG && _d('Database', $db, 'does not exist'); return; } if ( $db && $tbl && !$schema->{$db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'does not exist in database', $db); + PTDEBUG && _d('Table', $tbl, 'does not exist in database', $db); return; } @@ -3852,12 +3852,12 @@ sub find_table { DATABASE: foreach my $search_db ( @search_dbs ) { if ( $ignore && grep { $_->{db} eq $search_db } @$ignore ) { - MKDEBUG && _d('Ignoring', $search_db); + PTDEBUG && _d('Ignoring', $search_db); next DATABASE; } if ( exists $schema->{$search_db}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'exists in', $search_db); + PTDEBUG && _d('Table', $tbl, 'exists in', $search_db); push @dbs, $search_db; } } @@ -3893,7 +3893,7 @@ package SchemaIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -3955,11 +3955,11 @@ sub _make_filters { if ( $is_table ) { my ($db, $tbl) = $q->split_unquote($obj); $db ||= '*'; - MKDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); + PTDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); $filters{$filter}->{$tbl} = $db; } else { # database - MKDEBUG && _d('Filter', $filter, 'value:', $obj); + PTDEBUG && _d('Filter', $filter, 'value:', $obj); $filters{$filter}->{$obj} = 1; } } @@ -3975,11 +3975,11 @@ sub _make_filters { my $pat = $o->get($filter); next REGEX_FILTER unless $pat; $filters{$filter} = qr/$pat/; - MKDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); + PTDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); } } - MKDEBUG && _d('Schema object filters:', Dumper(\%filters)); + PTDEBUG && _d('Schema object filters:', Dumper(\%filters)); return \%filters; } @@ -4007,7 +4007,7 @@ sub next_schema_object { } } - MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); + PTDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); return $schema_obj; } @@ -4017,14 +4017,14 @@ sub _iterate_files { if ( !$self->{fh} ) { my ($fh, $file) = $self->{file_itr}->(); if ( !$fh ) { - MKDEBUG && _d('No more files to iterate'); + PTDEBUG && _d('No more files to iterate'); return; } $self->{fh} = $fh; $self->{file} = $file; } my $fh = $self->{fh}; - MKDEBUG && _d('Getting next schema object from', $self->{file}); + PTDEBUG && _d('Getting next schema object from', $self->{file}); local $INPUT_RECORD_SEPARATOR = ''; CHUNK: @@ -4039,7 +4039,7 @@ sub _iterate_files { } elsif ($self->{db} && $chunk =~ m/CREATE TABLE/) { if ($chunk =~ m/DROP VIEW IF EXISTS/) { - MKDEBUG && _d('Table is a VIEW, skipping'); + PTDEBUG && _d('Table is a VIEW, skipping'); next CHUNK; } @@ -4067,7 +4067,7 @@ sub _iterate_files { } } # CHUNK - MKDEBUG && _d('No more schema objects in', $self->{file}); + PTDEBUG && _d('No more schema objects in', $self->{file}); close $self->{fh}; $self->{fh} = undef; @@ -4078,26 +4078,26 @@ sub _iterate_dbh { my ( $self ) = @_; my $q = $self->{Quoter}; my $dbh = $self->{dbh}; - MKDEBUG && _d('Getting next schema object from dbh', $dbh); + PTDEBUG && _d('Getting next schema object from dbh', $dbh); if ( !defined $self->{dbs} ) { my $sql = 'SHOW DATABASES'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @dbs = grep { $self->database_is_allowed($_) } @{$dbh->selectcol_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @dbs, 'databases'); + PTDEBUG && _d('Found', scalar @dbs, 'databases'); $self->{dbs} = \@dbs; } if ( !$self->{db} ) { $self->{db} = shift @{$self->{dbs}}; - MKDEBUG && _d('Next database:', $self->{db}); + PTDEBUG && _d('Next database:', $self->{db}); return unless $self->{db}; } if ( !defined $self->{tbls} ) { my $sql = 'SHOW /*!50002 FULL*/ TABLES FROM ' . $q->quote($self->{db}); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @tbls = map { $_->[0]; # (tbl, type) } @@ -4107,7 +4107,7 @@ sub _iterate_dbh { && (!$type || ($type ne 'VIEW')); } @{$dbh->selectall_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); + PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); $self->{tbls} = \@tbls; } @@ -4117,9 +4117,9 @@ sub _iterate_dbh { || $self->{filters}->{'ignore-engines'} ) { my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db}) . " LIKE \'$tbl\'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $engine = $dbh->selectrow_hashref($sql)->{engine}; - MKDEBUG && _d($tbl, 'uses', $engine, 'engine'); + PTDEBUG && _d($tbl, 'uses', $engine, 'engine'); } @@ -4137,7 +4137,7 @@ sub _iterate_dbh { } } - MKDEBUG && _d('No more tables in database', $self->{db}); + PTDEBUG && _d('No more tables in database', $self->{db}); $self->{db} = undef; $self->{tbls} = undef; @@ -4153,30 +4153,30 @@ sub database_is_allowed { my $filter = $self->{filters}; if ( $db =~ m/information_schema|performance_schema|lost\+found/ ) { - MKDEBUG && _d('Database', $db, 'is a system database, ignoring'); + PTDEBUG && _d('Database', $db, 'is a system database, ignoring'); return 0; } if ( $self->{filters}->{'ignore-databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is in --ignore-databases list'); + PTDEBUG && _d('Database', $db, 'is in --ignore-databases list'); return 0; } if ( $filter->{'ignore-databases-regex'} && $db =~ $filter->{'ignore-databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); + PTDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); return 0; } if ( $filter->{'databases'} && !$filter->{'databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); + PTDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); return 0; } if ( $filter->{'databases-regex'} && $db !~ $filter->{'databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); + PTDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); return 0; } @@ -4196,25 +4196,25 @@ sub table_is_allowed { if ( $filter->{'ignore-tables'}->{$tbl} && ($filter->{'ignore-tables'}->{$tbl} eq '*' || $filter->{'ignore-tables'}->{$tbl} eq $db) ) { - MKDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); + PTDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); return 0; } if ( $filter->{'ignore-tables-regex'} && $tbl =~ $filter->{'ignore-tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); + PTDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); return 0; } if ( $filter->{'tables'} && !$filter->{'tables'}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); + PTDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); return 0; } if ( $filter->{'tables-regex'} && $tbl !~ $filter->{'tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); + PTDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); return 0; } @@ -4222,7 +4222,7 @@ sub table_is_allowed { && $filter->{'tables'}->{$tbl} && $filter->{'tables'}->{$tbl} ne '*' && $filter->{'tables'}->{$tbl} ne $db ) { - MKDEBUG && _d('Table', $tbl, 'is only allowed in database', + PTDEBUG && _d('Table', $tbl, 'is only allowed in database', $filter->{'tables'}->{$tbl}); return 0; } @@ -4239,13 +4239,13 @@ sub engine_is_allowed { my $filter = $self->{filters}; if ( $filter->{'ignore-engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); + PTDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); return 0; } if ( $filter->{'engines'} && !$filter->{'engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); + PTDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); return 0; } @@ -4280,7 +4280,7 @@ package FileIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4311,14 +4311,14 @@ sub get_file_itr { if ( !@filenames ) { push @final_filenames, '-'; - MKDEBUG && _d('Auto-adding "-" to the list of filenames'); + PTDEBUG && _d('Auto-adding "-" to the list of filenames'); } - MKDEBUG && _d('Final filenames:', @final_filenames); + PTDEBUG && _d('Final filenames:', @final_filenames); return sub { while ( @final_filenames ) { my $fn = shift @final_filenames; - MKDEBUG && _d('Filename:', $fn); + PTDEBUG && _d('Filename:', $fn); if ( $fn eq '-' ) { # Magical STDIN filename. return (*STDIN, undef, undef); } @@ -4359,7 +4359,7 @@ package ExplainAnalyzer; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4385,14 +4385,14 @@ sub explain_query { my ($query, $dbh) = @args{qw(query dbh)}; $query = $self->{QueryRewriter}->convert_to_select($query); if ( $query !~ m/^\s*select/i ) { - MKDEBUG && _d("Cannot EXPLAIN non-SELECT query:", + PTDEBUG && _d("Cannot EXPLAIN non-SELECT query:", (length $query <= 100 ? $query : substr($query, 0, 100) . "...")); return; } my $sql = "EXPLAIN $query"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $explain = $dbh->selectall_arrayref($sql, { Slice => {} }); - MKDEBUG && _d("Result of EXPLAIN:", Dumper($explain)); + PTDEBUG && _d("Result of EXPLAIN:", Dumper($explain)); return $explain; } @@ -4460,7 +4460,7 @@ sub get_index_usage { }; } - MKDEBUG && _d("Index usage for", + PTDEBUG && _d("Index usage for", (length $query <= 100 ? $query : substr($query, 0, 100) . "..."), ":", Dumper(\@result)); return \@result; @@ -4475,7 +4475,7 @@ sub get_usage_for { { $usage = $self->{usage}->{$db}->{$checksum}; } - MKDEBUG && _d("Usage for", + PTDEBUG && _d("Usage for", (length $checksum <= 100 ? $checksum : substr($checksum, 0, 100) . "..."), "on", $db, ":", Dumper($usage)); return $usage; @@ -4503,7 +4503,7 @@ sub sparkline { die "I need a $arg argument" unless defined $args{$arg}; } my ($explain) = @args{@required_args}; - MKDEBUG && _d("Making sparkline for", Dumper($explain)); + PTDEBUG && _d("Making sparkline for", Dumper($explain)); my $access_code = { 'ALL' => 'a', @@ -4547,7 +4547,7 @@ sub sparkline { } } - MKDEBUG && _d("sparkline:", $sparkline); + PTDEBUG && _d("sparkline:", $sparkline); return $sparkline; } @@ -4579,7 +4579,7 @@ package IndexUsage; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4665,7 +4665,7 @@ sub add_index_usage { sub find_unused_indexes { my ( $self, $callback ) = @_; die "I need a callback" unless $callback; - MKDEBUG && _d("Finding unused indexes"); + PTDEBUG && _d("Finding unused indexes"); DATABASE: foreach my $db ( sort keys %{$self->{indexes_for}} ) { @@ -4701,9 +4701,9 @@ sub save_results { die "I need a $arg argument" unless defined $args{$arg}; } my ($dbh, $db) = @args{@required_args}; - MKDEBUG && _d("Saving results to tables in database", $db); + PTDEBUG && _d("Saving results to tables in database", $db); - MKDEBUG && _d("Saving index data"); + PTDEBUG && _d("Saving index data"); my $insert_index_sth = $dbh->prepare( "INSERT INTO `$db`.`indexes` (db, tbl, idx, cnt) VALUES (?, ?, ?, ?) " . "ON DUPLICATE KEY UPDATE cnt = cnt + ?"); @@ -4716,7 +4716,7 @@ sub save_results { } } - MKDEBUG && _d("Saving table data"); + PTDEBUG && _d("Saving table data"); my $insert_tbl_sth = $dbh->prepare( "INSERT INTO `$db`.`tables` (db, tbl, cnt) VALUES (?, ?, ?) " . "ON DUPLICATE KEY UPDATE cnt = cnt + ?"); @@ -4727,7 +4727,7 @@ sub save_results { } } - MKDEBUG && _d("Save query data"); + PTDEBUG && _d("Save query data"); my $insert_query_sth = $dbh->prepare( "INSERT IGNORE INTO `$db`.`queries` (query_id, fingerprint, sample) " . " VALUES (CONV(?, 16, 10), ?, ?)"); @@ -4737,7 +4737,7 @@ sub save_results { $query_id, $query->{fingerprint}, $query->{sample}); } - MKDEBUG && _d("Saving index usage data"); + PTDEBUG && _d("Saving index usage data"); my $insert_index_usage_sth = $dbh->prepare( "INSERT INTO `$db`.`index_usage` (query_id, db, tbl, idx, cnt) " . "VALUES (CONV(?, 16, 10), ?, ?, ?, ?) " @@ -4755,7 +4755,7 @@ sub save_results { } } - MKDEBUG && _d("Saving alternate index usage data"); + PTDEBUG && _d("Saving alternate index usage data"); my $insert_index_alt_sth = $dbh->prepare( "INSERT INTO `$db`.`index_alternatives` " . "(query_id, db, tbl, idx, alt_idx, cnt) " @@ -4807,7 +4807,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4949,7 +4949,7 @@ use Data::Dumper; $Data::Dumper::Indent = 1; $OUTPUT_AUTOFLUSH = 1; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(make_checksum)); @@ -5157,7 +5157,7 @@ sub main { }; if ( $EVAL_ERROR ) { warn $EVAL_ERROR unless $o->get('q'); - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } } $si_dbh->disconnect(); @@ -5233,7 +5233,7 @@ sub main { my $new_db = $event->{db} || $event->{Schema}; if ( $new_db && $new_db ne $cur_db ) { my $sql = 'USE ' . $q->quote($new_db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); $cur_db = $new_db; } @@ -5280,7 +5280,7 @@ sub main { $err_for{$fingerprint} = { event => $event, error => $EVAL_ERROR }; # Log the error. - MKDEBUG && _d('Problem on query', $event, $EVAL_ERROR); + PTDEBUG && _d('Problem on query', $event, $EVAL_ERROR); warn $EVAL_ERROR unless $o->get('q'); } $pr->update($tell) if $pr; @@ -5320,7 +5320,7 @@ sub print_reports { my $iu = $args{IndexUsage}; my $o = $args{OptionParser}; my @reports = @{$o->get('report-format')}; - MKDEBUG && _d("Printing reports"); + PTDEBUG && _d("Printing reports"); if ( grep { $_ eq 'drop_unused_indexes' } @reports ) { $iu->find_unused_indexes( @@ -5420,7 +5420,7 @@ sub get_cxn { } my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), $args{opts}); - MKDEBUG && _d('Connected dbh', $dbh); + PTDEBUG && _d('Connected dbh', $dbh); return $dbh; } @@ -5436,24 +5436,24 @@ sub create_save_results_database { $db = $q->quote($db); eval { - MKDEBUG && _d("Checking if", $db, "database already exists"); + PTDEBUG && _d("Checking if", $db, "database already exists"); $sql = "USE $db"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($db, "does not exist:", $EVAL_ERROR); + PTDEBUG && _d($db, "does not exist:", $EVAL_ERROR); $sql = "CREATE DATABASE $db"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); # Now USE the newly created db (the first attempt failed obviously). $sql = "USE $db"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { - MKDEBUG && _d($db, "already exists"); + PTDEBUG && _d($db, "already exists"); } return; @@ -5467,7 +5467,7 @@ sub get_save_results_tables { } my ($o) = @args{@required_args}; my $file = $args{file} || __FILE__; - MKDEBUG && _d("Getting CREATE TABLE defs from POD"); + PTDEBUG && _d("Getting CREATE TABLE defs from POD"); my @table_defs = qw(indexes tables queries index_usage index_alternatives); my @tables; @@ -5497,7 +5497,7 @@ sub empty_save_results_tables { # Dropping and recreating has an advantage over truncating/deleting: # if the CREATE TABLE def is changed, this will auto-upgrade. my $sql = "DROP TABLE IF EXISTS " . $q->quote($db, $tbl->{name}); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } @@ -5514,7 +5514,7 @@ sub create_save_results_tables { foreach my $tbl ( @$tbls ) { my $sql = $tbl->{def}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } @@ -5528,7 +5528,7 @@ sub create_views { die "I need a $arg arugment" unless $args{$arg}; } my ($dbh) = @args{@required_args}; - MKDEBUG && _d("Creating views"); + PTDEBUG && _d("Creating views"); my $pod_parser = new PodParser(); $pod_parser->parse_from_file(__FILE__); @@ -5537,7 +5537,7 @@ sub create_views { foreach my $ident ( keys %$magic ) { next unless $ident =~ m/^view/; my $sql = "CREATE VIEW `$ident` AS $magic->{$ident}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } diff --git a/bin/pt-kill b/bin/pt-kill index 05f638e1..34108c61 100755 --- a/bin/pt-kill +++ b/bin/pt-kill @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1057,7 +1057,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1068,7 +1068,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1086,7 +1086,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1098,7 +1098,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1130,7 +1130,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1153,7 +1153,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1171,7 +1171,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1180,10 +1180,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1195,23 +1195,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1242,7 +1242,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1292,7 +1292,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1337,7 +1337,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1347,21 +1347,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1373,15 +1373,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1399,7 +1399,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1425,7 +1425,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1486,7 +1486,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1504,17 +1504,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1556,19 +1556,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1586,7 +1586,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1606,7 +1606,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1619,7 +1619,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1628,10 +1628,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1672,7 +1672,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1852,36 +1852,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1935,7 +1935,7 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant { ID => 0, USER => 1, @@ -1976,16 +1976,16 @@ sub parse_event { my ($code) = @args{@required_args}; if ( @{$self->{event_cache}} ) { - MKDEBUG && _d("Returning cached event"); + PTDEBUG && _d("Returning cached event"); return shift @{$self->{event_cache}}; } if ( $self->{interval} && $self->{polls} ) { - MKDEBUG && _d("Sleeping between polls"); + PTDEBUG && _d("Sleeping between polls"); usleep($self->{interval}); } - MKDEBUG && _d("Polling PROCESSLIST"); + PTDEBUG && _d("Polling PROCESSLIST"); my ($time, $etime) = @args{qw(time etime)}; my $start = $etime ? 0 : time; # don't need start if etime given my $rows = $code->(); @@ -1996,7 +1996,7 @@ sub parse_event { $time = time unless $time; $etime = $time - $start unless $etime; $self->{polls}++; - MKDEBUG && _d('Rows:', ($rows ? scalar @$rows : 0), 'in', $etime, 'seconds'); + PTDEBUG && _d('Rows:', ($rows ? scalar @$rows : 0), 'in', $etime, 'seconds'); my $active_cxn = $self->{active_cxn}; my $curr_cxn = {}; @@ -2010,23 +2010,23 @@ sub parse_event { my $query_start = $time - ($curr->[TIME] || 0); if ( $active_cxn->{$curr->[ID]} ) { - MKDEBUG && _d('Checking existing cxn', $curr->[ID]); + PTDEBUG && _d('Checking existing cxn', $curr->[ID]); my $prev = $active_cxn->{$curr->[ID]}; # previous state of cxn my $new_query = 0; my $fudge = ($curr->[TIME] || 0) =~ m/\D/ ? 0.001 : 1; # micro-t? if ( $prev->[INFO] ) { if ( !$curr->[INFO] || $prev->[INFO] ne $curr->[INFO] ) { - MKDEBUG && _d('Info is different; new query'); + PTDEBUG && _d('Info is different; new query'); $new_query = 1; } elsif ( defined $curr->[TIME] && $curr->[TIME] < $prev->[TIME] ) { - MKDEBUG && _d('Time is less than previous; new query'); + PTDEBUG && _d('Time is less than previous; new query'); $new_query = 1; } elsif ( $curr->[INFO] && defined $curr->[TIME] && $query_start - $etime - $prev->[START] > $fudge ) { - MKDEBUG && _d('Query restarted; new query', + PTDEBUG && _d('Query restarted; new query', $query_start, $etime, $prev->[START], $fudge); $new_query = 1; } @@ -2040,11 +2040,11 @@ sub parse_event { if ( $curr->[INFO] ) { if ( $prev->[INFO] && !$new_query ) { - MKDEBUG && _d("Query on cxn", $curr->[ID], "hasn't changed"); + PTDEBUG && _d("Query on cxn", $curr->[ID], "hasn't changed"); $self->_update_profile($prev, $curr, $time); } else { - MKDEBUG && _d('Saving new query, state', $curr->[STATE]); + PTDEBUG && _d('Saving new query, state', $curr->[STATE]); push @new_cxn, [ @$curr, # proc info int($query_start), # START @@ -2056,9 +2056,9 @@ sub parse_event { } } else { - MKDEBUG && _d('New cxn', $curr->[ID]); + PTDEBUG && _d('New cxn', $curr->[ID]); if ( $curr->[INFO] && defined $curr->[TIME] ) { - MKDEBUG && _d('Saving query of new cxn, state', $curr->[STATE]); + PTDEBUG && _d('Saving query of new cxn, state', $curr->[STATE]); push @new_cxn, [ @$curr, # proc info int($query_start), # START @@ -2073,7 +2073,7 @@ sub parse_event { PREVIOUSLY_ACTIVE_CXN: foreach my $prev ( values %$active_cxn ) { if ( !$curr_cxn->{$prev->[ID]} ) { - MKDEBUG && _d('cxn', $prev->[ID], 'ended'); + PTDEBUG && _d('cxn', $prev->[ID], 'ended'); push @{$self->{event_cache}}, $self->make_event($prev, $time); delete $active_cxn->{$prev->[ID]}; @@ -2081,7 +2081,7 @@ sub parse_event { elsif ( ($curr_cxn->{$prev->[ID]}->[COMMAND] || "") eq 'Sleep' || !$curr_cxn->{$prev->[ID]}->[STATE] || !$curr_cxn->{$prev->[ID]}->[INFO] ) { - MKDEBUG && _d('cxn', $prev->[ID], 'became idle'); + PTDEBUG && _d('cxn', $prev->[ID], 'became idle'); delete $active_cxn->{$prev->[ID]}; } } @@ -2091,7 +2091,7 @@ sub parse_event { $self->{last_poll} = $time; my $event = shift @{$self->{event_cache}}; - MKDEBUG && _d(scalar @{$self->{event_cache}}, "events in cache"); + PTDEBUG && _d(scalar @{$self->{event_cache}}, "events in cache"); return $event; } @@ -2115,13 +2115,13 @@ sub make_event { Query_time => $Query_time, Lock_time => $row->[PROFILE]->{Locked} || 0, }; - MKDEBUG && _d('Properties of event:', Dumper($event)); + PTDEBUG && _d('Properties of event:', Dumper($event)); return $event; } sub _get_active_cxn { my ( $self ) = @_; - MKDEBUG && _d("Active cxn:", Dumper($self->{active_cxn})); + PTDEBUG && _d("Active cxn:", Dumper($self->{active_cxn})); return $self->{active_cxn}; } @@ -2133,11 +2133,11 @@ sub _update_profile { if ( ($prev->[STATE] || "") eq ($curr->[STATE] || "") ) { - MKDEBUG && _d("Query is still in", $curr->[STATE], "state"); + PTDEBUG && _d("Query is still in", $curr->[STATE], "state"); $prev->[PROFILE]->{$prev->[STATE] || ""} += $time_elapsed; } else { - MKDEBUG && _d("Query changed from state", $prev->[STATE], + PTDEBUG && _d("Query changed from state", $prev->[STATE], "to", $curr->[STATE]); my $half_time = ($time_elapsed || 0) / 2; @@ -2152,36 +2152,36 @@ sub _update_profile { sub find { my ( $self, $proclist, %find_spec ) = @_; - MKDEBUG && _d('find specs:', Dumper(\%find_spec)); + PTDEBUG && _d('find specs:', Dumper(\%find_spec)); my $ms = $self->{MasterSlave}; my @matches; QUERY: foreach my $query ( @$proclist ) { - MKDEBUG && _d('Checking query', Dumper($query)); + PTDEBUG && _d('Checking query', Dumper($query)); my $matched = 0; if ( !$find_spec{replication_threads} && $ms->is_replication_thread($query) ) { - MKDEBUG && _d('Skipping replication thread'); + PTDEBUG && _d('Skipping replication thread'); next QUERY; } if ( $find_spec{busy_time} && ($query->{Command} || '') eq 'Query' ) { if ( $query->{Time} < $find_spec{busy_time} ) { - MKDEBUG && _d("Query isn't running long enough"); + PTDEBUG && _d("Query isn't running long enough"); next QUERY; } - MKDEBUG && _d('Exceeds busy time'); + PTDEBUG && _d('Exceeds busy time'); $matched++; } if ( $find_spec{idle_time} && ($query->{Command} || '') eq 'Sleep' ) { if ( $query->{Time} < $find_spec{idle_time} ) { - MKDEBUG && _d("Query isn't idle long enough"); + PTDEBUG && _d("Query isn't idle long enough"); next QUERY; } - MKDEBUG && _d('Exceeds idle time'); + PTDEBUG && _d('Exceeds idle time'); $matched++; } @@ -2190,24 +2190,24 @@ sub find { my $filter = "_find_match_$property"; if ( defined $find_spec{ignore}->{$property} && $self->$filter($query, $find_spec{ignore}->{$property}) ) { - MKDEBUG && _d('Query matches ignore', $property, 'spec'); + PTDEBUG && _d('Query matches ignore', $property, 'spec'); next QUERY; } if ( defined $find_spec{match}->{$property} ) { if ( !$self->$filter($query, $find_spec{match}->{$property}) ) { - MKDEBUG && _d('Query does not match', $property, 'spec'); + PTDEBUG && _d('Query does not match', $property, 'spec'); next QUERY; } - MKDEBUG && _d('Query matches', $property, 'spec'); + PTDEBUG && _d('Query matches', $property, 'spec'); $matched++; } } if ( $matched || $find_spec{all} ) { - MKDEBUG && _d("Query matched one or more specs, adding"); + PTDEBUG && _d("Query matched one or more specs, adding"); push @matches, $query; next QUERY; } - MKDEBUG && _d('Query does not match any specs, ignoring'); + PTDEBUG && _d('Query does not match any specs, ignoring'); } # QUERY return @matches; @@ -2282,7 +2282,7 @@ package TextResultSetParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2335,19 +2335,19 @@ sub parse { my $result_set; if ( $text =~ m/^\+---/m ) { # standard "tabular" output - MKDEBUG && _d('Result set text is standard tabular'); + PTDEBUG && _d('Result set text is standard tabular'); my $line_pattern = qr/^(\| .*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tabular); } elsif ( $text =~ m/^\w+\t\w+/m ) { # tab-separated - MKDEBUG && _d('Result set text is tab-separated'); + PTDEBUG && _d('Result set text is tab-separated'); my $line_pattern = qr/^(.*?\t.*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tab_sep); } elsif ( $text =~ m/\*\*\* \d+\. row/ ) { # "vertical" output - MKDEBUG && _d('Result set text is vertical (\G)'); + PTDEBUG && _d('Result set text is vertical (\G)'); foreach my $row ( split_vertical_rows($text) ) { push @$result_set, $self->parse_vertical_row($row); } @@ -2426,7 +2426,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2447,7 +2447,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -2456,15 +2456,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -2480,7 +2480,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -2498,23 +2498,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -2543,11 +2543,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -2576,7 +2576,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -2587,11 +2587,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -2606,7 +2606,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -2666,7 +2666,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -2675,7 +2675,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -2684,21 +2684,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -2719,17 +2719,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -2742,7 +2742,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -2751,13 +2751,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -2770,12 +2770,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -2787,7 +2787,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -2795,7 +2795,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -2803,7 +2803,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -2846,7 +2846,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -2908,12 +2908,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -2934,7 +2934,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -2944,14 +2944,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -2992,7 +2992,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -3041,7 +3041,7 @@ package QueryRewriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; @@ -3190,7 +3190,7 @@ sub distill_verbs { $query = $self->strip_comments($query); if ( $query =~ m/\A\s*SHOW\s+/i ) { - MKDEBUG && _d($query); + PTDEBUG && _d($query); $query = uc $query; $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; @@ -3200,7 +3200,7 @@ sub distill_verbs { $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; $query =~ s/\s+/ /g; - MKDEBUG && _d($query); + PTDEBUG && _d($query); return $query; } @@ -3210,10 +3210,10 @@ sub distill_verbs { if ( $dds) { my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; $obj = uc $obj if $obj; - MKDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); + PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); my ($db_or_tbl) = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches db or table:', $db_or_tbl); + PTDEBUG && _d('Matches db or table:', $db_or_tbl); return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; } @@ -3224,7 +3224,7 @@ sub distill_verbs { }; if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - MKDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); + PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); my $union = grep { $_ eq 'UNION' } @verbs; @verbs = $union ? qw(SELECT UNION) : qw(SELECT); } @@ -3351,12 +3351,12 @@ sub __delete_to_select { sub __insert_to_select { my ( $tbl, $cols, $vals ) = @_; - MKDEBUG && _d('Args:', @_); + PTDEBUG && _d('Args:', @_); my @cols = split(/,/, $cols); - MKDEBUG && _d('Cols:', @cols); + PTDEBUG && _d('Cols:', @cols); $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - MKDEBUG && _d('Vals:', @vals); + PTDEBUG && _d('Vals:', @vals); if ( @cols == @vals ) { return "select * from $tbl where " . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); @@ -3422,7 +3422,7 @@ $Data::Dumper::Quotekeys = 0; Transformers->import qw(ts); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; $OUTPUT_AUTOFLUSH = 1; @@ -3459,7 +3459,7 @@ sub main { } if ( !-t STDIN ) { - MKDEBUG && _d("STDIN is piped"); + PTDEBUG && _d("STDIN is piped"); @ARGV = ('-'); } @@ -3484,7 +3484,7 @@ sub main { # ######################################################################## if ( $o->get('stop') ) { my $sentinel = $o->get('sentinel'); - MKDEBUG && _d('Creating sentinel file', $sentinel); + PTDEBUG && _d('Creating sentinel file', $sentinel); open my $fh, '>', $sentinel or die "Cannot open $sentinel: $OS_ERROR\n"; print $fh "Remove this file to permit pt-kill to run.\n" @@ -3503,7 +3503,7 @@ sub main { my $kill_sth; my $get_proclist; if ( @ARGV ) { - MKDEBUG && _d('Getting processlist from files:', @ARGV); + PTDEBUG && _d('Getting processlist from files:', @ARGV); my $trp = new TextResultSetParser(); my $fh; $get_proclist = sub { @@ -3538,7 +3538,7 @@ sub main { }; } else { - MKDEBUG && _d('Getting processlist from MySQL'); + PTDEBUG && _d('Getting processlist from MySQL'); $dsn = $dp->parse_options($o); $dbh = get_cxn($dp, $dsn, 1); $kill_sth = $o->get('kill-query') ? $dbh->prepare('KILL QUERY ?') @@ -3557,7 +3557,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -3649,10 +3649,10 @@ sub main { # ################################################################## CLASS: foreach my $class ( keys %$query_classes ) { - MKDEBUG && _d("Finding matching queries for class", $class); + PTDEBUG && _d("Finding matching queries for class", $class); my @matches = $pl->find($query_classes->{$class}, %find_spec); if ( !@matches ) { - MKDEBUG && _d("Class has no matching queries"); + PTDEBUG && _d("Class has no matching queries"); next CLASS; } @@ -3660,7 +3660,7 @@ sub main { # Apply class-based filters. # ############################################################### if ( $query_count && @matches < $query_count ) { - MKDEBUG && _d("Class does not have enough queries; has", + PTDEBUG && _d("Class does not have enough queries; has", scalar @matches, "but needs at least", $query_count); next CLASS; } @@ -3668,7 +3668,7 @@ sub main { if ( $each_busy_time ) { foreach my $proc ( @matches ) { if ( ($proc->{Time} || 0) <= $each_busy_time ) { - MKDEBUG && _d("This proc hasn't been running long enough:", + PTDEBUG && _d("This proc hasn't been running long enough:", Dumper($proc)); next CLASS; } @@ -3683,7 +3683,7 @@ sub main { } } if ( !$busy_enough ) { - MKDEBUG && _d("No proc is busy enough"); + PTDEBUG && _d("No proc is busy enough"); next CLASS; } } @@ -3710,7 +3710,7 @@ sub main { # ############################################################### # Save matching queries in this class. # ############################################################### - MKDEBUG && _d(scalar @matches, "queries in class to kill"); + PTDEBUG && _d(scalar @matches, "queries in class to kill"); push @queries, @matches; } # CLASS msg('Matched ' . scalar @queries . ' queries'); @@ -3786,13 +3786,13 @@ sub get_cxn { # does not block parent. sub exec_cmd { my ( $cmd ) = @_; - MKDEBUG && _d('exec cmd:', $cmd); + PTDEBUG && _d('exec cmd:', $cmd); return unless $cmd; my $pid = fork(); if ( $pid ) { # parent - MKDEBUG && _d('child pid:', $pid); + PTDEBUG && _d('child pid:', $pid); return $pid; } @@ -3800,21 +3800,21 @@ sub exec_cmd { POSIX::setsid() or die "Cannot start a new session: $OS_ERROR"; my $retval = system($cmd); $retval = $retval >> 8; - MKDEBUG && _d('child exit status:', $retval); + PTDEBUG && _d('child exit status:', $retval); exit $retval; } sub msg { my ( $msg ) = @_; print '# ', ts(time), " $msg\n" if $o->get('verbose'); - MKDEBUG && _d($msg); + PTDEBUG && _d($msg); return; } sub group_queries { my ( %args ) = @_; my ($proclist, $group_by, $qr) = @args{qw(proclist group_by QueryRewriter)}; - MKDEBUG && _d("Grouping queries by", $group_by); + PTDEBUG && _d("Grouping queries by", $group_by); # If there's proclist then there's nothing to do. If there's no group by # then all the procs in the list are in the same class. diff --git a/bin/pt-log-player b/bin/pt-log-player index 606b96ed..a86cead4 100755 --- a/bin/pt-log-player +++ b/bin/pt-log-player @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package SlowLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1099,7 +1099,7 @@ sub parse_event { if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); if ( @chunks > 1 ) { - MKDEBUG && _d("Found multiple chunks"); + PTDEBUG && _d("Found multiple chunks"); $stmt = shift @chunks; unshift @$pending, @chunks; } @@ -1117,18 +1117,18 @@ sub parse_event { while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - MKDEBUG && _d("Got ts", $time); + PTDEBUG && _d("Got ts", $time); push @properties, 'ts', $time; ++$got_ts; if ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } @@ -1137,13 +1137,13 @@ sub parse_event { elsif ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - MKDEBUG && _d("Got admin command"); + PTDEBUG && _d("Got admin command"); $line =~ s/^#\s+//; # string leading "# ". push @properties, 'cmd', 'Admin', 'arg', $line; push @properties, 'bytes', length($properties[-1]); @@ -1152,12 +1152,12 @@ sub parse_event { } elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - MKDEBUG && _d("Got some line with properties"); + PTDEBUG && _d("Got some line with properties"); if ( $line =~ m/Schema:\s+\w+: / ) { - MKDEBUG && _d('Removing empty Schema attrib'); + PTDEBUG && _d('Removing empty Schema attrib'); $line =~ s/Schema:\s+//; - MKDEBUG && _d($line); + PTDEBUG && _d($line); } my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; @@ -1165,36 +1165,36 @@ sub parse_event { } elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; ++$got_db; } elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, split(/,|\s*=\s*/, $setting); ++$got_set; } if ( !$found_arg && $pos == $len ) { - MKDEBUG && _d("Did not find arg, looking for special cases"); + PTDEBUG && _d("Did not find arg, looking for special cases"); local $INPUT_RECORD_SEPARATOR = ";\n"; if ( defined(my $l = $next_event->()) ) { chomp $l; $l =~ s/^\s+//; - MKDEBUG && _d("Found admin statement", $l); + PTDEBUG && _d("Found admin statement", $l); push @properties, 'cmd', 'Admin', 'arg', $l; push @properties, 'bytes', length($properties[-1]); $found_arg++; } else { - MKDEBUG && _d("I can't figure out what to do with this line"); + PTDEBUG && _d("I can't figure out what to do with this line"); next EVENT; } } } else { - MKDEBUG && _d("Got the query/arg line"); + PTDEBUG && _d("Got the query/arg line"); my $arg = substr($stmt, $pos - length($line)); push @properties, 'arg', $arg, 'bytes', length($arg); if ( $args{misc} && $args{misc}->{embed} @@ -1206,7 +1206,7 @@ sub parse_event { } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -1248,7 +1248,7 @@ package BinaryLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1298,10 +1298,10 @@ sub parse_event { $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. $line =~ s/$delim// if $delim; - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ( $line =~ m/^\/\*.+\*\/;/ ) { - MKDEBUG && _d('Comment line'); + PTDEBUG && _d('Comment line'); next LINE; } @@ -1310,10 +1310,10 @@ sub parse_event { if ( $del ) { $self->{delim_len} = $delim_len = length $del; $self->{delim} = $delim = quotemeta $del; - MKDEBUG && _d('delimiter:', $delim); + PTDEBUG && _d('delimiter:', $delim); } else { - MKDEBUG && _d('Delimiter reset to ;'); + PTDEBUG && _d('Delimiter reset to ;'); $self->{delim} = $delim = undef; $self->{delim_len} = $delim_len = 0; } @@ -1323,14 +1323,14 @@ sub parse_event { next LINE if $line =~ m/End of log file/; if ( !$got_offset && (my ( $offset ) = $line =~ m/$binlog_line_1/m) ) { - MKDEBUG && _d('Got the at offset line'); + PTDEBUG && _d('Got the at offset line'); push @properties, 'offset', $offset; $got_offset++; } elsif ( !$got_hdr && $line =~ m/^#(\d{6}\s+\d{1,2}:\d\d:\d\d)/ ) { ($ts, $sid, $end, $type, $rest) = $line =~ m/$binlog_line_2/m; - MKDEBUG && _d('Got the header line; type:', $type, 'rest:', $rest); + PTDEBUG && _d('Got the header line; type:', $type, 'rest:', $rest); push @properties, 'cmd', 'Query', 'ts', $ts, 'server_id', $sid, 'end_log_pos', $end; $got_hdr++; @@ -1339,18 +1339,18 @@ sub parse_event { elsif ( $line =~ m/^(?:#|use |SET)/i ) { if ( my ( $db ) = $line =~ m/^use ([^;]+)/ ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; } elsif ( my ($setting) = $line =~ m/^SET\s+([^;]*)/ ) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, map { s/\s+//; lc } split(/,|\s*=\s*/, $setting); } } else { - MKDEBUG && _d("Got the query/arg line at pos", $pos); + PTDEBUG && _d("Got the query/arg line at pos", $pos); $found_arg++; if ( $got_offset && $got_hdr ) { if ( $type eq 'Xid' ) { @@ -1363,15 +1363,15 @@ sub parse_event { 'error_code', $c; } elsif ( $type eq 'Start:' ) { - MKDEBUG && _d("Binlog start"); + PTDEBUG && _d("Binlog start"); } else { - MKDEBUG && _d('Unknown event type:', $type); + PTDEBUG && _d('Unknown event type:', $type); next EVENT; } } else { - MKDEBUG && _d("It's not a query/arg, it's just some SQL fluff"); + PTDEBUG && _d("It's not a query/arg, it's just some SQL fluff"); push @properties, 'cmd', 'Query', 'ts', undef; } @@ -1385,10 +1385,10 @@ sub parse_event { if ( $del ) { $self->{delim_len} = $delim_len = length $del; $self->{delim} = $delim = quotemeta $del; - MKDEBUG && _d('delimiter:', $delim); + PTDEBUG && _d('delimiter:', $delim); } else { - MKDEBUG && _d('Delimiter reset to ;'); + PTDEBUG && _d('Delimiter reset to ;'); $del = ';'; $self->{delim} = $delim = undef; $self->{delim_len} = $delim_len = 0; @@ -1406,7 +1406,7 @@ sub parse_event { } # LINE if ( $found_arg ) { - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -1415,7 +1415,7 @@ sub parse_event { return $event; } else { - MKDEBUG && _d('Event had no arg'); + PTDEBUG && _d('Event had no arg'); } } # EVENT @@ -1451,7 +1451,7 @@ package GeneralLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1496,10 +1496,10 @@ sub parse_event { defined($line = shift @$pending) or defined($line = $next_event->()) ) { - MKDEBUG && _d($line); + PTDEBUG && _d($line); my ($ts, $thread_id, $cmd, $arg) = $line =~ m/$genlog_line_1/; if ( !($thread_id && $cmd) ) { - MKDEBUG && _d('Not start of general log event'); + PTDEBUG && _d('Not start of general log event'); next; } my @properties = ('pos_in_log', $pos_in_log, 'ts', $ts, @@ -1516,17 +1516,17 @@ sub parse_event { my (undef, $next_thread_id, $next_cmd) = $line =~ m/$genlog_line_1/; if ( $next_thread_id && $next_cmd ) { - MKDEBUG && _d('Event done'); + PTDEBUG && _d('Event done'); $done = 1; push @$pending, $line; } else { - MKDEBUG && _d('More arg:', $line); + PTDEBUG && _d('More arg:', $line); $arg .= $line; } } else { - MKDEBUG && _d('No more lines'); + PTDEBUG && _d('No more lines'); $done = 1; } } until ( $done ); @@ -1547,7 +1547,7 @@ sub parse_event { my ($user, undef, $db) = $arg =~ /(\S+)/g; my $host; ($user, $host) = split(/@/, $user); - MKDEBUG && _d('Connect', $user, '@', $host, 'on', $db); + PTDEBUG && _d('Connect', $user, '@', $host, 'on', $db); push @properties, 'user', $user if $user; push @properties, 'host', $host if $host; @@ -1559,7 +1559,7 @@ sub parse_event { $cmd = 'Init DB'; $arg =~ s/^DB\s+//; my ($db) = $arg =~ /(\S+)/; - MKDEBUG && _d('Init DB:', $db); + PTDEBUG && _d('Init DB:', $db); push @properties, 'db', $db if $db; $db_for->{$thread_id} = $db; } @@ -1570,7 +1570,7 @@ sub parse_event { push @properties, 'Query_time', 0; - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -1612,7 +1612,7 @@ package LogSplitter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1630,7 +1630,7 @@ sub new { $args{base_dir} .= '/' if substr($args{base_dir}, -1, 1) ne '/'; if ( $args{split_random} ) { - MKDEBUG && _d('Split random'); + PTDEBUG && _d('Split random'); $args{attribute} = '_sessionno'; # set round-robin 1..session_files } @@ -1659,7 +1659,7 @@ sub new { created_dirs => [], }; - MKDEBUG && _d('new LogSplitter final args:', Dumper($self)); + PTDEBUG && _d('new LogSplitter final args:', Dumper($self)); return bless $self, $class; } @@ -1675,7 +1675,7 @@ sub split { } if ( @logs == 0 ) { - MKDEBUG && _d('Implicitly reading STDIN because no logs were given'); + PTDEBUG && _d('Implicitly reading STDIN because no logs were given'); push @logs, '-'; } @@ -1700,7 +1700,7 @@ sub split { } } - MKDEBUG && _d('Splitting', $log); + PTDEBUG && _d('Splitting', $log); my $event = {}; my $more_events = 1; my $more_events_sub = sub { $more_events = $_[0]; }; @@ -1725,7 +1725,7 @@ sub split { $self->_save_event($event) if $event; } if ( !$more_events ) { - MKDEBUG && _d('Done parsing', $log); + PTDEBUG && _d('Done parsing', $log); close $fh; next LOG; } @@ -1751,13 +1751,13 @@ sub _save_event { if ( !defined $session->{fh} ) { $self->{n_sessions_saved}++; - MKDEBUG && _d('New session:', $session_id, ',', + PTDEBUG && _d('New session:', $session_id, ',', $self->{n_sessions_saved}, 'of', $self->{max_sessions}); my $session_file = $self->_get_next_session_file(); if ( !$session_file ) { $oktorun = 0; - MKDEBUG && _d('Not oktorun because no _get_next_session_file'); + PTDEBUG && _d('Not oktorun because no _get_next_session_file'); return; } @@ -1775,7 +1775,7 @@ sub _save_event { push @{$self->{session_fhs}}, { fh => $fh, session_id => $session_id }; - MKDEBUG && _d('Created', $session_file, 'for session', + PTDEBUG && _d('Created', $session_file, 'for session', $self->{attribute}, '=', $session_id); print $fh "-- START SESSION $session_id\n\n"; @@ -1793,11 +1793,11 @@ sub _save_event { $session->{active} = 1; $self->{n_open_fhs}++; - MKDEBUG && _d('Reopend', $session->{session_file}, 'for session', + PTDEBUG && _d('Reopend', $session->{session_file}, 'for session', $self->{attribute}, '=', $session_id); } else { - MKDEBUG && _d('Event belongs to active session', $session_id); + PTDEBUG && _d('Event belongs to active session', $session_id); } my $session_fh = $session->{fh}; @@ -1819,7 +1819,7 @@ sub _get_session_ds { my $attrib = $self->{attribute}; if ( !$event->{ $attrib } ) { - MKDEBUG && _d('No attribute', $attrib, 'in event:', Dumper($event)); + PTDEBUG && _d('No attribute', $attrib, 'in event:', Dumper($event)); return; } @@ -1838,7 +1838,7 @@ sub _get_session_ds { } else { $self->{n_sessions_skipped} += 1; - MKDEBUG && _d('Skipping new session', $session_id, + PTDEBUG && _d('Skipping new session', $session_id, 'because max_sessions is reached'); } @@ -1851,7 +1851,7 @@ sub _close_lru_session { my $lru_n = $self->{n_sessions_saved} - $self->{max_open_files} - 1; my $close_to_n = $lru_n + $self->{close_lru_files} - 1; - MKDEBUG && _d('Closing session fhs', $lru_n, '..', $close_to_n, + PTDEBUG && _d('Closing session fhs', $lru_n, '..', $close_to_n, '(',$self->{n_sessions}, 'sessions', $self->{n_open_fhs}, 'open fhs)'); foreach my $session ( @$session_fhs[ $lru_n..$close_to_n ] ) { @@ -1877,15 +1877,15 @@ sub _get_next_session_file { if ( ($retval >> 8) != 0 ) { die "Cannot create new directory $new_dir: $OS_ERROR"; } - MKDEBUG && _d('Created new base_dir', $new_dir); + PTDEBUG && _d('Created new base_dir', $new_dir); push @{$self->{created_dirs}}, $new_dir; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($new_dir, 'already exists'); } } else { - MKDEBUG && _d('No dir created; n_files_this_dir:', + PTDEBUG && _d('No dir created; n_files_this_dir:', $self->{n_files_this_dir}, 'n_files_total:', $self->{n_files_total}); } @@ -1897,7 +1897,7 @@ sub _get_next_session_file { my $session_file = $self->{base_dir} . $dir_n . $self->{base_file_name}."-$session_n.txt"; - MKDEBUG && _d('Next session file', $session_file); + PTDEBUG && _d('Next session file', $session_file); return $session_file; } @@ -2002,7 +2002,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -2025,7 +2025,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -2043,7 +2043,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -2052,10 +2052,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -2067,23 +2067,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -2114,7 +2114,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -2164,7 +2164,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -2209,7 +2209,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -2219,21 +2219,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -2245,15 +2245,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -2271,7 +2271,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -2297,7 +2297,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -2358,7 +2358,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2376,17 +2376,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2428,19 +2428,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2458,7 +2458,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2478,7 +2478,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2491,7 +2491,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2500,10 +2500,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2553,7 +2553,7 @@ $Data::Dumper::Quotekeys = 0; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # These are global so the --play threads can access them. my $o; @@ -2632,7 +2632,7 @@ sub main { if ( $o->get('filter') ) { my $filter = $o->get('filter'); if ( -f $filter && -r $filter ) { - MKDEBUG && _d('Reading file', $filter, 'for --filter code'); + PTDEBUG && _d('Reading file', $filter, 'for --filter code'); open my $fh, "<", $filter or die "Cannot open $filter: $OS_ERROR"; $filter = do { local $/ = undef; <$fh> }; close $fh; @@ -2640,8 +2640,8 @@ sub main { else { $filter = "( $filter )"; # issue 565 } - my $code = "sub { MKDEBUG && _d('callback: filter'); my(\$event) = shift; $filter && return \$event; };"; - MKDEBUG && _d('--filter code:', $code); + my $code = "sub { PTDEBUG && _d('callback: filter'); my(\$event) = shift; $filter && return \$event; };"; + PTDEBUG && _d('--filter code:', $code); my $sub = eval $code or die "Error compiling --filter code: $code\n$EVAL_ERROR"; push @callbacks, $sub; @@ -2677,7 +2677,7 @@ sub main { # The session "file" might actually be a dir, in which case we # read ALL files in that dir. if ( -d $session_file ) { - MKDEBUG && _d('Reading all session log files in', $session_file); + PTDEBUG && _d('Reading all session log files in', $session_file); opendir my $dir, $session_file or die "Cannot open directory $session_file: $OS_ERROR"; push @session_files, @@ -2696,7 +2696,7 @@ sub main { } } - MKDEBUG && _d('Session files:', @session_files); + PTDEBUG && _d('Session files:', @session_files); if ( @session_files == 0 ) { warn 'No valid session files'; @@ -2774,9 +2774,9 @@ sub main { } else { # I'm the child. $SIG{CHLD} = 'DEFAULT'; # See bug #1886444 - MKDEBUG && _d('Child PID', $PID, 'started'); + PTDEBUG && _d('Child PID', $PID, 'started'); play_session($dsn, ($childno + 1), $child_tasks); - MKDEBUG && _d('Child PID', $PID, 'finished'); + PTDEBUG && _d('Child PID', $PID, 'finished'); return 0; } } @@ -2792,7 +2792,7 @@ sub main { print "Process ", $children{$pid}, " finished with exit status ", $exited_children{$pid}->{exit_status}, ".\n" unless $o->get('quiet'); - MKDEBUG && _d('Reaped child PID', $pid); + PTDEBUG && _d('Reaped child PID', $pid); delete $children{$pid}; delete $exited_children{$pid}; } @@ -2801,10 +2801,10 @@ sub main { # Don't busy-wait. But don't wait forever either, as a child may exit # and signal while we're not sleeping, so if we sleep forever we may # not get the signal. - MKDEBUG && _d('Sleeping to wait for children'); + PTDEBUG && _d('Sleeping to wait for children'); sleep 1; } - MKDEBUG && _d(scalar keys %children, 'children are still working'); + PTDEBUG && _d(scalar keys %children, 'children are still working'); } while ( keys %children ); @@ -2836,17 +2836,17 @@ sub play_session { if ( $results || $print ) { open $output_fh, '>', $output_file or die "Cannot open $output_file for writing: $OS_ERROR"; - MKDEBUG && _d('Proc', $childno, 'writing to', $output_file); + PTDEBUG && _d('Proc', $childno, 'writing to', $output_file); } else { - MKDEBUG && _d('Proc', $childno, 'not writing results'); + PTDEBUG && _d('Proc', $childno, 'not writing results'); } local $INPUT_RECORD_SEPARATOR = ''; ITERATION: for my $iteration_n ( 1..$o->get('iterations') ) { - MKDEBUG && _d('Proc', $childno, 'starting iteration', $iteration_n); + PTDEBUG && _d('Proc', $childno, 'starting iteration', $iteration_n); SESSION_FILE: foreach my $session_file ( @$session_files ) { @@ -2874,7 +2874,7 @@ sub play_session { # Remove leading /* comments */ (issue 903) $query =~ s!^/\*.*?\*/\s*!!; if ( $query !~ m/^(?:SELECT|USE) /i ) { - MKDEBUG && _d('Skipping query for --only-select:', $query); + PTDEBUG && _d('Skipping query for --only-select:', $query); next QUERY; } } @@ -2905,7 +2905,7 @@ sub play_session { } } # QUERY - MKDEBUG && _d('No more sessions in', $session_file); + PTDEBUG && _d('No more sessions in', $session_file); close $session_fh; } # SESSION_FILE } # ITERATION @@ -2963,10 +2963,10 @@ sub get_number_of_cpus { if ( $sys_info || (open $cpuinfo, "<", "/proc/cpuinfo") ) { local $INPUT_RECORD_SEPARATOR = undef; my $contents = $sys_info || <$cpuinfo>; - MKDEBUG && _d('sys info:', $contents); + PTDEBUG && _d('sys info:', $contents); close $cpuinfo if $cpuinfo; $n_cpus = scalar( map { $_ } $contents =~ m/(processor)/g ); - MKDEBUG && _d('Got', $n_cpus, 'cpus from /proc/cpuinfo'); + PTDEBUG && _d('Got', $n_cpus, 'cpus from /proc/cpuinfo'); return $n_cpus if $n_cpus; } @@ -2975,9 +2975,9 @@ sub get_number_of_cpus { # FreeBSD and Mac OS X if ( $sys_info || ($OSNAME =~ m/freebsd/i) || ($OSNAME =~ m/darwin/i) ) { my $contents = $sys_info || `sysctl hw.ncpu`; - MKDEBUG && _d('sys info:', $contents); + PTDEBUG && _d('sys info:', $contents); ($n_cpus) = $contents =~ m/(\d)/ if $contents; - MKDEBUG && _d('Got', $n_cpus, 'cpus from sysctl hw.ncpu'); + PTDEBUG && _d('Got', $n_cpus, 'cpus from sysctl hw.ncpu'); return $n_cpus if $n_cpus; } @@ -3183,7 +3183,7 @@ If you supply your code on the command line, it is injected into the following subroutine where C<$filter> is your code: sub { - MKDEBUG && _d('callback: filter'); + PTDEBUG && _d('callback: filter'); my( $event ) = shift; ( $filter ) && return $event; } @@ -3206,7 +3206,7 @@ name as the value to L<"--filter">. The file should not contain a shebang the following subroutine: sub { - MKDEBUG && _d('callback: filter'); + PTDEBUG && _d('callback: filter'); my( $event ) = shift; $filter && return $event; } diff --git a/bin/pt-online-schema-change b/bin/pt-online-schema-change index efe31296..8909aa45 100755 --- a/bin/pt-online-schema-change +++ b/bin/pt-online-schema-change @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1057,7 +1057,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1068,7 +1068,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1086,7 +1086,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1098,7 +1098,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1130,7 +1130,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1153,7 +1153,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1171,7 +1171,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1180,10 +1180,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1195,23 +1195,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1242,7 +1242,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1292,7 +1292,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1337,7 +1337,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1347,21 +1347,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1373,15 +1373,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1399,7 +1399,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1425,7 +1425,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1486,7 +1486,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1504,17 +1504,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1556,19 +1556,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1586,7 +1586,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1606,7 +1606,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1619,7 +1619,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1628,10 +1628,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1672,7 +1672,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1749,7 +1749,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1929,36 +1929,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -2005,7 +2005,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2050,7 +2050,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -2111,7 +2111,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -2129,7 +2129,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -2138,25 +2138,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -2170,66 +2170,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -2245,7 +2245,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -2271,7 +2271,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -2293,7 +2293,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -2361,7 +2361,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -2371,7 +2371,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -2406,7 +2406,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -2500,11 +2500,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -2516,12 +2516,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -2531,15 +2531,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -2549,11 +2549,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -2574,7 +2574,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -2586,11 +2586,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -2603,7 +2603,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -2622,7 +2622,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -2640,7 +2640,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -2666,7 +2666,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -2711,7 +2711,7 @@ package TableChunker; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(floor ceil); use List::Util qw(min max); @@ -2759,7 +2759,7 @@ sub find_chunk_columns { push @possible_indexes, $index; } - MKDEBUG && _d('Possible chunk indexes in order:', + PTDEBUG && _d('Possible chunk indexes in order:', join(', ', map { $_->{name} } @possible_indexes)); my $can_chunk_exact = 0; @@ -2777,14 +2777,14 @@ sub find_chunk_columns { $can_chunk_exact = 1 if $args{exact} && scalar @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { my $chunk_type = $args{exact} ? 'Exact' : 'Inexact'; _d($chunk_type, 'chunkable:', join(', ', map { "$_->{column} on $_->{index}" } @candidate_cols)); } my @result; - MKDEBUG && _d('Ordering columns by order in tbl, PK first'); + PTDEBUG && _d('Ordering columns by order in tbl, PK first'); if ( $tbl_struct->{keys}->{PRIMARY} ) { my $pk_first_col = $tbl_struct->{keys}->{PRIMARY}->{cols}->[0]; @result = grep { $_->{column} eq $pk_first_col } @candidate_cols; @@ -2795,7 +2795,7 @@ sub find_chunk_columns { push @result, sort { $col_pos{$a->{column}} <=> $col_pos{$b->{column}} } @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { _d('Chunkable columns:', join(', ', map { "$_->{column} on $_->{index}" } @result)); _d('Can chunk exactly:', $can_chunk_exact); @@ -2810,18 +2810,18 @@ sub calculate_chunks { foreach my $arg ( @required_args ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Calculate chunks for', + PTDEBUG && _d('Calculate chunks for', join(", ", map {"$_=".(defined $args{$_} ? $args{$_} : "undef")} qw(db tbl chunk_col min max rows_in_range chunk_size zero_chunk exact) )); if ( !$args{rows_in_range} ) { - MKDEBUG && _d("Empty table"); + PTDEBUG && _d("Empty table"); return '1=1'; } if ( $args{rows_in_range} < $args{chunk_size} ) { - MKDEBUG && _d("Chunk size larger than rows in range"); + PTDEBUG && _d("Chunk size larger than rows in range"); return '1=1'; } @@ -2830,7 +2830,7 @@ sub calculate_chunks { my $chunk_col = $args{chunk_col}; my $tbl_struct = $args{tbl_struct}; my $col_type = $tbl_struct->{type_for}->{$chunk_col}; - MKDEBUG && _d('chunk col type:', $col_type); + PTDEBUG && _d('chunk col type:', $col_type); my %chunker; if ( $tbl_struct->{is_numeric}->{$chunk_col} || $col_type =~ /date|time/ ) { @@ -2842,7 +2842,7 @@ sub calculate_chunks { else { die "Cannot chunk $col_type columns"; } - MKDEBUG && _d("Chunker:", Dumper(\%chunker)); + PTDEBUG && _d("Chunker:", Dumper(\%chunker)); my ($col, $start_point, $end_point, $interval, $range_func) = @chunker{qw(col start_point end_point interval range_func)}; @@ -2882,7 +2882,7 @@ sub calculate_chunks { } } else { - MKDEBUG && _d('No chunks; using single chunk 1=1'); + PTDEBUG && _d('No chunks; using single chunk 1=1'); push @chunks, '1=1'; } @@ -2942,19 +2942,19 @@ sub _chunk_numeric { } if ( !defined $start_point ) { - MKDEBUG && _d('Start point is undefined'); + PTDEBUG && _d('Start point is undefined'); $start_point = 0; } if ( !defined $end_point || $end_point < $start_point ) { - MKDEBUG && _d('End point is undefined or before start point'); + PTDEBUG && _d('End point is undefined or before start point'); $end_point = 0; } - MKDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); my $have_zero_chunk = 0; if ( $args{zero_chunk} ) { if ( $start_point != $end_point && $start_point >= 0 ) { - MKDEBUG && _d('Zero chunking'); + PTDEBUG && _d('Zero chunking'); my $nonzero_val = $self->get_nonzero_value( %args, db_tbl => $db_tbl, @@ -2970,10 +2970,10 @@ sub _chunk_numeric { $have_zero_chunk = 1; } else { - MKDEBUG && _d("Cannot zero chunk"); + PTDEBUG && _d("Cannot zero chunk"); } } - MKDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); my $interval = $args{chunk_size} * ($end_point - $start_point) @@ -2985,7 +2985,7 @@ sub _chunk_numeric { if ( $args{exact} ) { $interval = $args{chunk_size}; } - MKDEBUG && _d('Chunk interval:', $interval, 'units'); + PTDEBUG && _d('Chunk interval:', $interval, 'units'); return ( col => $q->quote($args{chunk_col}), @@ -3012,21 +3012,21 @@ sub _chunk_char { $sql = "SELECT MIN($chunk_col), MAX($chunk_col) FROM $db_tbl " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my ($min_col, $max_col) = ($row->[0], $row->[1]); $sql = "SELECT ORD(?) AS min_col_ord, ORD(?) AS max_col_ord"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ord_sth = $dbh->prepare($sql); # avoid quoting issues $ord_sth->execute($min_col, $max_col); $row = $ord_sth->fetchrow_arrayref(); my ($min_col_ord, $max_col_ord) = ($row->[0], $row->[1]); - MKDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); + PTDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); my $base; my @chars; - MKDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); + PTDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); if ( ($args{tbl_struct}->{charset} || "") eq "latin1" ) { my @sorted_latin1_chars = ( 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, @@ -3054,16 +3054,16 @@ sub _chunk_char { my $tmp_tbl = '__maatkit_char_chunking_map'; my $tmp_db_tbl = $q->quote($args{db}, $tmp_tbl); $sql = "DROP TABLE IF EXISTS $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); my $col_def = $args{tbl_struct}->{defs}->{$chunk_col}; $sql = "CREATE TEMPORARY TABLE $tmp_db_tbl ($col_def) " . "ENGINE=MEMORY"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); $sql = "INSERT INTO $tmp_db_tbl VALUE (CHAR(?))"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ins_char_sth = $dbh->prepare($sql); # avoid quoting issues for my $char_code ( $min_col_ord..$max_col_ord ) { $ins_char_sth->execute($char_code); @@ -3072,7 +3072,7 @@ sub _chunk_char { $sql = "SELECT `$chunk_col` FROM $tmp_db_tbl " . "WHERE `$chunk_col` BETWEEN ? AND ? " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sel_char_sth = $dbh->prepare($sql); $sel_char_sth->execute($min_col, $max_col); @@ -3080,22 +3080,22 @@ sub _chunk_char { $base = scalar @chars; $sql = "DROP TABLE $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } - MKDEBUG && _d("Base", $base, "chars:", @chars); + PTDEBUG && _d("Base", $base, "chars:", @chars); $sql = "SELECT MAX(LENGTH($chunk_col)) FROM $db_tbl ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my $max_col_len = $row->[0]; - MKDEBUG && _d("Max column value:", $max_col, $max_col_len); + PTDEBUG && _d("Max column value:", $max_col, $max_col_len); my $n_values; for my $n_chars ( 1..$max_col_len ) { $n_values = $base**$n_chars; if ( $n_values >= $args{chunk_size} ) { - MKDEBUG && _d($n_chars, "chars in base", $base, "expresses", + PTDEBUG && _d($n_chars, "chars in base", $base, "expresses", $n_values, "values"); last; } @@ -3140,7 +3140,7 @@ sub get_first_chunkable_column { my $wanted_col = $args{chunk_column}; my $wanted_idx = $args{chunk_index}; - MKDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); + PTDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); if ( $wanted_col && $wanted_idx ) { foreach my $chunkable_col ( @cols ) { @@ -3171,7 +3171,7 @@ sub get_first_chunkable_column { } } - MKDEBUG && _d('First chunkable col/index:', $col, $idx); + PTDEBUG && _d('First chunkable col/index:', $col, $idx); return $col, $idx; } @@ -3233,9 +3233,9 @@ sub get_range_statistics { my $sql = "SELECT MIN($col), MAX($col) FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE ($where)" : ''); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); ($min, $max) = $dbh->selectrow_array($sql); - MKDEBUG && _d("Actual end points:", $min, $max); + PTDEBUG && _d("Actual end points:", $min, $max); ($min, $max) = $self->get_valid_end_points( %args, @@ -3246,7 +3246,7 @@ sub get_range_statistics { min => $min, max => $max, ); - MKDEBUG && _d("Valid end points:", $min, $max); + PTDEBUG && _d("Valid end points:", $min, $max); }; if ( $EVAL_ERROR ) { die "Error getting min and max values for table $db_tbl " @@ -3256,7 +3256,7 @@ sub get_range_statistics { my $sql = "EXPLAIN SELECT * FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE $where" : ''); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); return ( @@ -3271,7 +3271,7 @@ sub inject_chunks { foreach my $arg ( qw(database table chunks chunk_num query) ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Injecting chunk', $args{chunk_num}); + PTDEBUG && _d('Injecting chunk', $args{chunk_num}); my $query = $args{query}; my $comment = sprintf("/*%s.%s:%d/%d*/", $args{database}, $args{table}, @@ -3286,7 +3286,7 @@ sub inject_chunks { my $db_tbl = $self->{Quoter}->quote(@args{qw(database table)}); my $index_hint = $args{index_hint} || ''; - MKDEBUG && _d('Parameters:', + PTDEBUG && _d('Parameters:', Dumper({WHERE => $where, DB_TBL => $db_tbl, INDEX_HINT => $index_hint})); $query =~ s!/\*WHERE\*/! $where!; $query =~ s!/\*DB_TBL\*/!$db_tbl!; @@ -3305,7 +3305,7 @@ sub value_to_number { } my $val = $args{value}; my ($col_type, $dbh) = @args{@required_args}; - MKDEBUG && _d('Converting MySQL', $col_type, $val); + PTDEBUG && _d('Converting MySQL', $col_type, $val); return unless defined $val; # value is NULL @@ -3323,7 +3323,7 @@ sub value_to_number { elsif ( $col_type =~ m/^(?:timestamp|date|time)$/ ) { my $func = $mysql_conv_func_for{$col_type}; my $sql = "SELECT $func(?)"; - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val); ($num) = $sth->fetchrow_array(); @@ -3334,7 +3334,7 @@ sub value_to_number { else { die "I don't know how to chunk $col_type\n"; } - MKDEBUG && _d('Converts to', $num); + PTDEBUG && _d('Converts to', $num); return $num; } @@ -3360,14 +3360,14 @@ sub range_num { sub range_time { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT SEC_TO_TIME($start), SEC_TO_TIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_date { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_DAYS($start), FROM_DAYS(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -3375,14 +3375,14 @@ sub range_datetime { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $start SECOND), " . "DATE_ADD('$self->{EPOCH}', INTERVAL LEAST($max, $start + $interval) SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_timestamp { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_UNIXTIME($start), FROM_UNIXTIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -3390,10 +3390,10 @@ sub timestampdiff { my ( $self, $dbh, $time ) = @_; my $sql = "SELECT (COALESCE(TO_DAYS('$time'), 0) * 86400 + TIME_TO_SEC('$time')) " . "- TO_DAYS('$self->{EPOCH} 00:00:00') * 86400"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $diff ) = $dbh->selectrow_array($sql); $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $diff SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $check ) = $dbh->selectrow_array($sql); die <<" EOF" Incorrect datetime math: given $time, calculated $diff but checked to $check. @@ -3425,7 +3425,7 @@ sub get_valid_end_points { my $valid_min = $real_min; if ( defined $valid_min ) { - MKDEBUG && _d("Validating min end point:", $real_min); + PTDEBUG && _d("Validating min end point:", $real_min); $valid_min = $self->_get_valid_end_point( %args, val => $real_min, @@ -3438,7 +3438,7 @@ sub get_valid_end_points { my $valid_max = $real_max; if ( defined $valid_max ) { - MKDEBUG && _d("Validating max end point:", $real_min); + PTDEBUG && _d("Validating max end point:", $real_min); $valid_max = $self->_get_valid_end_point( %args, val => $real_max, @@ -3467,13 +3467,13 @@ sub _get_valid_end_point { : undef; if ( !$validate ) { - MKDEBUG && _d("No validator for", $col_type, "values"); + PTDEBUG && _d("No validator for", $col_type, "values"); return $val; } return $val if defined $validate->($dbh, $val); - MKDEBUG && _d("Value is invalid, getting first valid value"); + PTDEBUG && _d("Value is invalid, getting first valid value"); $val = $self->get_first_valid_value( %args, val => $val, @@ -3503,20 +3503,20 @@ sub get_first_valid_value { . "WHERE $col $cmp ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : "") . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sth = $dbh->prepare($sql); my $last_val = $val; while ( $tries-- ) { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); - MKDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); + PTDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); if ( !defined $next_val ) { - MKDEBUG && _d('No more rows in table'); + PTDEBUG && _d('No more rows in table'); last; } if ( defined $validate->($dbh, $next_val) ) { - MKDEBUG && _d('First valid value:', $next_val); + PTDEBUG && _d('First valid value:', $next_val); $sth->finish(); return $next_val; } @@ -3533,14 +3533,14 @@ sub _validate_temporal_value { my $sql = "SELECT IF(TIME_FORMAT(?,'%H:%i:%s')=?, TIME_TO_SEC(?), TO_DAYS(?))"; my $res; eval { - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val, $val, $val, $val); ($res) = $sth->fetchrow_array(); $sth->finish(); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } return $res; } @@ -3559,13 +3559,13 @@ sub get_nonzero_value { : sub { return $_[1]; }; if ( !$is_nonzero->($dbh, $val) ) { # quasi-double-negative, sorry - MKDEBUG && _d('Discarding zero value:', $val); + PTDEBUG && _d('Discarding zero value:', $val); my $sql = "SELECT $col FROM $db_tbl " . ($args{index_hint} ? "$args{index_hint} " : "") . "WHERE $col > ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : '') . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); my $last_val = $val; @@ -3573,7 +3573,7 @@ sub get_nonzero_value { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); if ( $is_nonzero->($dbh, $next_val) ) { - MKDEBUG && _d('First non-zero value:', $next_val); + PTDEBUG && _d('First non-zero value:', $next_val); $sth->finish(); return $next_val; } @@ -3644,7 +3644,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3785,7 +3785,7 @@ package OSCCaptureSync; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3903,7 +3903,7 @@ package CopyRowsInsertSelect; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3947,7 +3947,7 @@ sub copy { $msg->($sql); } else { - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $error; $self->{Retry}->retry( wait => sub { sleep 1; }, @@ -3958,7 +3958,7 @@ sub copy { $dbh->do($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/Lock wait timeout exceeded/ ) { $error = $EVAL_ERROR; if ( $args{tryno} > 1 ) { @@ -4015,7 +4015,7 @@ package Retry; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4036,35 +4036,35 @@ sub retry { my $tryno = 0; while ( ++$tryno <= $tries ) { - MKDEBUG && _d("Retry", $tryno, "of", $tries); + PTDEBUG && _d("Retry", $tryno, "of", $tries); my $result; eval { $result = $try->(tryno=>$tryno); }; if ( defined $result ) { - MKDEBUG && _d("Try code succeeded"); + PTDEBUG && _d("Try code succeeded"); if ( my $on_success = $args{on_success} ) { - MKDEBUG && _d("Calling on_success code"); + PTDEBUG && _d("Calling on_success code"); $on_success->(tryno=>$tryno, result=>$result); } return $result; } if ( $EVAL_ERROR ) { - MKDEBUG && _d("Try code died:", $EVAL_ERROR); + PTDEBUG && _d("Try code died:", $EVAL_ERROR); die $EVAL_ERROR unless $args{retry_on_die}; } if ( $tryno < $tries ) { - MKDEBUG && _d("Try code failed, calling wait code"); + PTDEBUG && _d("Try code failed, calling wait code"); $wait->(tryno=>$tryno); } } - MKDEBUG && _d("Try code did not succeed"); + PTDEBUG && _d("Try code did not succeed"); if ( my $on_failure = $args{on_failure} ) { - MKDEBUG && _d("Calling on_failure code"); + PTDEBUG && _d("Calling on_failure code"); $on_failure->(); } @@ -4104,7 +4104,7 @@ $Data::Dumper::Quotekeys = 0; Transformers->import qw(ts); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $quiet = 0; # for msg() @@ -4249,10 +4249,10 @@ sub main { ); if ( my $sleep_time = $o->get('sleep') ) { - MKDEBUG && _d("Sleep time:", $sleep_time); + PTDEBUG && _d("Sleep time:", $sleep_time); $plugin_args{sleep} = sub { my ( $chunkno ) = @_; - MKDEBUG && _d("Sleeping after chunk", $chunkno); + PTDEBUG && _d("Sleeping after chunk", $chunkno); sleep($sleep_time); }; } @@ -4583,7 +4583,7 @@ sub get_child_tables { my $sql = "SELECT table_name " . "FROM information_schema.key_column_usage " . "WHERE constraint_schema='$db' AND referenced_table_name='$tbl'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $child_tables; eval { $child_tables = $dbh->selectall_arrayref($sql); @@ -4594,7 +4594,7 @@ sub get_child_tables { . "Error: $EVAL_ERROR" } - MKDEBUG && _d("Child tables:", join(', ', map { $_->[0] } @$child_tables)); + PTDEBUG && _d("Child tables:", join(', ', map { $_->[0] } @$child_tables)); return map { $_->[0] } @$child_tables; } @@ -4612,7 +4612,7 @@ sub update_foreign_key_constraints { CHILD_TABLE: foreach my $child_table ( @$child_tables ) { my $sql = "SHOW CREATE TABLE `$db`.`$child_table`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $msg->($sql); my $table_def; eval { @@ -4673,7 +4673,7 @@ sub msg { my ( $msg ) = @_; chomp $msg; print '# ', ts(time), " $msg\n" unless $quiet; - MKDEBUG && _d($msg); + PTDEBUG && _d($msg); return; } diff --git a/bin/pt-query-advisor b/bin/pt-query-advisor index b61e1a69..80b877d2 100755 --- a/bin/pt-query-advisor +++ b/bin/pt-query-advisor @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -184,7 +184,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -229,7 +229,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -239,21 +239,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -265,15 +265,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -291,7 +291,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -317,7 +317,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -378,7 +378,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -462,7 +462,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -506,7 +506,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -543,7 +543,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -552,7 +552,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -571,7 +571,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -579,7 +579,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -617,7 +617,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -630,7 +630,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -656,14 +656,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -672,13 +672,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -686,17 +686,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -710,7 +710,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -720,7 +720,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -734,7 +734,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -757,7 +757,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -786,7 +786,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -817,7 +817,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -884,7 +884,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -933,7 +933,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -957,12 +957,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -971,23 +971,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -996,7 +996,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1006,7 +1006,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1080,11 +1080,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1299,7 +1299,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1309,7 +1309,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1333,7 +1333,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1346,7 +1346,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1373,7 +1373,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1403,7 +1403,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1480,7 +1480,7 @@ package SlowLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1532,7 +1532,7 @@ sub parse_event { if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); if ( @chunks > 1 ) { - MKDEBUG && _d("Found multiple chunks"); + PTDEBUG && _d("Found multiple chunks"); $stmt = shift @chunks; unshift @$pending, @chunks; } @@ -1550,18 +1550,18 @@ sub parse_event { while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - MKDEBUG && _d("Got ts", $time); + PTDEBUG && _d("Got ts", $time); push @properties, 'ts', $time; ++$got_ts; if ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } @@ -1570,13 +1570,13 @@ sub parse_event { elsif ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - MKDEBUG && _d("Got admin command"); + PTDEBUG && _d("Got admin command"); $line =~ s/^#\s+//; # string leading "# ". push @properties, 'cmd', 'Admin', 'arg', $line; push @properties, 'bytes', length($properties[-1]); @@ -1585,12 +1585,12 @@ sub parse_event { } elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - MKDEBUG && _d("Got some line with properties"); + PTDEBUG && _d("Got some line with properties"); if ( $line =~ m/Schema:\s+\w+: / ) { - MKDEBUG && _d('Removing empty Schema attrib'); + PTDEBUG && _d('Removing empty Schema attrib'); $line =~ s/Schema:\s+//; - MKDEBUG && _d($line); + PTDEBUG && _d($line); } my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; @@ -1598,36 +1598,36 @@ sub parse_event { } elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; ++$got_db; } elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, split(/,|\s*=\s*/, $setting); ++$got_set; } if ( !$found_arg && $pos == $len ) { - MKDEBUG && _d("Did not find arg, looking for special cases"); + PTDEBUG && _d("Did not find arg, looking for special cases"); local $INPUT_RECORD_SEPARATOR = ";\n"; if ( defined(my $l = $next_event->()) ) { chomp $l; $l =~ s/^\s+//; - MKDEBUG && _d("Found admin statement", $l); + PTDEBUG && _d("Found admin statement", $l); push @properties, 'cmd', 'Admin', 'arg', $l; push @properties, 'bytes', length($properties[-1]); $found_arg++; } else { - MKDEBUG && _d("I can't figure out what to do with this line"); + PTDEBUG && _d("I can't figure out what to do with this line"); next EVENT; } } } else { - MKDEBUG && _d("Got the query/arg line"); + PTDEBUG && _d("Got the query/arg line"); my $arg = substr($stmt, $pos - length($line)); push @properties, 'arg', $arg, 'bytes', length($arg); if ( $args{misc} && $args{misc}->{embed} @@ -1639,7 +1639,7 @@ sub parse_event { } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -1681,7 +1681,7 @@ package GeneralLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1726,10 +1726,10 @@ sub parse_event { defined($line = shift @$pending) or defined($line = $next_event->()) ) { - MKDEBUG && _d($line); + PTDEBUG && _d($line); my ($ts, $thread_id, $cmd, $arg) = $line =~ m/$genlog_line_1/; if ( !($thread_id && $cmd) ) { - MKDEBUG && _d('Not start of general log event'); + PTDEBUG && _d('Not start of general log event'); next; } my @properties = ('pos_in_log', $pos_in_log, 'ts', $ts, @@ -1746,17 +1746,17 @@ sub parse_event { my (undef, $next_thread_id, $next_cmd) = $line =~ m/$genlog_line_1/; if ( $next_thread_id && $next_cmd ) { - MKDEBUG && _d('Event done'); + PTDEBUG && _d('Event done'); $done = 1; push @$pending, $line; } else { - MKDEBUG && _d('More arg:', $line); + PTDEBUG && _d('More arg:', $line); $arg .= $line; } } else { - MKDEBUG && _d('No more lines'); + PTDEBUG && _d('No more lines'); $done = 1; } } until ( $done ); @@ -1777,7 +1777,7 @@ sub parse_event { my ($user, undef, $db) = $arg =~ /(\S+)/g; my $host; ($user, $host) = split(/@/, $user); - MKDEBUG && _d('Connect', $user, '@', $host, 'on', $db); + PTDEBUG && _d('Connect', $user, '@', $host, 'on', $db); push @properties, 'user', $user if $user; push @properties, 'host', $host if $host; @@ -1789,7 +1789,7 @@ sub parse_event { $cmd = 'Init DB'; $arg =~ s/^DB\s+//; my ($db) = $arg =~ /(\S+)/; - MKDEBUG && _d('Init DB:', $db); + PTDEBUG && _d('Init DB:', $db); push @properties, 'db', $db if $db; $db_for->{$thread_id} = $db; } @@ -1800,7 +1800,7 @@ sub parse_event { push @properties, 'Query_time', 0; - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -1842,7 +1842,7 @@ package QueryParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $tbl_ident = qr/(?:`[^`]+`|\w+)(?:\.(?:`[^`]+`|\w+))?/; our $tbl_regex = qr{ @@ -1870,33 +1870,33 @@ sub new { sub get_tables { my ( $self, $query ) = @_; return unless $query; - MKDEBUG && _d('Getting tables for', $query); + PTDEBUG && _d('Getting tables for', $query); my ( $ddl_stmt ) = $query =~ m/^\s*($data_def_stmts)\b/i; if ( $ddl_stmt ) { - MKDEBUG && _d('Special table type:', $ddl_stmt); + PTDEBUG && _d('Special table type:', $ddl_stmt); $query =~ s/IF\s+(?:NOT\s+)?EXISTS//i; if ( $query =~ m/$ddl_stmt DATABASE\b/i ) { - MKDEBUG && _d('Query alters a database, not a table'); + PTDEBUG && _d('Query alters a database, not a table'); return (); } if ( $ddl_stmt =~ m/CREATE/i && $query =~ m/$ddl_stmt\b.+?\bSELECT\b/i ) { my ($select) = $query =~ m/\b(SELECT\b.+)/is; - MKDEBUG && _d('CREATE TABLE ... SELECT:', $select); + PTDEBUG && _d('CREATE TABLE ... SELECT:', $select); return $self->get_tables($select); } my ($tbl) = $query =~ m/TABLE\s+($tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches table:', $tbl); + PTDEBUG && _d('Matches table:', $tbl); return ($tbl); } $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; if ( $query =~ /^\s*LOCK TABLES/i ) { - MKDEBUG && _d('Special table type: LOCK TABLES'); + PTDEBUG && _d('Special table type: LOCK TABLES'); $query =~ s/^(\s*LOCK TABLES\s+)//; $query =~ s/\s+(?:READ|WRITE|LOCAL)+\s*//g; - MKDEBUG && _d('Locked tables:', $query); + PTDEBUG && _d('Locked tables:', $query); $query = "FROM $query"; } @@ -1906,7 +1906,7 @@ sub get_tables { my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { - MKDEBUG && _d('Match tables:', $tbls); + PTDEBUG && _d('Match tables:', $tbls); next if $tbls =~ m/\ASELECT\b/i; @@ -1914,7 +1914,7 @@ sub get_tables { $tbl =~ s/\s*($tbl_ident)(\s+.*)?/$1/gio; if ( $tbl !~ m/[a-zA-Z]/ ) { - MKDEBUG && _d('Skipping suspicious table name:', $tbl); + PTDEBUG && _d('Skipping suspicious table name:', $tbl); next; } @@ -1927,7 +1927,7 @@ sub get_tables { sub has_derived_table { my ( $self, $query ) = @_; my $match = $query =~ m/$has_derived/; - MKDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); + PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); return $match; } @@ -1960,7 +1960,7 @@ sub get_aliases { $tbl_refs =~ s/\([^\)]+\)\s*//; } - MKDEBUG && _d('tbl refs:', $tbl_refs); + PTDEBUG && _d('tbl refs:', $tbl_refs); my $before_tbl = qr/(?:,|JOIN|\s|$from)+/i; @@ -1976,12 +1976,12 @@ sub get_aliases { }xgio ) { my ( $tbl_ref, $db_tbl, $alias ) = ($1, $2, $3); - MKDEBUG && _d('Match table:', $tbl_ref); + PTDEBUG && _d('Match table:', $tbl_ref); push @tbl_refs, $tbl_ref; $alias = $self->trim_identifier($alias); if ( $tbl_ref =~ m/^AS\s+\w+/i ) { - MKDEBUG && _d('Subquery', $tbl_ref); + PTDEBUG && _d('Subquery', $tbl_ref); $result->{TABLE}->{$alias} = undef; next; } @@ -1994,7 +1994,7 @@ sub get_aliases { } } else { - MKDEBUG && _d("No tables ref in", $query); + PTDEBUG && _d("No tables ref in", $query); } if ( $list ) { @@ -2009,7 +2009,7 @@ sub split { my ( $self, $query ) = @_; return unless $query; $query = $self->clean_query($query); - MKDEBUG && _d('Splitting', $query); + PTDEBUG && _d('Splitting', $query); my $verbs = qr{SELECT|INSERT|UPDATE|DELETE|REPLACE|UNION|CREATE}i; @@ -2029,7 +2029,7 @@ sub split { } } - MKDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); + PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); return @statements; } @@ -2055,12 +2055,12 @@ sub split_subquery { while ( $query =~ m/(\S+)(?:\s+|\Z)/g ) { $pos = pos($query); my $word = $1; - MKDEBUG && _d($word, $sqno); + PTDEBUG && _d($word, $sqno); if ( $word =~ m/^\(?SELECT\b/i ) { my $start_pos = $pos - length($word) - 1; if ( $start_pos ) { $sqno++; - MKDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); + PTDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); $subqueries[$sqno] = { start_pos => $start_pos, end_pos => 0, @@ -2072,25 +2072,25 @@ sub split_subquery { }; } else { - MKDEBUG && _d('Main SELECT at pos 0'); + PTDEBUG && _d('Main SELECT at pos 0'); } } else { next unless $sqno; # next unless we're in a subquery - MKDEBUG && _d('In subquery', $sqno); + PTDEBUG && _d('In subquery', $sqno); my $sq = $subqueries[$sqno]; if ( $sq->{done} ) { - MKDEBUG && _d('This subquery is done; SQL is for', + PTDEBUG && _d('This subquery is done; SQL is for', ($sqno - 1 ? "subquery $sqno" : "the main SELECT")); next; } push @{$sq->{words}}, $word; my $lp = ($word =~ tr/\(//) || 0; my $rp = ($word =~ tr/\)//) || 0; - MKDEBUG && _d('parentheses left', $lp, 'right', $rp); + PTDEBUG && _d('parentheses left', $lp, 'right', $rp); if ( ($sq->{lp} + $lp) - ($sq->{rp} + $rp) == 0 ) { my $end_pos = $pos - 1; - MKDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); + PTDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); $sq->{end_pos} = $end_pos; $sq->{len} = $end_pos - $sq->{start_pos}; } @@ -2156,7 +2156,7 @@ sub get_columns { ($cols_def) = $query =~ m/\(([^\)]+)\)\s*VALUE/i; } - MKDEBUG && _d('Columns:', $cols_def); + PTDEBUG && _d('Columns:', $cols_def); if ( $cols_def ) { @$cols = split(',', $cols_def); map { @@ -2197,7 +2197,7 @@ sub extract_tables { my $default_db = $args{default_db}; my $q = $self->{Quoter} || $args{Quoter}; return unless $query; - MKDEBUG && _d('Extracting tables'); + PTDEBUG && _d('Extracting tables'); my @tables; my %seen; foreach my $db_tbl ( $self->get_tables($query) ) { @@ -2246,7 +2246,7 @@ package QueryRewriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; @@ -2395,7 +2395,7 @@ sub distill_verbs { $query = $self->strip_comments($query); if ( $query =~ m/\A\s*SHOW\s+/i ) { - MKDEBUG && _d($query); + PTDEBUG && _d($query); $query = uc $query; $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; @@ -2405,7 +2405,7 @@ sub distill_verbs { $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; $query =~ s/\s+/ /g; - MKDEBUG && _d($query); + PTDEBUG && _d($query); return $query; } @@ -2415,10 +2415,10 @@ sub distill_verbs { if ( $dds) { my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; $obj = uc $obj if $obj; - MKDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); + PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); my ($db_or_tbl) = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches db or table:', $db_or_tbl); + PTDEBUG && _d('Matches db or table:', $db_or_tbl); return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; } @@ -2429,7 +2429,7 @@ sub distill_verbs { }; if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - MKDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); + PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); my $union = grep { $_ eq 'UNION' } @verbs; @verbs = $union ? qw(SELECT UNION) : qw(SELECT); } @@ -2556,12 +2556,12 @@ sub __delete_to_select { sub __insert_to_select { my ( $tbl, $cols, $vals ) = @_; - MKDEBUG && _d('Args:', @_); + PTDEBUG && _d('Args:', @_); my @cols = split(/,/, $cols); - MKDEBUG && _d('Cols:', @cols); + PTDEBUG && _d('Cols:', @cols); $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - MKDEBUG && _d('Vals:', @vals); + PTDEBUG && _d('Vals:', @vals); if ( @cols == @vals ) { return "select * from $tbl where " . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); @@ -2620,7 +2620,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -2800,36 +2800,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -2876,7 +2876,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2894,17 +2894,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2946,19 +2946,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2976,7 +2976,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2996,7 +2996,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -3009,7 +3009,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -3018,10 +3018,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -3062,7 +3062,7 @@ package Advisor; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3083,7 +3083,7 @@ sub new { sub load_rules { my ( $self, $advisor ) = @_; return unless $advisor; - MKDEBUG && _d('Loading rules from', ref $advisor); + PTDEBUG && _d('Loading rules from', ref $advisor); my $i = scalar @{$self->{rules}}; @@ -3091,7 +3091,7 @@ sub load_rules { foreach my $rule ( $advisor->get_rules() ) { my $id = $rule->{id}; if ( $self->{ignore_rules}->{"$id"} ) { - MKDEBUG && _d("Ignoring rule", $id); + PTDEBUG && _d("Ignoring rule", $id); next RULE; } die "Rule $id already exists and cannot be redefined" @@ -3106,7 +3106,7 @@ sub load_rules { sub load_rule_info { my ( $self, $advisor ) = @_; return unless $advisor; - MKDEBUG && _d('Loading rule info from', ref $advisor); + PTDEBUG && _d('Loading rule info from', ref $advisor); my $rules = $self->{rules}; foreach my $rule ( @$rules ) { my $id = $rule->{id}; @@ -3134,14 +3134,14 @@ sub run_rules { my $match = $rule->{code}->(%args); if ( $match_type eq 'pos' ) { if ( defined $match ) { - MKDEBUG && _d('Matches rule', $rule->{id}, 'near pos', $match); + PTDEBUG && _d('Matches rule', $rule->{id}, 'near pos', $match); push @matched_rules, $rule->{id}; push @matched_pos, $match; } } elsif ( $match_type eq 'bool' ) { if ( $match ) { - MKDEBUG && _d("Matches rule", $rule->{id}); + PTDEBUG && _d("Matches rule", $rule->{id}); push @matched_rules, $rule->{id}; } } @@ -3188,7 +3188,7 @@ package AdvisorRules; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -3276,13 +3276,13 @@ use base 'AdvisorRules'; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; my $self = $class->SUPER::new(%args); @{$self->{rules}} = $self->get_rules(); - MKDEBUG && _d(scalar @{$self->{rules}}, "rules"); + PTDEBUG && _d(scalar @{$self->{rules}}, "rules"); return $self; } @@ -3660,7 +3660,7 @@ sub get_rules { return unless $where; my %outer_tbls = map { $_->{tbl} => 1 } get_outer_tables($tbls); - MKDEBUG && _d("Outer tables:", keys %outer_tbls); + PTDEBUG && _d("Outer tables:", keys %outer_tbls); return unless %outer_tbls; foreach my $pred ( @$where ) { @@ -3669,7 +3669,7 @@ sub get_rules { if ( $tbl && $col && $outer_tbls{$tbl} ) { if ($pred->{operator} ne 'is' || $pred->{right_arg} !~ m/null/i) { - MKDEBUG && _d("Predicate prevents OUTER JOIN:", + PTDEBUG && _d("Predicate prevents OUTER JOIN:", map { $pred->{$_} } qw(left_arg operator right_arg)); return 0; } @@ -3720,7 +3720,7 @@ sub get_rules { next unless $pred->{operator} eq '='; push @join_cols, $pred->{left_arg}, $pred->{right_arg}; } - MKDEBUG && _d("Join columns:", @join_cols); + PTDEBUG && _d("Join columns:", @join_cols); foreach my $join_col ( @join_cols ) { my ($tbl, $col) = split /\./, $join_col; if ( !$col ) { @@ -3731,7 +3731,7 @@ sub get_rules { ); } if ( !$tbl ) { - MKDEBUG && _d("Cannot determine the table for join column", + PTDEBUG && _d("Cannot determine the table for join column", $col); push @unknown_join_cols, $col; } @@ -3742,8 +3742,8 @@ sub get_rules { } } } - MKDEBUG && _d("Outer table join columns:", keys %outer_tbl_join_cols); - MKDEBUG && _d("Unknown join columns:", @unknown_join_cols); + PTDEBUG && _d("Outer table join columns:", keys %outer_tbl_join_cols); + PTDEBUG && _d("Unknown join columns:", @unknown_join_cols); foreach my $pred ( @$where ) { next unless $pred->{left_arg}; # skip constants like 1 in "WHERE 1" @@ -3802,13 +3802,13 @@ sub determine_table_for_column { foreach my $db ( keys %$tbl_structs ) { foreach my $tbl ( keys %{$tbl_structs->{$db}} ) { if ( $tbl_structs->{$db}->{$tbl}->{is_col}->{$col} ) { - MKDEBUG && _d($col, "column belongs to", $db, $tbl); + PTDEBUG && _d($col, "column belongs to", $db, $tbl); return $tbl; } } } - MKDEBUG && _d("Cannot determine table for column", $col); + PTDEBUG && _d("Cannot determine table for column", $col); return; } @@ -3840,7 +3840,7 @@ package PodParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my %parse_items_from = ( 'OPTIONS' => 1, @@ -3885,7 +3885,7 @@ sub get_magic { sub parse_from_file { my ( $self, $file ) = @_; return unless $file; - MKDEBUG && _d('Parsing POD in', $file); + PTDEBUG && _d('Parsing POD in', $file); open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs my $para; @@ -3897,7 +3897,7 @@ sub parse_from_file { if ( $para =~ m/^=(head|item|over|back)/ ) { my ($cmd, $name) = $para =~ m/^=(\w+)(?:\s+(.+))?/; $name ||= ''; - MKDEBUG && _d('cmd:', $cmd, 'name:', $name); + PTDEBUG && _d('cmd:', $cmd, 'name:', $name); $self->command($cmd, $name); } elsif ( $parse_items_from{$self->{current_section}} ) { @@ -3914,12 +3914,12 @@ sub command { $name =~ s/\s+\Z//m; # Remove \n and blank line after name. if ( $cmd eq 'head1' ) { - MKDEBUG && _d('In section', $name); + PTDEBUG && _d('In section', $name); $self->{current_section} = $name; } elsif ( $cmd eq 'over' ) { if ( $parse_items_from{$name} ) { - MKDEBUG && _d('Start items in', $self->{current_section}); + PTDEBUG && _d('Start items in', $self->{current_section}); $self->{items}->{$self->{current_section}} = {}; } } @@ -3927,7 +3927,7 @@ sub command { my $pat = $item_pattern_for{ $self->{current_section} }; my ($item) = $name =~ m/$pat/; if ( $item ) { - MKDEBUG && _d($self->{current_section}, 'item:', $item); + PTDEBUG && _d($self->{current_section}, 'item:', $item); $self->{items}->{ $self->{current_section} }->{$item} = { desc => '', # every item should have a desc }; @@ -3939,7 +3939,7 @@ sub command { } elsif ( $cmd eq 'back' ) { if ( $parse_items_from{$self->{current_section}} ) { - MKDEBUG && _d('End items in', $self->{current_section}); + PTDEBUG && _d('End items in', $self->{current_section}); } } else { @@ -3960,7 +3960,7 @@ sub textblock { $para =~ s/\s+\Z//; if ( $para =~ m/^[a-z]\w+[:;] / ) { - MKDEBUG && _d('Item attributes:', $para); + PTDEBUG && _d('Item attributes:', $para); map { my ($attrib, $val) = split(/: /, $_); $item->{$attrib} = defined $val ? $val : 1; @@ -3974,26 +3974,26 @@ sub textblock { if ( $indent ) { $para =~ s/^\s{$indent}//mg; $para =~ s/\s+$//; - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); $self->{magic}->{$self->{current_section}}->{$self->{magic_ident}} = $para; } else { - MKDEBUG && _d("MAGIC", $self->{magic_ident}, + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para is not indented; treating as normal para"); } $self->{magic_ident} = ''; # must unset this! } - MKDEBUG && _d('Item desc:', substr($para, 0, 40), + PTDEBUG && _d('Item desc:', substr($para, 0, 40), length($para) > 40 ? '...' : ''); $para =~ s/\n+/ /g; $item->{desc} .= $para; if ( $para =~ m/MAGIC_(\w+)/ ) { $self->{magic_ident} = $1; # XXX - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); } } @@ -4033,7 +4033,7 @@ package SQLParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4088,7 +4088,7 @@ sub parse { my $type; if ( $query =~ s/^(\w+)\s+// ) { $type = lc $1; - MKDEBUG && _d('Query type:', $type); + PTDEBUG && _d('Query type:', $type); die "Cannot parse " . uc($type) . " queries" unless $type =~ m/$allowed_types/i; } @@ -4100,7 +4100,7 @@ sub parse { my @subqueries; if ( $query =~ m/(\(SELECT )/i ) { - MKDEBUG && _d('Removing subqueries'); + PTDEBUG && _d('Removing subqueries'); @subqueries = $self->remove_subqueries($query); $query = shift @subqueries; } @@ -4108,14 +4108,14 @@ sub parse { my $parse_func = "parse_$type"; my $struct = $self->$parse_func($query); if ( !$struct ) { - MKDEBUG && _d($parse_func, 'failed to parse query'); + PTDEBUG && _d($parse_func, 'failed to parse query'); return; } $struct->{type} = $type; $self->_parse_clauses($struct); if ( @subqueries ) { - MKDEBUG && _d('Parsing subqueries'); + PTDEBUG && _d('Parsing subqueries'); foreach my $subquery ( @subqueries ) { my $subquery_struct = $self->parse($subquery->{query}); @{$subquery_struct}{keys %$subquery} = values %$subquery; @@ -4123,7 +4123,7 @@ sub parse { } } - MKDEBUG && _d('Query struct:', Dumper($struct)); + PTDEBUG && _d('Query struct:', Dumper($struct)); return $struct; } @@ -4142,7 +4142,7 @@ sub _parse_clauses { $struct->{$clause} = $self->$parse_func($struct->{clauses}->{$clause}); if ( $clause eq 'select' ) { - MKDEBUG && _d('Parsing subquery clauses'); + PTDEBUG && _d('Parsing subquery clauses'); $struct->{select}->{type} = 'select'; $self->_parse_clauses($struct->{select}); } @@ -4188,13 +4188,13 @@ sub _parse_query { my $clause = $first_clause, my $value = shift @clause; $struct->{clauses}->{$clause} = $value; - MKDEBUG && _d('Clause:', $clause, $value); + PTDEBUG && _d('Clause:', $clause, $value); while ( @clause ) { $clause = shift @clause; $value = shift @clause; $struct->{clauses}->{lc $clause} = $value; - MKDEBUG && _d('Clause:', $clause, $value); + PTDEBUG && _d('Clause:', $clause, $value); } ($struct->{unknown}) = ($query =~ m/\G(.+)/); @@ -4226,7 +4226,7 @@ sub parse_insert { my $values = $1; die "No values after ON DUPLICATE KEY UPDATE: $query" unless $values; $struct->{clauses}->{on_duplicate} = $values; - MKDEBUG && _d('Clause: on duplicate key update', $values); + PTDEBUG && _d('Clause: on duplicate key update', $values); $query =~ s/\s+ON DUPLICATE KEY UPDATE.+//; } @@ -4240,13 +4240,13 @@ sub parse_insert { ) { my $tbl = shift @into; # table ref $struct->{clauses}->{into} = $tbl; - MKDEBUG && _d('Clause: into', $tbl); + PTDEBUG && _d('Clause: into', $tbl); my $cols = shift @into; # columns, maybe if ( $cols ) { $cols =~ s/[\(\)]//g; $struct->{clauses}->{columns} = $cols; - MKDEBUG && _d('Clause: columns', $cols); + PTDEBUG && _d('Clause: columns', $cols); } my $next_clause = lc(shift @into); # VALUES, SET or SELECT @@ -4256,7 +4256,7 @@ sub parse_insert { my ($values) = ($query =~ m/\G(.+)/gci); die "INSERT/REPLACE without values: $query" unless $values; $struct->{clauses}->{$next_clause} = $values; - MKDEBUG && _d('Clause:', $next_clause, $values); + PTDEBUG && _d('Clause:', $next_clause, $values); } ($struct->{unknown}) = ($query =~ m/\G(.+)/); @@ -4315,7 +4315,7 @@ sub parse_update { sub parse_from { my ( $self, $from ) = @_; return unless $from; - MKDEBUG && _d('Parsing FROM', $from); + PTDEBUG && _d('Parsing FROM', $from); my $comma_join = qr/(?>\s*,\s*)/; my $ansi_join = qr/(?> @@ -4333,10 +4333,10 @@ sub parse_from { $thing =~ s/^\s+//; $thing =~ s/\s+$//; - MKDEBUG && _d('Table thing:', $thing); + PTDEBUG && _d('Table thing:', $thing); if ( $thing =~ m/\s+(?:ON|USING)\s+/i ) { - MKDEBUG && _d("JOIN condition"); + PTDEBUG && _d("JOIN condition"); my ($tbl_ref_txt, $join_condition_verb, $join_condition_value) = $thing =~ m/^(.+?)\s+(ON|USING)\s+(.+)/i; @@ -4358,7 +4358,7 @@ sub parse_from { $tbl_ref->{join} = $join; } push @tbls, $tbl_ref; - MKDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); + PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); $tbl_ref = undef; $join = {}; @@ -4376,7 +4376,7 @@ sub parse_from { } else { $tbl_ref = $self->parse_table_reference($thing); - MKDEBUG && _d('Table reference:', Dumper($tbl_ref)); + PTDEBUG && _d('Table reference:', Dumper($tbl_ref)); } } @@ -4385,7 +4385,7 @@ sub parse_from { $tbl_ref->{join} = $join; } push @tbls, $tbl_ref; - MKDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); + PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); } return \@tbls; @@ -4394,7 +4394,7 @@ sub parse_from { sub parse_table_reference { my ( $self, $tbl_ref ) = @_; return unless $tbl_ref; - MKDEBUG && _d('Parsing table reference:', $tbl_ref); + PTDEBUG && _d('Parsing table reference:', $tbl_ref); my %tbl; if ( $tbl_ref =~ s/ @@ -4405,7 +4405,7 @@ sub parse_table_reference { )//xi) { $tbl{index_hint} = $1; - MKDEBUG && _d('Index hint:', $tbl{index_hint}); + PTDEBUG && _d('Index hint:', $tbl{index_hint}); } if ( $tbl_ref =~ m/$table_ident/ ) { @@ -4431,7 +4431,7 @@ sub parse_table_reference { sub parse_where { my ( $self, $where ) = @_; return unless $where; - MKDEBUG && _d("Parsing WHERE", $where); + PTDEBUG && _d("Parsing WHERE", $where); my $op_symbol = qr/ (?: @@ -4475,8 +4475,8 @@ sub parse_where { $pred = substr $where, $offset; push @pred, $pred; push @has_op, $pred =~ m/$op_pat/o ? 1 : 0; - MKDEBUG && _d("Predicate fragments:", Dumper(\@pred)); - MKDEBUG && _d("Predicate frags with operators:", @has_op); + PTDEBUG && _d("Predicate fragments:", Dumper(\@pred)); + PTDEBUG && _d("Predicate frags with operators:", @has_op); my $n = scalar @pred - 1; for my $i ( 1..$n ) { @@ -4490,7 +4490,7 @@ sub parse_where { $pred[$i] = undef; } } - MKDEBUG && _d("Predicate fragments joined:", Dumper(\@pred)); + PTDEBUG && _d("Predicate fragments joined:", Dumper(\@pred)); for my $i ( 0..@pred ) { $pred = $pred[$i]; @@ -4502,7 +4502,7 @@ sub parse_where { $pred[$i + 1] = undef; } } - MKDEBUG && _d("Predicate fragments balanced:", Dumper(\@pred)); + PTDEBUG && _d("Predicate fragments balanced:", Dumper(\@pred)); my @predicates; foreach my $pred ( @pred ) { @@ -4569,7 +4569,7 @@ sub parse_having { sub parse_group_by { my ( $self, $group_by ) = @_; return unless $group_by; - MKDEBUG && _d('Parsing GROUP BY', $group_by); + PTDEBUG && _d('Parsing GROUP BY', $group_by); my $with_rollup = $group_by =~ s/\s+WITH ROLLUP\s*//i; @@ -4583,7 +4583,7 @@ sub parse_group_by { sub parse_order_by { my ( $self, $order_by ) = @_; return unless $order_by; - MKDEBUG && _d('Parsing ORDER BY', $order_by); + PTDEBUG && _d('Parsing ORDER BY', $order_by); my $idents = $self->parse_identifiers( $self->_parse_csv($order_by) ); return $idents; } @@ -4622,7 +4622,7 @@ sub parse_values { sub parse_set { my ( $self, $set ) = @_; - MKDEBUG && _d("Parse SET", $set); + PTDEBUG && _d("Parse SET", $set); return unless $set; my $vals = $self->_parse_csv($set); return unless $vals && @$vals; @@ -4635,7 +4635,7 @@ sub parse_set { %$ident_struct, value => $val, }; - MKDEBUG && _d("SET:", Dumper($set_struct)); + PTDEBUG && _d("SET:", Dumper($set_struct)); push @set, $set_struct; } return \@set; @@ -4650,9 +4650,9 @@ sub _parse_csv { my $quote_char = ''; VAL: foreach my $val ( split(',', $vals) ) { - MKDEBUG && _d("Next value:", $val); + PTDEBUG && _d("Next value:", $val); if ( $quote_char ) { - MKDEBUG && _d("Value is part of previous quoted value"); + PTDEBUG && _d("Value is part of previous quoted value"); $vals[-1] .= ",$val"; if ( $val =~ m/[^\\]*$quote_char$/ ) { @@ -4660,7 +4660,7 @@ sub _parse_csv { $vals[-1] =~ s/^\s*$quote_char//; $vals[-1] =~ s/$quote_char\s*$//; } - MKDEBUG && _d("Previous quoted value is complete:", $vals[-1]); + PTDEBUG && _d("Previous quoted value is complete:", $vals[-1]); $quote_char = ''; } @@ -4670,10 +4670,10 @@ sub _parse_csv { $val =~ s/^\s+//; if ( $val =~ m/^(['"])/ ) { - MKDEBUG && _d("Value is quoted"); + PTDEBUG && _d("Value is quoted"); $quote_char = $1; # XXX if ( $val =~ m/.$quote_char$/ ) { - MKDEBUG && _d("Value is complete"); + PTDEBUG && _d("Value is complete"); $quote_char = ''; if ( $args{remove_quotes} ) { $vals[-1] =~ s/^\s*$quote_char//; @@ -4681,14 +4681,14 @@ sub _parse_csv { } } else { - MKDEBUG && _d("Quoted value is not complete"); + PTDEBUG && _d("Quoted value is not complete"); } } else { $val =~ s/\s+$//; } - MKDEBUG && _d("Saving value", ($quote_char ? "fragment" : "")); + PTDEBUG && _d("Saving value", ($quote_char ? "fragment" : "")); push @vals, $val; } } @@ -4705,7 +4705,7 @@ sub _parse_csv { sub parse_columns { my ( $self, $cols ) = @_; - MKDEBUG && _d('Parsing columns list:', $cols); + PTDEBUG && _d('Parsing columns list:', $cols); my @cols; pos $cols = 0; @@ -4755,31 +4755,31 @@ sub remove_subqueries { my $len_adj = 0; my $n = 0; for my $i ( 0..$#start_pos ) { - MKDEBUG && _d('Query:', $query); + PTDEBUG && _d('Query:', $query); my $offset = $start_pos[$i]; my $len = $end_pos[$i] - $start_pos[$i] - $len_adj; - MKDEBUG && _d("Subquery $n start", $start_pos[$i], + PTDEBUG && _d("Subquery $n start", $start_pos[$i], 'orig end', $end_pos[$i], 'adj', $len_adj, 'adj end', $offset + $len, 'len', $len); my $struct = {}; my $token = '__SQ' . $n . '__'; my $subquery = substr($query, $offset, $len, $token); - MKDEBUG && _d("Subquery $n:", $subquery); + PTDEBUG && _d("Subquery $n:", $subquery); my $outer_start = $start_pos[$i + 1]; my $outer_end = $end_pos[$i + 1]; if ( $outer_start && ($outer_start < $start_pos[$i]) && $outer_end && ($outer_end > $end_pos[$i]) ) { - MKDEBUG && _d("Subquery $n nested in next subquery"); + PTDEBUG && _d("Subquery $n nested in next subquery"); $len_adj += $len - length $token; $struct->{nested} = $i + 1; } else { - MKDEBUG && _d("Subquery $n not nested"); + PTDEBUG && _d("Subquery $n not nested"); $len_adj = 0; if ( $subqueries[-1] && $subqueries[-1]->{nested} ) { - MKDEBUG && _d("Outermost subquery"); + PTDEBUG && _d("Outermost subquery"); } } @@ -4796,7 +4796,7 @@ sub remove_subqueries { else { $struct->{context} = 'identifier'; } - MKDEBUG && _d("Subquery $n context:", $struct->{context}); + PTDEBUG && _d("Subquery $n context:", $struct->{context}); $subquery =~ s/^\s*\(//; $subquery =~ s/\s*\)\s*$//; @@ -4812,11 +4812,11 @@ sub remove_subqueries { sub parse_identifiers { my ( $self, $idents ) = @_; return unless $idents; - MKDEBUG && _d("Parsing identifiers"); + PTDEBUG && _d("Parsing identifiers"); my @ident_parts; foreach my $ident ( @$idents ) { - MKDEBUG && _d("Identifier:", $ident); + PTDEBUG && _d("Identifier:", $ident); my $parts = {}; if ( $ident =~ s/\s+(ASC|DESC)\s*$//i ) { @@ -4824,17 +4824,17 @@ sub parse_identifiers { } if ( $ident =~ m/^\d+$/ ) { # Position like 5 - MKDEBUG && _d("Positional ident"); + PTDEBUG && _d("Positional ident"); $parts->{position} = $ident; } elsif ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col) - MKDEBUG && _d("Expression ident"); + PTDEBUG && _d("Expression ident"); my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/; $parts->{function} = uc $func; $parts->{expression} = $expr if $expr; } else { # Ref like (table.)column - MKDEBUG && _d("Table/column ident"); + PTDEBUG && _d("Table/column ident"); my ($tbl, $col) = $self->split_unquote($ident); $parts->{table} = $tbl if $tbl; $parts->{column} = $col; @@ -4848,7 +4848,7 @@ sub parse_identifiers { sub parse_identifier { my ( $self, $type, $ident ) = @_; return unless $type && $ident; - MKDEBUG && _d("Parsing", $type, "identifier:", $ident); + PTDEBUG && _d("Parsing", $type, "identifier:", $ident); my %ident_struct; my @ident_parts = map { s/`//g; $_; } split /[.]/, $ident; @@ -4884,7 +4884,7 @@ sub parse_identifier { } } - MKDEBUG && _d($type, "identifier struct:", Dumper(\%ident_struct)); + PTDEBUG && _d($type, "identifier struct:", Dumper(\%ident_struct)); return \%ident_struct; } @@ -4952,7 +4952,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -5046,11 +5046,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -5062,12 +5062,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -5077,15 +5077,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -5095,11 +5095,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -5120,7 +5120,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -5132,11 +5132,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -5149,7 +5149,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -5168,7 +5168,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -5186,7 +5186,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -5212,7 +5212,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -5257,7 +5257,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -5302,7 +5302,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -5363,7 +5363,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -5381,7 +5381,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -5390,25 +5390,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -5422,66 +5422,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -5497,7 +5497,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -5523,7 +5523,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -5545,7 +5545,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -5613,7 +5613,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -5623,7 +5623,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -5658,7 +5658,7 @@ package ReportFormatter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use POSIX qw(ceil); @@ -5691,7 +5691,7 @@ sub new { . "is not installed" unless $have_term; ($self->{line_width}) = GetTerminalSize(); } - MKDEBUG && _d('Line width:', $self->{line_width}); + PTDEBUG && _d('Line width:', $self->{line_width}); return bless $self, $class; } @@ -5716,7 +5716,7 @@ sub set_columns { if ( $col->{width} ) { $col->{width_pct} = ceil(($col->{width} * 100) / $self->{line_width}); - MKDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', + PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', $col->{width_pct}, '%'); } @@ -5724,7 +5724,7 @@ sub set_columns { $used_width += $col->{width_pct}; } else { - MKDEBUG && _d('Auto width col:', $col_name); + PTDEBUG && _d('Auto width col:', $col_name); $col->{auto_width} = 1; push @auto_width_cols, $i; } @@ -5753,15 +5753,15 @@ sub set_columns { if ( @auto_width_cols ) { my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols); - MKDEBUG && _d('Line width left:', (100-$used_width), '%;', + PTDEBUG && _d('Line width left:', (100-$used_width), '%;', 'each auto width col:', $wid_per_col, '%'); map { $self->{cols}->[$_]->{width_pct} = $wid_per_col } @auto_width_cols; } $min_hdr_wid += ($self->{n_cols} - 1) * length $self->{column_spacing}; - MKDEBUG && _d('min header width:', $min_hdr_wid); + PTDEBUG && _d('min header width:', $min_hdr_wid); if ( $min_hdr_wid > $self->{line_width} ) { - MKDEBUG && _d('Will truncate headers because min header width', + PTDEBUG && _d('Will truncate headers because min header width', $min_hdr_wid, '> line width', $self->{line_width}); $self->{truncate_headers} = 1; } @@ -5802,7 +5802,7 @@ sub get_report { my @col_fmts = $self->_make_column_formats(); my $fmt = ($self->{line_prefix} || '') . join($self->{column_spacing}, @col_fmts); - MKDEBUG && _d('Format:', $fmt); + PTDEBUG && _d('Format:', $fmt); (my $hdr_fmt = $fmt) =~ s/%([^-])/%-$1/g; @@ -5854,7 +5854,7 @@ sub truncate_value { $val = $mark . substr($val, -1 * $width + length $mark); } else { - MKDEBUG && _d("I don't know how to", $side, "truncate values"); + PTDEBUG && _d("I don't know how to", $side, "truncate values"); } return $val; } @@ -5866,27 +5866,27 @@ sub _calculate_column_widths { foreach my $col ( @{$self->{cols}} ) { my $print_width = int($self->{line_width} * ($col->{width_pct} / 100)); - MKDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, + PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, 'char width:', $print_width, 'min val:', $col->{min_val}, 'max val:', $col->{max_val}); if ( $col->{auto_width} ) { if ( $col->{min_val} && $print_width < $col->{min_val} ) { - MKDEBUG && _d('Increased to min val width:', $col->{min_val}); + PTDEBUG && _d('Increased to min val width:', $col->{min_val}); $print_width = $col->{min_val}; } elsif ( $col->{max_val} && $print_width > $col->{max_val} ) { - MKDEBUG && _d('Reduced to max val width:', $col->{max_val}); + PTDEBUG && _d('Reduced to max val width:', $col->{max_val}); $extra_space += $print_width - $col->{max_val}; $print_width = $col->{max_val}; } } $col->{print_width} = $print_width; - MKDEBUG && _d('print width:', $col->{print_width}); + PTDEBUG && _d('print width:', $col->{print_width}); } - MKDEBUG && _d('Extra space:', $extra_space); + PTDEBUG && _d('Extra space:', $extra_space); while ( $extra_space-- ) { foreach my $col ( @{$self->{cols}} ) { if ( $col->{auto_width} @@ -5909,7 +5909,7 @@ sub _truncate_headers { my $print_width = $col->{print_width}; next if length $col_name <= $print_width; $col->{name} = $self->truncate_value($col, $col_name, $print_width, $side); - MKDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, + PTDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, 'max width:', $print_width); } return; @@ -5934,7 +5934,7 @@ sub _truncate_line_values { my $print_width = $col->{print_width}; $val = $callback ? $callback->($col, $val, $print_width) : $self->truncate_value($col, $val, $print_width); - MKDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, + PTDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, '; max width:', $print_width); $vals->[$i] = $val; } @@ -6014,7 +6014,7 @@ $Data::Dumper::Quotekeys = 0; Transformers->import(qw(make_checksum)); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # Some rules report their match pos. This sets how many # characters before and after that pos are shown to give @@ -6126,7 +6126,7 @@ sub main { # like JOI.004 may not be able to work in some cases. Maybe we can add # a rule attrib like "uses cxn: yes" to determine if need a cxn? if ( $EVAL_ERROR ) { - MKDEBUG && _d("Cannot connect to MySQL:", $EVAL_ERROR); + PTDEBUG && _d("Cannot connect to MySQL:", $EVAL_ERROR); } # ######################################################################### @@ -6137,7 +6137,7 @@ sub main { if ( my $query = $o->get('query') ) { push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: query:', $query); + PTDEBUG && _d('callback: query:', $query); $args{oktorun}->(0) if $args{oktorun}; return { cmd => 'Query', @@ -6151,12 +6151,12 @@ sub main { my $sql = "SELECT sample FROM " . $q->quote($review_dsn->{D}, $review_dsn->{t}) . ($where ? " WHERE $where" : ""); - MKDEBUG && _d($review_dbh, $sql); + PTDEBUG && _d($review_dbh, $sql); my $queries = $review_dbh->selectall_arrayref($sql); push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: review'); + PTDEBUG && _d('callback: review'); my $query = shift @$queries; if ( !$query ) { $args{oktorun}->(0) if $args{oktorun}; @@ -6189,7 +6189,7 @@ sub main { my ( %args ) = @_; return $parser->parse_event(%args); }; - MKDEBUG && _d('Added', $module, 'module to callbacks'); + PTDEBUG && _d('Added', $module, 'module to callbacks'); } } @@ -6197,14 +6197,14 @@ sub main { # rules, expect the event to have an arg. push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: check cmd and arg'); + PTDEBUG && _d('callback: check cmd and arg'); my $event = $args{event}; if ( ($event->{cmd} || '') ne 'Query' ) { - MKDEBUG && _d('Skipping non-Query cmd'); + PTDEBUG && _d('Skipping non-Query cmd'); return; } if ( !$event->{arg} ) { - MKDEBUG && _d('Skipping empty arg'); + PTDEBUG && _d('Skipping empty arg'); return; } return $event; @@ -6215,11 +6215,11 @@ sub main { my $num_samples = $o->get('sample'); push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: fingerprint/sample'); + PTDEBUG && _d('callback: fingerprint/sample'); my $event = $args{event}; $event->{fingerprint} = $qr->fingerprint($event->{arg}); if ( ++$seen_fingerprint{ $event->{fingerprint} } > $num_samples ) { - MKDEBUG && _d("Event skipped because of --sample"); + PTDEBUG && _d("Event skipped because of --sample"); return; } $event->{query_id} = make_checksum($event->{fingerprint}); @@ -6231,18 +6231,18 @@ sub main { # continue because some rules may not need the query struct. push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: parse query'); + PTDEBUG && _d('callback: parse query'); my $event = $args{event}; my $query_struct; eval { $query_struct = $sp->parse($event->{arg}); if ( !$query_struct ) { - MKDEBUG && _d('Failed to parse query struct, no error'); + PTDEBUG && _d('Failed to parse query struct, no error'); } $event->{query_struct} = $query_struct; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Failed to parse query struct:', $EVAL_ERROR); + PTDEBUG && _d('Failed to parse query struct:', $EVAL_ERROR); } return $event; }; @@ -6256,18 +6256,18 @@ sub main { my $tbl_structs = {}; push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: show create table'); + PTDEBUG && _d('callback: show create table'); my $event = $args{event}; my $query_struct = $event->{query_struct}; if ( !$query_struct ) { - MKDEBUG && _d("No query struct"); + PTDEBUG && _d("No query struct"); return $event; } my $tbls = $query_struct->{from} || $query_struct->{into} || $query_struct->{tables}; if ( !$tbls || !@$tbls ) { - MKDEBUG && _d("Query has no tables"); + PTDEBUG && _d("Query has no tables"); return $event; } @@ -6275,7 +6275,7 @@ sub main { my $tbl = $tbl_info->{tbl}; my $db = $tbl_info->{db} || $event->{db} || $default_db; if ( !$db ) { - MKDEBUG && _d("No database for table", $tbl); + PTDEBUG && _d("No database for table", $tbl); next; } @@ -6303,9 +6303,9 @@ sub main { # Run rules on query, get a list of rules that match (advice). push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: check query'); + PTDEBUG && _d('callback: check query'); my $event = $args{event}; - MKDEBUG && _d('Checking', $event->{arg}); + PTDEBUG && _d('Checking', $event->{arg}); my ($advice, $near_pos) = $adv->run_rules(event => $event); $event->{advice} = $advice; $event->{near_pos} = $near_pos; @@ -6316,7 +6316,7 @@ sub main { if ( $groupby eq 'none' ) { push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: print advice'); + PTDEBUG && _d('callback: print advice'); my $event = $args{event}; my $advice = $event->{advice}; return $event unless @$advice || $o->get('print-all'); @@ -6335,7 +6335,7 @@ sub main { else { push @pipeline, sub { my ( %args ) = @_; - MKDEBUG && _d('callback: queue advice for group-by', $groupby); + PTDEBUG && _d('callback: queue advice for group-by', $groupby); my $event = $args{event}; my $advice = $event->{advice}; return $event unless @$advice || $o->get('print-all'); @@ -6372,7 +6372,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -6388,12 +6388,12 @@ sub main { if ( !$fh ) { my $file = shift @ARGV; if ( !$file ) { - MKDEBUG && _d('No more files to parse'); + PTDEBUG && _d('No more files to parse'); last EVENT; } if ( $file eq '-' ) { $fh = *STDIN; - MKDEBUG && _d('Reading STDIN'); + PTDEBUG && _d('Reading STDIN'); } else { if ( !open $fh, "<", $file ) { @@ -6401,7 +6401,7 @@ sub main { warn "Cannot open $file: $OS_ERROR\n"; next EVENT; } - MKDEBUG && _d('Reading', $file); + PTDEBUG && _d('Reading', $file); } $next_event = sub { return <$fh>; }; $tell = sub { return tell $fh; }; @@ -6427,7 +6427,7 @@ sub main { last EVENT unless $o->get('continue-on-error'); } if ( !$more_events ) { - MKDEBUG && _d('No more events'); + PTDEBUG && _d('No more events'); close $fh if $fh and $fh ne *STDIN; $fh = undef; } @@ -6619,7 +6619,7 @@ sub get_cxn { my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), $args{opts}); $dbh->{FetchHashKeyName} = 'NAME_lc'; - MKDEBUG && _d('Connected dbh', $dbh); + PTDEBUG && _d('Connected dbh', $dbh); return $dbh; } diff --git a/bin/pt-query-digest b/bin/pt-query-digest index 21dec40e..affca886 100755 --- a/bin/pt-query-digest +++ b/bin/pt-query-digest @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -184,7 +184,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -229,7 +229,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -239,21 +239,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -265,15 +265,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -291,7 +291,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -317,7 +317,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -378,7 +378,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -455,7 +455,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -539,7 +539,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -583,7 +583,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -620,7 +620,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -629,7 +629,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -648,7 +648,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -656,7 +656,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -694,7 +694,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -707,7 +707,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -733,14 +733,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -749,13 +749,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -763,17 +763,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -787,7 +787,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -797,7 +797,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -811,7 +811,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -834,7 +834,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -863,7 +863,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -894,7 +894,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -961,7 +961,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1010,7 +1010,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1034,12 +1034,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1048,23 +1048,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1073,7 +1073,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1083,7 +1083,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1157,11 +1157,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1376,7 +1376,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1386,7 +1386,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1410,7 +1410,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1423,7 +1423,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1450,7 +1450,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1480,7 +1480,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1660,36 +1660,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1736,7 +1736,7 @@ package QueryRewriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; @@ -1885,7 +1885,7 @@ sub distill_verbs { $query = $self->strip_comments($query); if ( $query =~ m/\A\s*SHOW\s+/i ) { - MKDEBUG && _d($query); + PTDEBUG && _d($query); $query = uc $query; $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; @@ -1895,7 +1895,7 @@ sub distill_verbs { $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; $query =~ s/\s+/ /g; - MKDEBUG && _d($query); + PTDEBUG && _d($query); return $query; } @@ -1905,10 +1905,10 @@ sub distill_verbs { if ( $dds) { my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; $obj = uc $obj if $obj; - MKDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); + PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); my ($db_or_tbl) = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches db or table:', $db_or_tbl); + PTDEBUG && _d('Matches db or table:', $db_or_tbl); return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; } @@ -1919,7 +1919,7 @@ sub distill_verbs { }; if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - MKDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); + PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); my $union = grep { $_ eq 'UNION' } @verbs; @verbs = $union ? qw(SELECT UNION) : qw(SELECT); } @@ -2046,12 +2046,12 @@ sub __delete_to_select { sub __insert_to_select { my ( $tbl, $cols, $vals ) = @_; - MKDEBUG && _d('Args:', @_); + PTDEBUG && _d('Args:', @_); my @cols = split(/,/, $cols); - MKDEBUG && _d('Cols:', @cols); + PTDEBUG && _d('Cols:', @cols); $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - MKDEBUG && _d('Vals:', @vals); + PTDEBUG && _d('Vals:', @vals); if ( @cols == @vals ) { return "select * from $tbl where " . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); @@ -2117,7 +2117,7 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant { ID => 0, USER => 1, @@ -2158,16 +2158,16 @@ sub parse_event { my ($code) = @args{@required_args}; if ( @{$self->{event_cache}} ) { - MKDEBUG && _d("Returning cached event"); + PTDEBUG && _d("Returning cached event"); return shift @{$self->{event_cache}}; } if ( $self->{interval} && $self->{polls} ) { - MKDEBUG && _d("Sleeping between polls"); + PTDEBUG && _d("Sleeping between polls"); usleep($self->{interval}); } - MKDEBUG && _d("Polling PROCESSLIST"); + PTDEBUG && _d("Polling PROCESSLIST"); my ($time, $etime) = @args{qw(time etime)}; my $start = $etime ? 0 : time; # don't need start if etime given my $rows = $code->(); @@ -2178,7 +2178,7 @@ sub parse_event { $time = time unless $time; $etime = $time - $start unless $etime; $self->{polls}++; - MKDEBUG && _d('Rows:', ($rows ? scalar @$rows : 0), 'in', $etime, 'seconds'); + PTDEBUG && _d('Rows:', ($rows ? scalar @$rows : 0), 'in', $etime, 'seconds'); my $active_cxn = $self->{active_cxn}; my $curr_cxn = {}; @@ -2192,23 +2192,23 @@ sub parse_event { my $query_start = $time - ($curr->[TIME] || 0); if ( $active_cxn->{$curr->[ID]} ) { - MKDEBUG && _d('Checking existing cxn', $curr->[ID]); + PTDEBUG && _d('Checking existing cxn', $curr->[ID]); my $prev = $active_cxn->{$curr->[ID]}; # previous state of cxn my $new_query = 0; my $fudge = ($curr->[TIME] || 0) =~ m/\D/ ? 0.001 : 1; # micro-t? if ( $prev->[INFO] ) { if ( !$curr->[INFO] || $prev->[INFO] ne $curr->[INFO] ) { - MKDEBUG && _d('Info is different; new query'); + PTDEBUG && _d('Info is different; new query'); $new_query = 1; } elsif ( defined $curr->[TIME] && $curr->[TIME] < $prev->[TIME] ) { - MKDEBUG && _d('Time is less than previous; new query'); + PTDEBUG && _d('Time is less than previous; new query'); $new_query = 1; } elsif ( $curr->[INFO] && defined $curr->[TIME] && $query_start - $etime - $prev->[START] > $fudge ) { - MKDEBUG && _d('Query restarted; new query', + PTDEBUG && _d('Query restarted; new query', $query_start, $etime, $prev->[START], $fudge); $new_query = 1; } @@ -2222,11 +2222,11 @@ sub parse_event { if ( $curr->[INFO] ) { if ( $prev->[INFO] && !$new_query ) { - MKDEBUG && _d("Query on cxn", $curr->[ID], "hasn't changed"); + PTDEBUG && _d("Query on cxn", $curr->[ID], "hasn't changed"); $self->_update_profile($prev, $curr, $time); } else { - MKDEBUG && _d('Saving new query, state', $curr->[STATE]); + PTDEBUG && _d('Saving new query, state', $curr->[STATE]); push @new_cxn, [ @$curr, # proc info int($query_start), # START @@ -2238,9 +2238,9 @@ sub parse_event { } } else { - MKDEBUG && _d('New cxn', $curr->[ID]); + PTDEBUG && _d('New cxn', $curr->[ID]); if ( $curr->[INFO] && defined $curr->[TIME] ) { - MKDEBUG && _d('Saving query of new cxn, state', $curr->[STATE]); + PTDEBUG && _d('Saving query of new cxn, state', $curr->[STATE]); push @new_cxn, [ @$curr, # proc info int($query_start), # START @@ -2255,7 +2255,7 @@ sub parse_event { PREVIOUSLY_ACTIVE_CXN: foreach my $prev ( values %$active_cxn ) { if ( !$curr_cxn->{$prev->[ID]} ) { - MKDEBUG && _d('cxn', $prev->[ID], 'ended'); + PTDEBUG && _d('cxn', $prev->[ID], 'ended'); push @{$self->{event_cache}}, $self->make_event($prev, $time); delete $active_cxn->{$prev->[ID]}; @@ -2263,7 +2263,7 @@ sub parse_event { elsif ( ($curr_cxn->{$prev->[ID]}->[COMMAND] || "") eq 'Sleep' || !$curr_cxn->{$prev->[ID]}->[STATE] || !$curr_cxn->{$prev->[ID]}->[INFO] ) { - MKDEBUG && _d('cxn', $prev->[ID], 'became idle'); + PTDEBUG && _d('cxn', $prev->[ID], 'became idle'); delete $active_cxn->{$prev->[ID]}; } } @@ -2273,7 +2273,7 @@ sub parse_event { $self->{last_poll} = $time; my $event = shift @{$self->{event_cache}}; - MKDEBUG && _d(scalar @{$self->{event_cache}}, "events in cache"); + PTDEBUG && _d(scalar @{$self->{event_cache}}, "events in cache"); return $event; } @@ -2297,13 +2297,13 @@ sub make_event { Query_time => $Query_time, Lock_time => $row->[PROFILE]->{Locked} || 0, }; - MKDEBUG && _d('Properties of event:', Dumper($event)); + PTDEBUG && _d('Properties of event:', Dumper($event)); return $event; } sub _get_active_cxn { my ( $self ) = @_; - MKDEBUG && _d("Active cxn:", Dumper($self->{active_cxn})); + PTDEBUG && _d("Active cxn:", Dumper($self->{active_cxn})); return $self->{active_cxn}; } @@ -2315,11 +2315,11 @@ sub _update_profile { if ( ($prev->[STATE] || "") eq ($curr->[STATE] || "") ) { - MKDEBUG && _d("Query is still in", $curr->[STATE], "state"); + PTDEBUG && _d("Query is still in", $curr->[STATE], "state"); $prev->[PROFILE]->{$prev->[STATE] || ""} += $time_elapsed; } else { - MKDEBUG && _d("Query changed from state", $prev->[STATE], + PTDEBUG && _d("Query changed from state", $prev->[STATE], "to", $curr->[STATE]); my $half_time = ($time_elapsed || 0) / 2; @@ -2334,36 +2334,36 @@ sub _update_profile { sub find { my ( $self, $proclist, %find_spec ) = @_; - MKDEBUG && _d('find specs:', Dumper(\%find_spec)); + PTDEBUG && _d('find specs:', Dumper(\%find_spec)); my $ms = $self->{MasterSlave}; my @matches; QUERY: foreach my $query ( @$proclist ) { - MKDEBUG && _d('Checking query', Dumper($query)); + PTDEBUG && _d('Checking query', Dumper($query)); my $matched = 0; if ( !$find_spec{replication_threads} && $ms->is_replication_thread($query) ) { - MKDEBUG && _d('Skipping replication thread'); + PTDEBUG && _d('Skipping replication thread'); next QUERY; } if ( $find_spec{busy_time} && ($query->{Command} || '') eq 'Query' ) { if ( $query->{Time} < $find_spec{busy_time} ) { - MKDEBUG && _d("Query isn't running long enough"); + PTDEBUG && _d("Query isn't running long enough"); next QUERY; } - MKDEBUG && _d('Exceeds busy time'); + PTDEBUG && _d('Exceeds busy time'); $matched++; } if ( $find_spec{idle_time} && ($query->{Command} || '') eq 'Sleep' ) { if ( $query->{Time} < $find_spec{idle_time} ) { - MKDEBUG && _d("Query isn't idle long enough"); + PTDEBUG && _d("Query isn't idle long enough"); next QUERY; } - MKDEBUG && _d('Exceeds idle time'); + PTDEBUG && _d('Exceeds idle time'); $matched++; } @@ -2372,24 +2372,24 @@ sub find { my $filter = "_find_match_$property"; if ( defined $find_spec{ignore}->{$property} && $self->$filter($query, $find_spec{ignore}->{$property}) ) { - MKDEBUG && _d('Query matches ignore', $property, 'spec'); + PTDEBUG && _d('Query matches ignore', $property, 'spec'); next QUERY; } if ( defined $find_spec{match}->{$property} ) { if ( !$self->$filter($query, $find_spec{match}->{$property}) ) { - MKDEBUG && _d('Query does not match', $property, 'spec'); + PTDEBUG && _d('Query does not match', $property, 'spec'); next QUERY; } - MKDEBUG && _d('Query matches', $property, 'spec'); + PTDEBUG && _d('Query matches', $property, 'spec'); $matched++; } } if ( $matched || $find_spec{all} ) { - MKDEBUG && _d("Query matched one or more specs, adding"); + PTDEBUG && _d("Query matched one or more specs, adding"); push @matches, $query; next QUERY; } - MKDEBUG && _d('Query does not match any specs, ignoring'); + PTDEBUG && _d('Query does not match any specs, ignoring'); } # QUERY return @matches; @@ -2464,7 +2464,7 @@ package TcpdumpParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2556,7 +2556,7 @@ sub _parse_packet { data => $data ? substr($data, 0, 10).(length $data > 10 ? '...' : '') : '', }; - MKDEBUG && _d('packet:', Dumper($pkt)); + PTDEBUG && _d('packet:', Dumper($pkt)); $pkt->{data} = $data; return $pkt; } @@ -2598,7 +2598,7 @@ package MySQLProtocolParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; eval { require IO::Uncompress::Inflate; @@ -2794,7 +2794,7 @@ sub new { o => $args{o}, fake_thread_id => 2**32, # see _make_event() }; - MKDEBUG && $self->{server} && _d('Watching only server', $self->{server}); + PTDEBUG && $self->{server} && _d('Watching only server', $self->{server}); return bless $self, $class; } @@ -2812,7 +2812,7 @@ sub parse_event { if ( my $server = $self->{server} ) { # Watch only the given server. $server .= ":$self->{port}"; if ( $src_host ne $server && $dst_host ne $server ) { - MKDEBUG && _d('Packet is not to or from', $server); + PTDEBUG && _d('Packet is not to or from', $server); return; } } @@ -2828,10 +2828,10 @@ sub parse_event { $client = $src_host; } else { - MKDEBUG && _d('Packet is not to or from a MySQL server'); + PTDEBUG && _d('Packet is not to or from a MySQL server'); return; } - MKDEBUG && _d('Client', $client); + PTDEBUG && _d('Client', $client); my $packetno = -1; if ( $packet->{data_len} >= 5 ) { @@ -2839,13 +2839,13 @@ sub parse_event { } if ( !exists $self->{sessions}->{$client} ) { if ( $packet->{syn} ) { - MKDEBUG && _d('New session (SYN)'); + PTDEBUG && _d('New session (SYN)'); } elsif ( $packetno == 0 ) { - MKDEBUG && _d('New session (packetno 0)'); + PTDEBUG && _d('New session (packetno 0)'); } else { - MKDEBUG && _d('Ignoring mid-stream', $packet_from, 'data,', + PTDEBUG && _d('Ignoring mid-stream', $packet_from, 'data,', 'packetno', $packetno); return; } @@ -2863,19 +2863,19 @@ sub parse_event { }; } my $session = $self->{sessions}->{$client}; - MKDEBUG && _d('Client state:', $session->{state}); + PTDEBUG && _d('Client state:', $session->{state}); push @{$session->{raw_packets}}, $packet->{raw_packet}; if ( $packet->{syn} && ($session->{n_queries} > 0 || $session->{state}) ) { - MKDEBUG && _d('Client port reuse and last session did not quit'); + PTDEBUG && _d('Client port reuse and last session did not quit'); $self->fail_session($session, 'client port reuse and last session did not quit'); return $self->parse_event(%args); } if ( $packet->{data_len} == 0 ) { - MKDEBUG && _d('TCP control:', + PTDEBUG && _d('TCP control:', map { uc $_ } grep { $packet->{$_} } qw(syn ack fin rst)); return; } @@ -2892,7 +2892,7 @@ sub parse_event { $packet->{mysql_data_len} = $session->{mysql_data_len}; $packet->{number} = $session->{number}; - MKDEBUG && _d('Appending data to buff; expecting', + PTDEBUG && _d('Appending data to buff; expecting', $session->{buff_left}, 'more bytes'); } else { @@ -2900,7 +2900,7 @@ sub parse_event { remove_mysql_header($packet); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('remove_mysql_header() failed; failing session'); + PTDEBUG && _d('remove_mysql_header() failed; failing session'); $session->{EVAL_ERROR} = $EVAL_ERROR; $self->fail_session($session, 'remove_mysql_header() failed'); return; @@ -2914,7 +2914,7 @@ sub parse_event { elsif ( $packet_from eq 'client' ) { if ( $session->{buff} ) { if ( $session->{buff_left} <= 0 ) { - MKDEBUG && _d('Data is complete'); + PTDEBUG && _d('Data is complete'); $self->_delete_buff($session); } else { @@ -2924,7 +2924,7 @@ sub parse_event { elsif ( $packet->{mysql_data_len} > ($packet->{data_len} - 4) ) { if ( $session->{cmd} && ($session->{state} || '') eq 'awaiting_reply' ) { - MKDEBUG && _d('No server OK to previous command (frag)'); + PTDEBUG && _d('No server OK to previous command (frag)'); $self->fail_session($session, 'no server OK to previous command'); $packet->{data} = $packet->{mysql_hdr} . $packet->{data}; return $self->parse_event(%args); @@ -2937,13 +2937,13 @@ sub parse_event { $session->{buff_left} ||= $packet->{mysql_data_len} - ($packet->{data_len} - 4); - MKDEBUG && _d('Data not complete; expecting', + PTDEBUG && _d('Data not complete; expecting', $session->{buff_left}, 'more bytes'); return; } if ( $session->{cmd} && ($session->{state} || '') eq 'awaiting_reply' ) { - MKDEBUG && _d('No server OK to previous command'); + PTDEBUG && _d('No server OK to previous command'); $self->fail_session($session, 'no server OK to previous command'); $packet->{data} = $packet->{mysql_hdr} . $packet->{data}; return $self->parse_event(%args); @@ -2955,10 +2955,10 @@ sub parse_event { die 'Packet origin unknown'; } - MKDEBUG && _d('Done parsing packet; client state:', $session->{state}); + PTDEBUG && _d('Done parsing packet; client state:', $session->{state}); if ( $session->{closed} ) { delete $self->{sessions}->{$session->{client}}; - MKDEBUG && _d('Session deleted'); + PTDEBUG && _d('Session deleted'); } $args{stats}->{events_parsed}++ if $args{stats}; @@ -2970,11 +2970,11 @@ sub _packet_from_server { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from server; client state:', $session->{state}); + PTDEBUG && _d('Packet is from server; client state:', $session->{state}); if ( ($session->{server_seq} || '') eq $packet->{seq} ) { push @{ $session->{server_retransmissions} }, $packet->{seq}; - MKDEBUG && _d('TCP retransmission'); + PTDEBUG && _d('TCP retransmission'); return; } $session->{server_seq} = $packet->{seq}; @@ -2983,7 +2983,7 @@ sub _packet_from_server { my ( $first_byte ) = substr($data, 0, 2, ''); - MKDEBUG && _d('First byte of packet:', $first_byte); + PTDEBUG && _d('First byte of packet:', $first_byte); if ( !$first_byte ) { $self->fail_session($session, 'no first byte'); return; @@ -3007,7 +3007,7 @@ sub _packet_from_server { return; } else { - MKDEBUG && _d('Ignoring mid-stream server response'); + PTDEBUG && _d('Ignoring mid-stream server response'); return; } } @@ -3017,9 +3017,9 @@ sub _packet_from_server { $session->{compress} = $session->{will_compress}; delete $session->{will_compress}; - MKDEBUG && $session->{compress} && _d('Packets will be compressed'); + PTDEBUG && $session->{compress} && _d('Packets will be compressed'); - MKDEBUG && _d('Admin command: Connect'); + PTDEBUG && _d('Admin command: Connect'); return $self->_make_event( { cmd => 'Admin', arg => 'administrator command: Connect', @@ -3032,7 +3032,7 @@ sub _packet_from_server { my $com = $session->{cmd}->{cmd}; my $ok; if ( $com eq COM_STMT_PREPARE ) { - MKDEBUG && _d('OK for prepared statement'); + PTDEBUG && _d('OK for prepared statement'); $ok = parse_ok_prepared_statement_packet($data); if ( !$ok ) { $self->fail_session($session, @@ -3082,7 +3082,7 @@ sub _packet_from_server { ); } else { - MKDEBUG && _d('Looks like an OK packet but session has no cmd'); + PTDEBUG && _d('Looks like an OK packet but session has no cmd'); } } elsif ( $first_byte eq 'ff' ) { @@ -3094,7 +3094,7 @@ sub _packet_from_server { my $event; if ( $session->{state} eq 'client_auth' ) { - MKDEBUG && _d('Connection failed'); + PTDEBUG && _d('Connection failed'); $event = { cmd => 'Admin', arg => 'administrator command: Connect', @@ -3129,7 +3129,7 @@ sub _packet_from_server { return $self->_make_event($event, $packet, $session); } else { - MKDEBUG && _d('Looks like an error packet but client is not ' + PTDEBUG && _d('Looks like an error packet but client is not ' . 'authenticating and session has no cmd'); } } @@ -3138,20 +3138,20 @@ sub _packet_from_server { && $session->{state} eq 'client_auth' && $packet->{number} == 2 ) { - MKDEBUG && _d('Server has old password table;', + PTDEBUG && _d('Server has old password table;', 'client will resend password using old algorithm'); $session->{state} = 'client_auth_resend'; } else { - MKDEBUG && _d('Got an EOF packet'); + PTDEBUG && _d('Got an EOF packet'); $self->fail_session($session, 'got an unexpected EOF packet'); } } else { if ( $session->{cmd} ) { - MKDEBUG && _d('Got a row/field/result packet'); + PTDEBUG && _d('Got a row/field/result packet'); my $com = $session->{cmd}->{cmd}; - MKDEBUG && _d('Responding to client', $com_for{$com}); + PTDEBUG && _d('Responding to client', $com_for{$com}); my $event = { ts => $packet->{ts} }; if ( $com eq COM_QUERY || $com eq COM_STMT_EXECUTE ) { $event->{cmd} = 'Query'; @@ -3179,7 +3179,7 @@ sub _packet_from_server { return $self->_make_event($event, $packet, $session); } else { - MKDEBUG && _d('Unknown in-stream server response'); + PTDEBUG && _d('Unknown in-stream server response'); } } } @@ -3192,11 +3192,11 @@ sub _packet_from_client { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from client; state:', $session->{state}); + PTDEBUG && _d('Packet is from client; state:', $session->{state}); if ( ($session->{client_seq} || '') eq $packet->{seq} ) { push @{ $session->{client_retransmissions} }, $packet->{seq}; - MKDEBUG && _d('TCP retransmission'); + PTDEBUG && _d('TCP retransmission'); return; } $session->{client_seq} = $packet->{seq}; @@ -3205,7 +3205,7 @@ sub _packet_from_client { my $ts = $packet->{ts}; if ( ($session->{state} || '') eq 'server_handshake' ) { - MKDEBUG && _d('Expecting client authentication packet'); + PTDEBUG && _d('Expecting client authentication packet'); my $handshake = parse_client_handshake_packet($data); if ( !$handshake ) { $self->fail_session($session, 'failed to parse client handshake'); @@ -3219,13 +3219,13 @@ sub _packet_from_client { $session->{will_compress} = $handshake->{flags}->{CLIENT_COMPRESS}; } elsif ( ($session->{state} || '') eq 'client_auth_resend' ) { - MKDEBUG && _d('Client resending password using old algorithm'); + PTDEBUG && _d('Client resending password using old algorithm'); $session->{state} = 'client_auth'; } elsif ( ($session->{state} || '') eq 'awaiting_reply' ) { my $arg = $session->{cmd}->{arg} ? substr($session->{cmd}->{arg}, 0, 50) : 'unknown'; - MKDEBUG && _d('More data for previous command:', $arg, '...'); + PTDEBUG && _d('More data for previous command:', $arg, '...'); return; } else { @@ -3246,10 +3246,10 @@ sub _packet_from_client { } if ( $com->{code} eq COM_STMT_EXECUTE ) { - MKDEBUG && _d('Execute prepared statement'); + PTDEBUG && _d('Execute prepared statement'); my $exec = parse_execute_packet($com->{data}, $session->{sths}); if ( !$exec ) { - MKDEBUG && _d('Failed to parse execute packet'); + PTDEBUG && _d('Failed to parse execute packet'); $session->{state} = undef; return; } @@ -3276,7 +3276,7 @@ sub _packet_from_client { }; if ( $com->{code} eq COM_QUIT ) { # Fire right away; will cleanup later. - MKDEBUG && _d('Got a COM_QUIT'); + PTDEBUG && _d('Got a COM_QUIT'); $session->{closed} = 1; # delete session when done @@ -3311,13 +3311,13 @@ sub _packet_from_client { sub _make_event { my ( $self, $event, $packet, $session ) = @_; - MKDEBUG && _d('Making event'); + PTDEBUG && _d('Making event'); $session->{raw_packets} = []; $self->_delete_buff($session); if ( !$session->{thread_id} ) { - MKDEBUG && _d('Giving session fake thread id', $self->{fake_thread_id}); + PTDEBUG && _d('Giving session fake thread id', $self->{fake_thread_id}); $session->{thread_id} = $self->{fake_thread_id}++; } @@ -3342,7 +3342,7 @@ sub _make_event { No_index_used => ($event->{No_index_used} ? 'Yes' : 'No'), }; @{$new_event}{keys %{$session->{attribs}}} = values %{$session->{attribs}}; - MKDEBUG && _d('Properties of event:', Dumper($new_event)); + PTDEBUG && _d('Properties of event:', Dumper($new_event)); delete $session->{cmd}; @@ -3419,11 +3419,11 @@ sub decode_len { $encode_len = 8; } else { - MKDEBUG && _d('data:', $data, 'first byte:', $first_byte); + PTDEBUG && _d('data:', $data, 'first byte:', $first_byte); die "Invalid length encoded byte: $first_byte"; } - MKDEBUG && _d('len:', $len, 'encode len', $encode_len); + PTDEBUG && _d('len:', $len, 'encode len', $encode_len); return $data, $len, $encode_len; } @@ -3465,9 +3465,9 @@ sub get_lcb { sub parse_error_packet { my ( $data ) = @_; return unless $data; - MKDEBUG && _d('ERROR data:', $data); + PTDEBUG && _d('ERROR data:', $data); if ( length $data < 16 ) { - MKDEBUG && _d('Error packet is too short:', $data); + PTDEBUG && _d('Error packet is too short:', $data); return; } my $errno = to_num(substr($data, 0, 4)); @@ -3480,16 +3480,16 @@ sub parse_error_packet { sqlstate => $marker . $sqlstate, message => $message, }; - MKDEBUG && _d('Error packet:', Dumper($pkt)); + PTDEBUG && _d('Error packet:', Dumper($pkt)); return $pkt; } sub parse_ok_packet { my ( $data ) = @_; return unless $data; - MKDEBUG && _d('OK data:', $data); + PTDEBUG && _d('OK data:', $data); if ( length $data < 12 ) { - MKDEBUG && _d('OK packet is too short:', $data); + PTDEBUG && _d('OK packet is too short:', $data); return; } my $affected_rows = get_lcb(\$data); @@ -3504,16 +3504,16 @@ sub parse_ok_packet { warnings => $warnings, message => $message, }; - MKDEBUG && _d('OK packet:', Dumper($pkt)); + PTDEBUG && _d('OK packet:', Dumper($pkt)); return $pkt; } sub parse_ok_prepared_statement_packet { my ( $data ) = @_; return unless $data; - MKDEBUG && _d('OK prepared statement data:', $data); + PTDEBUG && _d('OK prepared statement data:', $data); if ( length $data < 8 ) { - MKDEBUG && _d('OK prepared statement packet is too short:', $data); + PTDEBUG && _d('OK prepared statement packet is too short:', $data); return; } my $sth_id = to_num(substr($data, 0, 8, '')); @@ -3524,14 +3524,14 @@ sub parse_ok_prepared_statement_packet { num_cols => $num_cols, num_params => $num_params, }; - MKDEBUG && _d('OK prepared packet:', Dumper($pkt)); + PTDEBUG && _d('OK prepared packet:', Dumper($pkt)); return $pkt; } sub parse_server_handshake_packet { my ( $data ) = @_; return unless $data; - MKDEBUG && _d('Server handshake data:', $data); + PTDEBUG && _d('Server handshake data:', $data); my $handshake_pattern = qr{ ^ # ----- ---- (.+?)00 # n Null-Term String server_version @@ -3549,14 +3549,14 @@ sub parse_server_handshake_packet { thread_id => to_num($thread_id), flags => parse_flags($flags), }; - MKDEBUG && _d('Server handshake packet:', Dumper($pkt)); + PTDEBUG && _d('Server handshake packet:', Dumper($pkt)); return $pkt; } sub parse_client_handshake_packet { my ( $data ) = @_; return unless $data; - MKDEBUG && _d('Client handshake data:', $data); + PTDEBUG && _d('Client handshake data:', $data); my ( $flags, $user, $buff_len ) = $data =~ m{ ^ (.{8}) # Client flags @@ -3567,7 +3567,7 @@ sub parse_client_handshake_packet { }x; if ( !$buff_len ) { - MKDEBUG && _d('Did not match client handshake packet'); + PTDEBUG && _d('Did not match client handshake packet'); return; } @@ -3582,20 +3582,20 @@ sub parse_client_handshake_packet { db => $db ? to_string($db) : '', flags => parse_flags($flags), }; - MKDEBUG && _d('Client handshake packet:', Dumper($pkt)); + PTDEBUG && _d('Client handshake packet:', Dumper($pkt)); return $pkt; } sub parse_com_packet { my ( $data, $len ) = @_; return unless $data && $len; - MKDEBUG && _d('COM data:', + PTDEBUG && _d('COM data:', (substr($data, 0, 100).(length $data > 100 ? '...' : '')), 'len:', $len); my $code = substr($data, 0, 2); my $com = $com_for{$code}; if ( !$com ) { - MKDEBUG && _d('Did not match COM packet'); + PTDEBUG && _d('Did not match COM packet'); return; } if ( $code ne COM_STMT_EXECUTE @@ -3609,7 +3609,7 @@ sub parse_com_packet { com => $com, data => $data, }; - MKDEBUG && _d('COM packet:', Dumper($pkt)); + PTDEBUG && _d('COM packet:', Dumper($pkt)); return $pkt; } @@ -3622,23 +3622,23 @@ sub parse_execute_packet { my $sth = $sths->{$sth_id}; if ( !$sth ) { - MKDEBUG && _d('Skipping unknown statement handle', $sth_id); + PTDEBUG && _d('Skipping unknown statement handle', $sth_id); return; } my $null_count = int(($sth->{num_params} + 7) / 8) || 1; my $null_bitmap = to_num(substr($data, 20, $null_count * 2)); - MKDEBUG && _d('NULL bitmap:', $null_bitmap, 'count:', $null_count); + PTDEBUG && _d('NULL bitmap:', $null_bitmap, 'count:', $null_count); substr($data, 0, 20 + ($null_count * 2), ''); my $new_params = to_num(substr($data, 0, 2, '')); my @types; if ( $new_params ) { - MKDEBUG && _d('New param types'); + PTDEBUG && _d('New param types'); for my $i ( 0..($sth->{num_params}-1) ) { my $type = to_num(substr($data, 0, 4, '')); push @types, $type_for{$type}; - MKDEBUG && _d('Param', $i, 'type:', $type, $type_for{$type}); + PTDEBUG && _d('Param', $i, 'type:', $type, $type_for{$type}); } $sth->{types} = \@types; } @@ -3648,12 +3648,12 @@ sub parse_execute_packet { my $arg = $sth->{statement}; - MKDEBUG && _d('Statement:', $arg); + PTDEBUG && _d('Statement:', $arg); for my $i ( 0..($sth->{num_params}-1) ) { my $val; my $len; # in bytes if ( $null_bitmap & (2**$i) ) { - MKDEBUG && _d('Param', $i, 'is NULL (bitmap)'); + PTDEBUG && _d('Param', $i, 'is NULL (bitmap)'); $val = 'NULL'; $len = 0; } @@ -3662,13 +3662,13 @@ sub parse_execute_packet { ($val, $len) = $unpack_type{$types[$i]}->($data); } else { - MKDEBUG && _d('No handler for param', $i, 'type', $types[$i]); + PTDEBUG && _d('No handler for param', $i, 'type', $types[$i]); $val = '?'; $len = 0; } } - MKDEBUG && _d('Param', $i, 'val:', $val); + PTDEBUG && _d('Param', $i, 'val:', $val); $arg =~ s/\?/$val/; substr($data, 0, $len * 2, '') if $len; @@ -3678,7 +3678,7 @@ sub parse_execute_packet { sth_id => $sth_id, arg => "EXECUTE $arg", }; - MKDEBUG && _d('Execute packet:', Dumper($pkt)); + PTDEBUG && _d('Execute packet:', Dumper($pkt)); return $pkt; } @@ -3692,7 +3692,7 @@ sub get_sth_id { sub parse_flags { my ( $flags ) = @_; die "I need flags" unless $flags; - MKDEBUG && _d('Flag data:', $flags); + PTDEBUG && _d('Flag data:', $flags); my %flags = %flag_for; my $flags_dec = to_num($flags); foreach my $flag ( keys %flag_for ) { @@ -3707,7 +3707,7 @@ sub uncompress_data { die "I need data" unless $data; die "I need a len argument" unless $len; die "I need a scalar reference to data" unless ref $data eq 'SCALAR'; - MKDEBUG && _d('Uncompressing data'); + PTDEBUG && _d('Uncompressing data'); our $InflateError; my $comp_bin_data = pack('H*', $$data); @@ -3726,10 +3726,10 @@ sub uncompress_data { sub detect_compression { my ( $self, $packet, $session ) = @_; - MKDEBUG && _d('Checking for client compression'); + PTDEBUG && _d('Checking for client compression'); my $com = parse_com_packet($packet->{data}, $packet->{mysql_data_len}); if ( $com && $com->{code} eq COM_SLEEP ) { - MKDEBUG && _d('Client is using compression'); + PTDEBUG && _d('Client is using compression'); $session->{compress} = 1; $packet->{data} = $packet->{mysql_hdr} . $packet->{data}; @@ -3737,7 +3737,7 @@ sub detect_compression { remove_mysql_header($packet); } else { - MKDEBUG && _d('Client is NOT using compression'); + PTDEBUG && _d('Client is NOT using compression'); $session->{compress} = 0; } return 1; @@ -3760,7 +3760,7 @@ sub uncompress_packet { $comp_data_len = to_num(substr($comp_hdr, 0, 6)); $pkt_num = to_num(substr($comp_hdr, 6, 2)); $uncomp_data_len = to_num(substr($comp_hdr, 8, 6)); - MKDEBUG && _d('Compression header data:', $comp_hdr, + PTDEBUG && _d('Compression header data:', $comp_hdr, 'compressed data len (bytes)', $comp_data_len, 'number', $pkt_num, 'uncompressed data len (bytes)', $uncomp_data_len); @@ -3784,7 +3784,7 @@ sub uncompress_packet { } } else { - MKDEBUG && _d('Packet is not really compressed'); + PTDEBUG && _d('Packet is not really compressed'); $packet->{data} = $$data; } @@ -3798,7 +3798,7 @@ sub remove_mysql_header { my $mysql_hdr = substr($packet->{data}, 0, 8, ''); my $mysql_data_len = to_num(substr($mysql_hdr, 0, 6)); my $pkt_num = to_num(substr($mysql_hdr, 6, 2)); - MKDEBUG && _d('MySQL packet: header data', $mysql_hdr, + PTDEBUG && _d('MySQL packet: header data', $mysql_hdr, 'data len (bytes)', $mysql_data_len, 'number', $pkt_num); $packet->{mysql_hdr} = $mysql_hdr; @@ -3816,7 +3816,7 @@ sub _get_errors_fh { my $o = $self->{o}; if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) { my $errors_file = $o->get('tcpdump-errors'); - MKDEBUG && _d('tcpdump-errors file:', $errors_file); + PTDEBUG && _d('tcpdump-errors file:', $errors_file); open $errors_fh, '>>', $errors_file or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR"; } @@ -3827,7 +3827,7 @@ sub _get_errors_fh { sub fail_session { my ( $self, $session, $reason ) = @_; - MKDEBUG && _d('Client', $session->{client}, 'failed because', $reason); + PTDEBUG && _d('Client', $session->{client}, 'failed because', $reason); my $errors_fh = $self->_get_errors_fh(); if ( $errors_fh ) { my $raw_packets = $session->{raw_packets}; @@ -3881,7 +3881,7 @@ package SysLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $syslog_regex = qr{\A.*\w+\[\d+\]: \[(\d+)-(\d+)\] (.*)\Z}; @@ -3901,7 +3901,7 @@ sub generate_wrappers { my ( $self, %args ) = @_; if ( ($self->{sanity} || '') ne "$args{next_event}" ){ - MKDEBUG && _d("Clearing and recreating internal state"); + PTDEBUG && _d("Clearing and recreating internal state"); @{$self}{qw(next_event tell is_syslog)} = $self->make_closures(%args); $self->{sanity} = "$args{next_event}"; } @@ -3918,11 +3918,11 @@ sub make_closures { my $line_filter = $args{'misc'}->{'line_filter'}; my $test_line = $next_event->(); - MKDEBUG && _d('Read first sample/test line:', $test_line); + PTDEBUG && _d('Read first sample/test line:', $test_line); if ( defined $test_line && $test_line =~ m/$syslog_regex/o ) { - MKDEBUG && _d('This looks like a syslog line, MKDEBUG prefix=LLSP'); + PTDEBUG && _d('This looks like a syslog line, PTDEBUG prefix=LLSP'); my ($msg_nr, $line_nr, $content) = $test_line =~ m/$syslog_regex/o; my @pending = ($test_line); @@ -3930,9 +3930,9 @@ sub make_closures { my $pos_in_log = 0; my $new_next_event = sub { - MKDEBUG && _d('LLSP: next_event()'); + PTDEBUG && _d('LLSP: next_event()'); - MKDEBUG && _d('LLSP: Current virtual $fh position:', $pos_in_log); + PTDEBUG && _d('LLSP: Current virtual $fh position:', $pos_in_log); my $new_pos = 0; my @arg_lines; @@ -3946,7 +3946,7 @@ sub make_closures { defined($line = $next_event->()); } ) { - MKDEBUG && _d('LLSP: Line:', $line); + PTDEBUG && _d('LLSP: Line:', $line); ($msg_nr, $line_nr, $content) = $line =~ m/$syslog_regex/o; if ( !$msg_nr ) { @@ -3954,38 +3954,38 @@ sub make_closures { } elsif ( $msg_nr != $last_msg_nr ) { - MKDEBUG && _d('LLSP: $msg_nr', $last_msg_nr, '=>', $msg_nr); + PTDEBUG && _d('LLSP: $msg_nr', $last_msg_nr, '=>', $msg_nr); $last_msg_nr = $msg_nr; last LINE; } elsif ( @arg_lines && $new_event_test && $new_event_test->($content) ) { - MKDEBUG && _d('LLSP: $new_event_test matches'); + PTDEBUG && _d('LLSP: $new_event_test matches'); last LINE; } $content =~ s/#(\d{3})/chr(oct($1))/ge; $content =~ s/\^I/\t/g; if ( $line_filter ) { - MKDEBUG && _d('LLSP: applying $line_filter'); + PTDEBUG && _d('LLSP: applying $line_filter'); $content = $line_filter->($content); } push @arg_lines, $content; } - MKDEBUG && _d('LLSP: Exited while-loop after finding a complete entry'); + PTDEBUG && _d('LLSP: Exited while-loop after finding a complete entry'); my $psql_log_event = @arg_lines ? join('', @arg_lines) : undef; - MKDEBUG && _d('LLSP: Final log entry:', $psql_log_event); + PTDEBUG && _d('LLSP: Final log entry:', $psql_log_event); if ( defined $line ) { - MKDEBUG && _d('LLSP: Saving $line:', $line); + PTDEBUG && _d('LLSP: Saving $line:', $line); @pending = $line; - MKDEBUG && _d('LLSP: $pos_in_log:', $pos_in_log, '=>', $new_pos); + PTDEBUG && _d('LLSP: $pos_in_log:', $pos_in_log, '=>', $new_pos); $pos_in_log = $new_pos; } else { - MKDEBUG && _d('LLSP: EOF reached'); + PTDEBUG && _d('LLSP: EOF reached'); @pending = (); $last_msg_nr = 0; } @@ -3994,7 +3994,7 @@ sub make_closures { }; my $new_tell = sub { - MKDEBUG && _d('LLSP: tell()', $pos_in_log); + PTDEBUG && _d('LLSP: tell()', $pos_in_log); return $pos_in_log; }; @@ -4003,16 +4003,16 @@ sub make_closures { else { - MKDEBUG && _d('Plain log, or we are at EOF; MKDEBUG prefix=PLAIN'); + PTDEBUG && _d('Plain log, or we are at EOF; PTDEBUG prefix=PLAIN'); my @pending = defined $test_line ? ($test_line) : (); my $new_next_event = sub { - MKDEBUG && _d('PLAIN: next_event(); @pending:', scalar @pending); + PTDEBUG && _d('PLAIN: next_event(); @pending:', scalar @pending); return @pending ? shift @pending : $next_event->(); }; my $new_tell = sub { - MKDEBUG && _d('PLAIN: tell(); @pending:', scalar @pending); + PTDEBUG && _d('PLAIN: tell(); @pending:', scalar @pending); return @pending ? 0 : $tell->(); }; return ($new_next_event, $new_tell, 0); @@ -4047,7 +4047,7 @@ package PgLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4108,7 +4108,7 @@ sub parse_event { my $got_duration; if ( !$was_pending && (!defined $line || $line !~ m/$log_line_regex/o) ) { - MKDEBUG && _d('Skipping lines until I find a header'); + PTDEBUG && _d('Skipping lines until I find a header'); my $found_header; LINE: while ( @@ -4122,10 +4122,10 @@ sub parse_event { last LINE; } else { - MKDEBUG && _d('Line was not a header, will fetch another'); + PTDEBUG && _d('Line was not a header, will fetch another'); } } - MKDEBUG && _d('Found a header line, now at pos_in_line', $pos_in_log); + PTDEBUG && _d('Found a header line, now at pos_in_line', $pos_in_log); } my $first_line; @@ -4140,7 +4140,7 @@ sub parse_event { if ( (($line_type) = $line =~ m/$log_line_regex/o) && $line_type ne 'LOG' ) { if ( @arg_lines ) { - MKDEBUG && _d('Found a non-LOG line, exiting loop'); + PTDEBUG && _d('Found a non-LOG line, exiting loop'); last LINE; } @@ -4149,20 +4149,20 @@ sub parse_event { if ( my ($e) = $line =~ m/ERROR:\s+(\S.*)\Z/s ) { push @properties, 'Error_msg', $e; - MKDEBUG && _d('Found an error msg, saving and continuing'); + PTDEBUG && _d('Found an error msg, saving and continuing'); ($new_pos, $line) = $self->get_line(); next LINE; } elsif ( my ($s) = $line =~ m/STATEMENT:\s+(\S.*)\Z/s ) { push @properties, 'arg', $s, 'cmd', 'Query'; - MKDEBUG && _d('Found a statement, finishing up event'); + PTDEBUG && _d('Found a statement, finishing up event'); $done = 1; last LINE; } else { - MKDEBUG && _d("I don't know what to do with this line"); + PTDEBUG && _d("I don't know what to do with this line"); } } @@ -4192,7 +4192,7 @@ sub parse_event { |transaction\sID\swrap\slimit\sis }x ) { - MKDEBUG && _d('Skipping this line because it matches skip-pattern'); + PTDEBUG && _d('Skipping this line because it matches skip-pattern'); ($new_pos, $line) = $self->get_line(); next LINE; } @@ -4206,36 +4206,36 @@ sub parse_event { } push @arg_lines, $line; - MKDEBUG && _d('This was a continuation line'); + PTDEBUG && _d('This was a continuation line'); } elsif ( my ( $sev, $label, $rest ) = $line =~ m/$log_line_regex(.+?):\s+(.*)\Z/so ) { - MKDEBUG && _d('Line is case 1 or case 3'); + PTDEBUG && _d('Line is case 1 or case 3'); if ( @arg_lines ) { $done = 1; - MKDEBUG && _d('There are saved @arg_lines, we are done'); + PTDEBUG && _d('There are saved @arg_lines, we are done'); if ( $label eq 'duration' && $rest =~ m/[0-9.]+\s+\S+\Z/ ) { if ( $got_duration ) { - MKDEBUG && _d('Discarding line, duration already found'); + PTDEBUG && _d('Discarding line, duration already found'); } else { push @properties, 'Query_time', $self->duration_to_secs($rest); - MKDEBUG && _d("Line's duration is for previous event:", $rest); + PTDEBUG && _d("Line's duration is for previous event:", $rest); } } else { $self->pending($new_pos, $line); - MKDEBUG && _d('Deferred line'); + PTDEBUG && _d('Deferred line'); } } elsif ( $label =~ m/\A(?:duration|statement|query)\Z/ ) { - MKDEBUG && _d('Case 1: start a multi-line event'); + PTDEBUG && _d('Case 1: start a multi-line event'); if ( $label eq 'duration' ) { @@ -4246,33 +4246,33 @@ sub parse_event { push @properties, 'Query_time', $self->duration_to_secs($dur); $got_duration = 1; push @arg_lines, $stmt; - MKDEBUG && _d('Duration + statement'); + PTDEBUG && _d('Duration + statement'); } else { $first_line = undef; ($pos_in_log, $line) = $self->get_line(); - MKDEBUG && _d('Line applies to event we never saw, discarding'); + PTDEBUG && _d('Line applies to event we never saw, discarding'); next LINE; } } else { push @arg_lines, $rest; - MKDEBUG && _d('Putting onto @arg_lines'); + PTDEBUG && _d('Putting onto @arg_lines'); } } else { $done = 1; - MKDEBUG && _d('Line is case 3, event is done'); + PTDEBUG && _d('Line is case 3, event is done'); if ( @arg_lines ) { $self->pending($new_pos, $line); - MKDEBUG && _d('There was @arg_lines, putting line to pending'); + PTDEBUG && _d('There was @arg_lines, putting line to pending'); } else { - MKDEBUG && _d('No need to defer, process event from this line now'); + PTDEBUG && _d('No need to defer, process event from this line now'); push @properties, 'cmd', 'Admin', 'arg', $label; if ( $label =~ m/\A(?:dis)?connection(?: received| authorized)?\Z/ ) { @@ -4298,22 +4298,22 @@ sub parse_event { } # LINE if ( !defined $line ) { - MKDEBUG && _d('Line not defined, at EOF; calling oktorun(0) if exists'); + PTDEBUG && _d('Line not defined, at EOF; calling oktorun(0) if exists'); $args{oktorun}->(0) if $args{oktorun}; if ( !@arg_lines ) { - MKDEBUG && _d('No saved @arg_lines either, we are all done'); + PTDEBUG && _d('No saved @arg_lines either, we are all done'); return undef; } } if ( $line_type && $line_type ne 'LOG' ) { - MKDEBUG && _d('Line is not a LOG line'); + PTDEBUG && _d('Line is not a LOG line'); if ( $line_type eq 'ERROR' ) { - MKDEBUG && _d('Line is ERROR'); + PTDEBUG && _d('Line is ERROR'); if ( @arg_lines ) { - MKDEBUG && _d('There is @arg_lines, will peek ahead one line'); + PTDEBUG && _d('There is @arg_lines, will peek ahead one line'); my ( $temp_pos, $temp_line ) = $self->get_line(); my ( $type, $msg ); if ( @@ -4321,51 +4321,51 @@ sub parse_event { && ( ($type, $msg) = $temp_line =~ m/$log_line_regex(.*)/o ) && ( $type ne 'STATEMENT' || $msg eq $arg_lines[-1] ) ) { - MKDEBUG && _d('Error/statement line pertain to current event'); + PTDEBUG && _d('Error/statement line pertain to current event'); push @properties, 'Error_msg', $line =~ m/ERROR:\s*(\S.*)\Z/s; if ( $type ne 'STATEMENT' ) { - MKDEBUG && _d('Must save peeked line, it is a', $type); + PTDEBUG && _d('Must save peeked line, it is a', $type); $self->pending($temp_pos, $temp_line); } } elsif ( defined $temp_line && defined $type ) { - MKDEBUG && _d('Error/statement line are a new event'); + PTDEBUG && _d('Error/statement line are a new event'); $self->pending($new_pos, $line); $self->pending($temp_pos, $temp_line); } else { - MKDEBUG && _d("Unknown line", $line); + PTDEBUG && _d("Unknown line", $line); } } } else { - MKDEBUG && _d("Unknown line", $line); + PTDEBUG && _d("Unknown line", $line); } } if ( $done || @arg_lines ) { - MKDEBUG && _d('Making event'); + PTDEBUG && _d('Making event'); push @properties, 'pos_in_log', $pos_in_log; if ( @arg_lines ) { - MKDEBUG && _d('Assembling @arg_lines: ', scalar @arg_lines); + PTDEBUG && _d('Assembling @arg_lines: ', scalar @arg_lines); push @properties, 'arg', join('', @arg_lines), 'cmd', 'Query'; } if ( $first_line ) { if ( my ($ts) = $first_line =~ m/([0-9-]{10} [0-9:.]{8,12})/ ) { - MKDEBUG && _d('Getting timestamp', $ts); + PTDEBUG && _d('Getting timestamp', $ts); push @properties, 'ts', $ts; } if ( my ($meta) = $first_line =~ m/(.*?)[A-Z]{3,}: / ) { - MKDEBUG && _d('Found a meta-data chunk:', $meta); + PTDEBUG && _d('Found a meta-data chunk:', $meta); push @properties, $self->get_meta($meta); } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; $event->{bytes} = length($event->{arg} || ''); return $event; @@ -4383,11 +4383,11 @@ sub get_meta { push @properties, $prop, $val; } else { - MKDEBUG && _d('Bad meta key', $set); + PTDEBUG && _d('Bad meta key', $set); } } else { - MKDEBUG && _d("Can't figure out meta from", $set); + PTDEBUG && _d("Can't figure out meta from", $set); } } return @properties; @@ -4397,25 +4397,25 @@ sub get_line { my ( $self ) = @_; my ($pos, $line, $was_pending) = $self->pending; if ( ! defined $line ) { - MKDEBUG && _d('Got nothing from pending, trying the $fh'); + PTDEBUG && _d('Got nothing from pending, trying the $fh'); my ( $next_event, $tell) = @{$self}{qw(next_event tell)}; eval { $pos = $tell->(); $line = $next_event->(); }; - if ( MKDEBUG && $EVAL_ERROR ) { + if ( PTDEBUG && $EVAL_ERROR ) { _d($EVAL_ERROR); } } - MKDEBUG && _d('Got pos/line:', $pos, $line); + PTDEBUG && _d('Got pos/line:', $pos, $line); return ($pos, $line); } sub pending { my ( $self, $val, $pos_in_log ) = @_; my $was_pending; - MKDEBUG && _d('In sub pending, val:', $val); + PTDEBUG && _d('In sub pending, val:', $val); if ( $val ) { push @{$self->{pending}}, [$val, $pos_in_log]; } @@ -4423,7 +4423,7 @@ sub pending { ($val, $pos_in_log) = @{ shift @{$self->{pending}} }; $was_pending = 1; } - MKDEBUG && _d('Return from pending:', $val, $pos_in_log); + PTDEBUG && _d('Return from pending:', $val, $pos_in_log); return ($val, $pos_in_log, $was_pending); } @@ -4431,7 +4431,7 @@ sub generate_wrappers { my ( $self, %args ) = @_; if ( ($self->{sanity} || '') ne "$args{next_event}" ){ - MKDEBUG && _d("Clearing and recreating internal state"); + PTDEBUG && _d("Clearing and recreating internal state"); eval { require SysLogParser; }; # Required for tests to work. my $sl = new SysLogParser(); @@ -4456,7 +4456,7 @@ sub generate_wrappers { sub duration_to_secs { my ( $self, $str ) = @_; - MKDEBUG && _d('Duration:', $str); + PTDEBUG && _d('Duration:', $str); my ( $num, $suf ) = split(/\s+/, $str); my $factor = $suf eq 'ms' ? 1000 : $suf eq 'sec' ? 1 @@ -4492,7 +4492,7 @@ package SlowLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4544,7 +4544,7 @@ sub parse_event { if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); if ( @chunks > 1 ) { - MKDEBUG && _d("Found multiple chunks"); + PTDEBUG && _d("Found multiple chunks"); $stmt = shift @chunks; unshift @$pending, @chunks; } @@ -4562,18 +4562,18 @@ sub parse_event { while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - MKDEBUG && _d("Got ts", $time); + PTDEBUG && _d("Got ts", $time); push @properties, 'ts', $time; ++$got_ts; if ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } @@ -4582,13 +4582,13 @@ sub parse_event { elsif ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - MKDEBUG && _d("Got admin command"); + PTDEBUG && _d("Got admin command"); $line =~ s/^#\s+//; # string leading "# ". push @properties, 'cmd', 'Admin', 'arg', $line; push @properties, 'bytes', length($properties[-1]); @@ -4597,12 +4597,12 @@ sub parse_event { } elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - MKDEBUG && _d("Got some line with properties"); + PTDEBUG && _d("Got some line with properties"); if ( $line =~ m/Schema:\s+\w+: / ) { - MKDEBUG && _d('Removing empty Schema attrib'); + PTDEBUG && _d('Removing empty Schema attrib'); $line =~ s/Schema:\s+//; - MKDEBUG && _d($line); + PTDEBUG && _d($line); } my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; @@ -4610,36 +4610,36 @@ sub parse_event { } elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; ++$got_db; } elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, split(/,|\s*=\s*/, $setting); ++$got_set; } if ( !$found_arg && $pos == $len ) { - MKDEBUG && _d("Did not find arg, looking for special cases"); + PTDEBUG && _d("Did not find arg, looking for special cases"); local $INPUT_RECORD_SEPARATOR = ";\n"; if ( defined(my $l = $next_event->()) ) { chomp $l; $l =~ s/^\s+//; - MKDEBUG && _d("Found admin statement", $l); + PTDEBUG && _d("Found admin statement", $l); push @properties, 'cmd', 'Admin', 'arg', $l; push @properties, 'bytes', length($properties[-1]); $found_arg++; } else { - MKDEBUG && _d("I can't figure out what to do with this line"); + PTDEBUG && _d("I can't figure out what to do with this line"); next EVENT; } } } else { - MKDEBUG && _d("Got the query/arg line"); + PTDEBUG && _d("Got the query/arg line"); my $arg = substr($stmt, $pos - length($line)); push @properties, 'arg', $arg, 'bytes', length($arg); if ( $args{misc} && $args{misc}->{embed} @@ -4651,7 +4651,7 @@ sub parse_event { } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -4693,7 +4693,7 @@ package SlowLogWriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -4780,7 +4780,7 @@ package EventAggregator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use Data::Dumper; @@ -4857,7 +4857,7 @@ sub aggregate { return unless defined $group_by; $self->{n_events}++; - MKDEBUG && _d('Event', $self->{n_events}); + PTDEBUG && _d('Event', $self->{n_events}); return $self->{unrolled_loops}->($self, $event, $group_by) if $self->{unrolled_loops}; @@ -4870,9 +4870,9 @@ sub aggregate { foreach my $attrib ( keys %{$self->{attributes}} ) { if ( !exists $event->{$attrib} ) { - MKDEBUG && _d("attrib doesn't exist in event:", $attrib); + PTDEBUG && _d("attrib doesn't exist in event:", $attrib); my $alt_attrib = $self->{alt_attribs}->{$attrib}->($event); - MKDEBUG && _d('alt attrib:', $alt_attrib); + PTDEBUG && _d('alt attrib:', $alt_attrib); next ATTRIB unless $alt_attrib; } @@ -4937,7 +4937,7 @@ sub _make_unrolled_loops { push @lines, '}'; my $code = join("\n", @lines); - MKDEBUG && _d('Unrolled subroutine:', @lines); + PTDEBUG && _d('Unrolled subroutine:', @lines); my $sub = eval $code; die $EVAL_ERROR if $EVAL_ERROR; $self->{unrolled_loops} = $sub; @@ -4997,7 +4997,7 @@ sub make_handler { my $val; eval { $val= $self->_get_value(%args); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Cannot make", $attrib, "handler:", $EVAL_ERROR); + PTDEBUG && _d("Cannot make", $attrib, "handler:", $EVAL_ERROR); return; } return unless defined $val; # can't determine type if it's undef @@ -5008,7 +5008,7 @@ sub make_handler { : $val =~ m/^(?:\d+|$float_re)$/o ? 'num' : $val =~ m/^(?:Yes|No)$/ ? 'bool' : 'string'; - MKDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); + PTDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); $self->{type_for}->{$attrib} = $type; my @lines; @@ -5111,7 +5111,7 @@ sub make_handler { '}', ); $self->{code_for}->{$attrib} = join("\n", @code); - MKDEBUG && _d($attrib, 'handler code:', $self->{code_for}->{$attrib}); + PTDEBUG && _d($attrib, 'handler code:', $self->{code_for}->{$attrib}); my $sub = eval $self->{code_for}->{$attrib}; if ( $EVAL_ERROR ) { die "Failed to compile $attrib handler code: $EVAL_ERROR"; @@ -5145,7 +5145,7 @@ sub bucket_value { for my $base10_bucket ( 0..($#base10_starts-1) ) { my $next_bucket = bucket_idx( $base10_starts[$base10_bucket+1] ); - MKDEBUG && _d('Base 10 bucket', $base10_bucket, 'maps to', + PTDEBUG && _d('Base 10 bucket', $base10_bucket, 'maps to', 'base 1.05 buckets', $start_bucket, '..', $next_bucket-1); for my $base1_05_bucket ($start_bucket..($next_bucket-1)) { $buck_tens[$base1_05_bucket] = $base10_bucket; @@ -5165,7 +5165,7 @@ sub calculate_statistical_metrics { my $globals = $self->{result_globals}; my $class_metrics = $self->{class_metrics}; my $global_metrics = $self->{global_metrics}; - MKDEBUG && _d('Calculating statistical_metrics'); + PTDEBUG && _d('Calculating statistical_metrics'); foreach my $attrib ( keys %$globals ) { if ( exists $globals->{$attrib}->{all} ) { $global_metrics->{$attrib} @@ -5250,7 +5250,7 @@ sub _calc_metrics { my $prev = NUM_BUCK-1; # Used for getting median when $cutoff is odd my $bucket_95 = 0; # top bucket in 95th - MKDEBUG && _d('total vals:', $total_left, 'top vals:', $top_vals, 'mid:', $mid); + PTDEBUG && _d('total vals:', $total_left, 'top vals:', $top_vals, 'mid:', $mid); my @buckets = map { 0 } (0..NUM_BUCK-1); map { $buckets[$_] = $vals->{$_} } keys %$vals; @@ -5280,7 +5280,7 @@ sub _calc_metrics { my $maxstdev = (($args->{max} || 0) - ($args->{min} || 0)) / 2; $stddev = $stddev > $maxstdev ? $maxstdev : $stddev; - MKDEBUG && _d('sum:', $sum, 'sumsq:', $sumsq, 'stddev:', $stddev, + PTDEBUG && _d('sum:', $sum, 'sumsq:', $sumsq, 'stddev:', $stddev, 'median:', $median, 'prev bucket:', $prev, 'total left:', $total_left, 'sum excl', $sum_excl, 'bucket 95:', $bucket_95, $buck_vals[$bucket_95]); @@ -5372,7 +5372,7 @@ sub add_new_attributes { $self->{attributes}->{$attrib} = [$attrib]; $self->{alt_attribs}->{$attrib} = make_alt_attrib($attrib); push @{$self->{all_attribs}}, $attrib; - MKDEBUG && _d('Added new attribute:', $attrib); + PTDEBUG && _d('Added new attribute:', $attrib); } grep { $_ ne $self->{groupby} @@ -5407,7 +5407,7 @@ sub make_alt_attrib { . "&& exists \$event->{'$_'};" } @attribs; push @lines, 'return $alt_attrib; }'; - MKDEBUG && _d('alt attrib sub for', $attrib, ':', @lines); + PTDEBUG && _d('alt attrib sub for', $attrib, ':', @lines); my $sub = eval join("\n", @lines); die if $EVAL_ERROR; return $sub; @@ -5415,7 +5415,7 @@ sub make_alt_attrib { sub merge { my ( @ea_objs ) = @_; - MKDEBUG && _d('Merging', scalar @ea_objs, 'ea'); + PTDEBUG && _d('Merging', scalar @ea_objs, 'ea'); return unless scalar @ea_objs; my $ea1 = shift @ea_objs; @@ -5453,7 +5453,7 @@ sub merge { } keys %{$r1->{classes}}; for my $i ( 0..$#ea_objs ) { - MKDEBUG && _d('Merging ea obj', ($i + 1)); + PTDEBUG && _d('Merging ea obj', ($i + 1)); my $r2 = $ea_objs[$i]->results; eval { @@ -5465,19 +5465,19 @@ sub merge { if ( $r1_class && $r2_class ) { CLASS_ATTRIB: foreach my $attrib ( keys %$r2_class ) { - MKDEBUG && _d('merge', $attrib); + PTDEBUG && _d('merge', $attrib); if ( $r1_class->{$attrib} && $r2_class->{$attrib} ) { _add_attrib_vals($r1_class->{$attrib}, $r2_class->{$attrib}); } elsif ( !$r1_class->{$attrib} ) { - MKDEBUG && _d('copy', $attrib); + PTDEBUG && _d('copy', $attrib); $r1_class->{$attrib} = _deep_copy_attrib_vals($r2_class->{$attrib}) } } } elsif ( !$r1_class ) { - MKDEBUG && _d('copy class'); + PTDEBUG && _d('copy class'); $r_merged->{classes}->{$class} = _deep_copy_attribs($r2_class); } @@ -5492,7 +5492,7 @@ sub merge { $new_worst_sample = $r2->{samples}->{$class}; } if ( $new_worst_sample ) { - MKDEBUG && _d('New worst sample:', $worst, '=', + PTDEBUG && _d('New worst sample:', $worst, '=', $new_worst_sample->{$worst}, 'item:', substr($class, 0, 100)); my %new_sample; @new_sample{keys %$new_worst_sample} @@ -5507,17 +5507,17 @@ sub merge { eval { GLOBAL_ATTRIB: - MKDEBUG && _d('Merging global attributes'); + PTDEBUG && _d('Merging global attributes'); foreach my $attrib ( keys %{$r2->{globals}} ) { my $r1_global = $r_merged->{globals}->{$attrib}; my $r2_global = $r2->{globals}->{$attrib}; if ( $r1_global && $r2_global ) { - MKDEBUG && _d('merge', $attrib); + PTDEBUG && _d('merge', $attrib); _add_attrib_vals($r1_global, $r2_global); } elsif ( !$r1_global ) { - MKDEBUG && _d('copy', $attrib); + PTDEBUG && _d('copy', $attrib); $r_merged->{globals}->{$attrib} = _deep_copy_attrib_vals($r2_global); } @@ -5581,8 +5581,8 @@ sub _add_attrib_vals { map { $vals1->{$val}->{$_} += $val2->{$_} } keys %$val2; } else { - MKDEBUG && _d('vals1:', Dumper($vals1)); - MKDEBUG && _d('vals2:', Dumper($vals2)); + PTDEBUG && _d('vals1:', Dumper($vals1)); + PTDEBUG && _d('vals2:', Dumper($vals2)); die "$val type mismatch"; } } @@ -5646,7 +5646,7 @@ sub calculate_apdex { } my $f = 4 * $t; - MKDEBUG && _d("Apdex T =", $t, "F =", $f); + PTDEBUG && _d("Apdex T =", $t, "F =", $f); my $satisfied = 0; my $tolerating = 0; @@ -5671,7 +5671,7 @@ sub calculate_apdex { } my $apdex = sprintf('%.2f', ($satisfied + ($tolerating / 2)) / $n_samples); - MKDEBUG && _d($n_samples, "samples,", $satisfied, "satisfied,", + PTDEBUG && _d($n_samples, "samples,", $satisfied, "satisfied,", $tolerating, "tolerating,", $frustrated, "frustrated, Apdex score:", $apdex); @@ -5734,7 +5734,7 @@ package ReportFormatter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use POSIX qw(ceil); @@ -5767,7 +5767,7 @@ sub new { . "is not installed" unless $have_term; ($self->{line_width}) = GetTerminalSize(); } - MKDEBUG && _d('Line width:', $self->{line_width}); + PTDEBUG && _d('Line width:', $self->{line_width}); return bless $self, $class; } @@ -5792,7 +5792,7 @@ sub set_columns { if ( $col->{width} ) { $col->{width_pct} = ceil(($col->{width} * 100) / $self->{line_width}); - MKDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', + PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', $col->{width_pct}, '%'); } @@ -5800,7 +5800,7 @@ sub set_columns { $used_width += $col->{width_pct}; } else { - MKDEBUG && _d('Auto width col:', $col_name); + PTDEBUG && _d('Auto width col:', $col_name); $col->{auto_width} = 1; push @auto_width_cols, $i; } @@ -5829,15 +5829,15 @@ sub set_columns { if ( @auto_width_cols ) { my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols); - MKDEBUG && _d('Line width left:', (100-$used_width), '%;', + PTDEBUG && _d('Line width left:', (100-$used_width), '%;', 'each auto width col:', $wid_per_col, '%'); map { $self->{cols}->[$_]->{width_pct} = $wid_per_col } @auto_width_cols; } $min_hdr_wid += ($self->{n_cols} - 1) * length $self->{column_spacing}; - MKDEBUG && _d('min header width:', $min_hdr_wid); + PTDEBUG && _d('min header width:', $min_hdr_wid); if ( $min_hdr_wid > $self->{line_width} ) { - MKDEBUG && _d('Will truncate headers because min header width', + PTDEBUG && _d('Will truncate headers because min header width', $min_hdr_wid, '> line width', $self->{line_width}); $self->{truncate_headers} = 1; } @@ -5878,7 +5878,7 @@ sub get_report { my @col_fmts = $self->_make_column_formats(); my $fmt = ($self->{line_prefix} || '') . join($self->{column_spacing}, @col_fmts); - MKDEBUG && _d('Format:', $fmt); + PTDEBUG && _d('Format:', $fmt); (my $hdr_fmt = $fmt) =~ s/%([^-])/%-$1/g; @@ -5930,7 +5930,7 @@ sub truncate_value { $val = $mark . substr($val, -1 * $width + length $mark); } else { - MKDEBUG && _d("I don't know how to", $side, "truncate values"); + PTDEBUG && _d("I don't know how to", $side, "truncate values"); } return $val; } @@ -5942,27 +5942,27 @@ sub _calculate_column_widths { foreach my $col ( @{$self->{cols}} ) { my $print_width = int($self->{line_width} * ($col->{width_pct} / 100)); - MKDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, + PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, 'char width:', $print_width, 'min val:', $col->{min_val}, 'max val:', $col->{max_val}); if ( $col->{auto_width} ) { if ( $col->{min_val} && $print_width < $col->{min_val} ) { - MKDEBUG && _d('Increased to min val width:', $col->{min_val}); + PTDEBUG && _d('Increased to min val width:', $col->{min_val}); $print_width = $col->{min_val}; } elsif ( $col->{max_val} && $print_width > $col->{max_val} ) { - MKDEBUG && _d('Reduced to max val width:', $col->{max_val}); + PTDEBUG && _d('Reduced to max val width:', $col->{max_val}); $extra_space += $print_width - $col->{max_val}; $print_width = $col->{max_val}; } } $col->{print_width} = $print_width; - MKDEBUG && _d('print width:', $col->{print_width}); + PTDEBUG && _d('print width:', $col->{print_width}); } - MKDEBUG && _d('Extra space:', $extra_space); + PTDEBUG && _d('Extra space:', $extra_space); while ( $extra_space-- ) { foreach my $col ( @{$self->{cols}} ) { if ( $col->{auto_width} @@ -5985,7 +5985,7 @@ sub _truncate_headers { my $print_width = $col->{print_width}; next if length $col_name <= $print_width; $col->{name} = $self->truncate_value($col, $col_name, $print_width, $side); - MKDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, + PTDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, 'max width:', $print_width); } return; @@ -6010,7 +6010,7 @@ sub _truncate_line_values { my $print_width = $col->{print_width}; $val = $callback ? $callback->($col, $val, $print_width) : $self->truncate_value($col, $val, $print_width); - MKDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, + PTDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, '; max width:', $print_width); $vals->[$i] = $val; } @@ -6091,7 +6091,7 @@ Transformers->import(qw( crc32 )); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant LINE_LENGTH => 74; use constant MAX_STRING_LENGTH => 10; @@ -6102,7 +6102,7 @@ sub new { } my $label_width = $args{label_width} || 12; - MKDEBUG && _d('Label width:', $label_width); + PTDEBUG && _d('Label width:', $label_width); my $cheat_width = $label_width + 1; @@ -6145,7 +6145,7 @@ sub print_reports { my $last_report; foreach my $report ( @$reports ) { - MKDEBUG && _d('Printing', $report, 'report'); + PTDEBUG && _d('Printing', $report, 'report'); my $report_output = $self->$report(%args); if ( $report_output ) { print "\n" @@ -6153,7 +6153,7 @@ sub print_reports { print $report_output; } else { - MKDEBUG && _d('No', $report, 'report'); + PTDEBUG && _d('No', $report, 'report'); } $last_report = $report; } @@ -6176,7 +6176,7 @@ sub rusage { shorten( ($vsz || 0) * 1_024 ); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } return $rusage ? $rusage : "# Could not get rusage\n"; } @@ -6230,7 +6230,7 @@ sub header { }; } - MKDEBUG && _d('global_cnt:', $global_cnt, 'unique:', + PTDEBUG && _d('global_cnt:', $global_cnt, 'unique:', scalar keys %{$results->{classes}}, 'qps:', $qps, 'conc:', $conc); my $line = sprintf( '# Overall: %s total, %s unique, %s QPS, %sx concurrency ', @@ -6501,7 +6501,7 @@ sub event_report { push @result, "# EXPLAIN sparkline: $sparkline\n"; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR); + PTDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR); } } @@ -6764,7 +6764,7 @@ sub profile { $samp_query, $default_db); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR); + PTDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR); } } @@ -6883,7 +6883,7 @@ sub prepared { $exec_cnt = $exec->{Query_time}->{cnt}; } else { - MKDEBUG && _d('Statement prepared but not executed:', $item); + PTDEBUG && _d('Statement prepared but not executed:', $item); $exec_r = 0; $exec_cnt = 0; } @@ -6894,7 +6894,7 @@ sub prepared { $prep_cnt = scalar keys %{$prep->{Statement_id}->{unq}}, } else { - MKDEBUG && _d('Statement executed but not prepared:', $item); + PTDEBUG && _d('Statement executed but not prepared:', $item); $prep_r = 0; $prep_cnt = 0; } @@ -7067,7 +7067,7 @@ sub format_string_list { sub sort_attribs { my ( $self, $attribs, $ea ) = @_; return unless $attribs && @$attribs; - MKDEBUG && _d("Sorting attribs:", @$attribs); + PTDEBUG && _d("Sorting attribs:", @$attribs); my @num_order = qw( Query_time @@ -7109,7 +7109,7 @@ sub sort_attribs { push @string, $attrib; } else { - MKDEBUG && _d("Unknown attrib type:", $type, "for", $attrib); + PTDEBUG && _d("Unknown attrib type:", $type, "for", $attrib); } } @@ -7175,7 +7175,7 @@ sub explain_report { eval { if ( !$qp->has_derived_table($query) ) { if ( $db ) { - MKDEBUG && _d($dbh, "USE", $db); + PTDEBUG && _d($dbh, "USE", $db); $dbh->do("USE " . $q->quote($db)); } my $sth = $dbh->prepare("EXPLAIN /*!50100 PARTITIONS */ $query"); @@ -7193,7 +7193,7 @@ sub explain_report { } }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("EXPLAIN failed:", $query, $EVAL_ERROR); + PTDEBUG && _d("EXPLAIN failed:", $query, $EVAL_ERROR); } return $explain ? $explain : "# EXPLAIN failed: $EVAL_ERROR"; } @@ -7226,7 +7226,7 @@ sub explain_sparkline { return unless $dbh && $ex; if ( $db ) { - MKDEBUG && _d($dbh, "USE", $db); + PTDEBUG && _d($dbh, "USE", $db); $dbh->do("USE " . $q->quote($db)); } my $res = $ex->normalize( @@ -7272,7 +7272,7 @@ package EventTimeline; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(parse_timestamp secs_to_time unix_timestamp)); @@ -7329,7 +7329,7 @@ sub make_handler { my $type = $val =~ m/^(?:\d+|$float_re)$/o ? 'num' : $val =~ m/^(?:Yes|No)$/ ? 'bool' : 'string'; - MKDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); + PTDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); $self->{type_for}->{$attrib} = $type; push @lines, ( @@ -7383,7 +7383,7 @@ sub make_handler { my $code = join("\n", @lines); $self->{code} = $code; - MKDEBUG && _d('Timeline handler:', $code); + PTDEBUG && _d('Timeline handler:', $code); my $sub = eval $code; die if $EVAL_ERROR; return $sub; @@ -7444,7 +7444,7 @@ package QueryParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $tbl_ident = qr/(?:`[^`]+`|\w+)(?:\.(?:`[^`]+`|\w+))?/; our $tbl_regex = qr{ @@ -7472,33 +7472,33 @@ sub new { sub get_tables { my ( $self, $query ) = @_; return unless $query; - MKDEBUG && _d('Getting tables for', $query); + PTDEBUG && _d('Getting tables for', $query); my ( $ddl_stmt ) = $query =~ m/^\s*($data_def_stmts)\b/i; if ( $ddl_stmt ) { - MKDEBUG && _d('Special table type:', $ddl_stmt); + PTDEBUG && _d('Special table type:', $ddl_stmt); $query =~ s/IF\s+(?:NOT\s+)?EXISTS//i; if ( $query =~ m/$ddl_stmt DATABASE\b/i ) { - MKDEBUG && _d('Query alters a database, not a table'); + PTDEBUG && _d('Query alters a database, not a table'); return (); } if ( $ddl_stmt =~ m/CREATE/i && $query =~ m/$ddl_stmt\b.+?\bSELECT\b/i ) { my ($select) = $query =~ m/\b(SELECT\b.+)/is; - MKDEBUG && _d('CREATE TABLE ... SELECT:', $select); + PTDEBUG && _d('CREATE TABLE ... SELECT:', $select); return $self->get_tables($select); } my ($tbl) = $query =~ m/TABLE\s+($tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches table:', $tbl); + PTDEBUG && _d('Matches table:', $tbl); return ($tbl); } $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; if ( $query =~ /^\s*LOCK TABLES/i ) { - MKDEBUG && _d('Special table type: LOCK TABLES'); + PTDEBUG && _d('Special table type: LOCK TABLES'); $query =~ s/^(\s*LOCK TABLES\s+)//; $query =~ s/\s+(?:READ|WRITE|LOCAL)+\s*//g; - MKDEBUG && _d('Locked tables:', $query); + PTDEBUG && _d('Locked tables:', $query); $query = "FROM $query"; } @@ -7508,7 +7508,7 @@ sub get_tables { my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { - MKDEBUG && _d('Match tables:', $tbls); + PTDEBUG && _d('Match tables:', $tbls); next if $tbls =~ m/\ASELECT\b/i; @@ -7516,7 +7516,7 @@ sub get_tables { $tbl =~ s/\s*($tbl_ident)(\s+.*)?/$1/gio; if ( $tbl !~ m/[a-zA-Z]/ ) { - MKDEBUG && _d('Skipping suspicious table name:', $tbl); + PTDEBUG && _d('Skipping suspicious table name:', $tbl); next; } @@ -7529,7 +7529,7 @@ sub get_tables { sub has_derived_table { my ( $self, $query ) = @_; my $match = $query =~ m/$has_derived/; - MKDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); + PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); return $match; } @@ -7562,7 +7562,7 @@ sub get_aliases { $tbl_refs =~ s/\([^\)]+\)\s*//; } - MKDEBUG && _d('tbl refs:', $tbl_refs); + PTDEBUG && _d('tbl refs:', $tbl_refs); my $before_tbl = qr/(?:,|JOIN|\s|$from)+/i; @@ -7578,12 +7578,12 @@ sub get_aliases { }xgio ) { my ( $tbl_ref, $db_tbl, $alias ) = ($1, $2, $3); - MKDEBUG && _d('Match table:', $tbl_ref); + PTDEBUG && _d('Match table:', $tbl_ref); push @tbl_refs, $tbl_ref; $alias = $self->trim_identifier($alias); if ( $tbl_ref =~ m/^AS\s+\w+/i ) { - MKDEBUG && _d('Subquery', $tbl_ref); + PTDEBUG && _d('Subquery', $tbl_ref); $result->{TABLE}->{$alias} = undef; next; } @@ -7596,7 +7596,7 @@ sub get_aliases { } } else { - MKDEBUG && _d("No tables ref in", $query); + PTDEBUG && _d("No tables ref in", $query); } if ( $list ) { @@ -7611,7 +7611,7 @@ sub split { my ( $self, $query ) = @_; return unless $query; $query = $self->clean_query($query); - MKDEBUG && _d('Splitting', $query); + PTDEBUG && _d('Splitting', $query); my $verbs = qr{SELECT|INSERT|UPDATE|DELETE|REPLACE|UNION|CREATE}i; @@ -7631,7 +7631,7 @@ sub split { } } - MKDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); + PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); return @statements; } @@ -7657,12 +7657,12 @@ sub split_subquery { while ( $query =~ m/(\S+)(?:\s+|\Z)/g ) { $pos = pos($query); my $word = $1; - MKDEBUG && _d($word, $sqno); + PTDEBUG && _d($word, $sqno); if ( $word =~ m/^\(?SELECT\b/i ) { my $start_pos = $pos - length($word) - 1; if ( $start_pos ) { $sqno++; - MKDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); + PTDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); $subqueries[$sqno] = { start_pos => $start_pos, end_pos => 0, @@ -7674,25 +7674,25 @@ sub split_subquery { }; } else { - MKDEBUG && _d('Main SELECT at pos 0'); + PTDEBUG && _d('Main SELECT at pos 0'); } } else { next unless $sqno; # next unless we're in a subquery - MKDEBUG && _d('In subquery', $sqno); + PTDEBUG && _d('In subquery', $sqno); my $sq = $subqueries[$sqno]; if ( $sq->{done} ) { - MKDEBUG && _d('This subquery is done; SQL is for', + PTDEBUG && _d('This subquery is done; SQL is for', ($sqno - 1 ? "subquery $sqno" : "the main SELECT")); next; } push @{$sq->{words}}, $word; my $lp = ($word =~ tr/\(//) || 0; my $rp = ($word =~ tr/\)//) || 0; - MKDEBUG && _d('parentheses left', $lp, 'right', $rp); + PTDEBUG && _d('parentheses left', $lp, 'right', $rp); if ( ($sq->{lp} + $lp) - ($sq->{rp} + $rp) == 0 ) { my $end_pos = $pos - 1; - MKDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); + PTDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); $sq->{end_pos} = $end_pos; $sq->{len} = $end_pos - $sq->{start_pos}; } @@ -7758,7 +7758,7 @@ sub get_columns { ($cols_def) = $query =~ m/\(([^\)]+)\)\s*VALUE/i; } - MKDEBUG && _d('Columns:', $cols_def); + PTDEBUG && _d('Columns:', $cols_def); if ( $cols_def ) { @$cols = split(',', $cols_def); map { @@ -7799,7 +7799,7 @@ sub extract_tables { my $default_db = $args{default_db}; my $q = $self->{Quoter} || $args{Quoter}; return unless $query; - MKDEBUG && _d('Extracting tables'); + PTDEBUG && _d('Extracting tables'); my @tables; my %seen; foreach my $db_tbl ( $self->get_tables($query) ) { @@ -7848,7 +7848,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -7942,11 +7942,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -7958,12 +7958,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -7973,15 +7973,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -7991,11 +7991,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -8016,7 +8016,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -8028,11 +8028,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -8045,7 +8045,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -8064,7 +8064,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -8082,7 +8082,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -8108,7 +8108,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -8153,7 +8153,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -8198,7 +8198,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -8259,7 +8259,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -8277,7 +8277,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -8286,25 +8286,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -8318,66 +8318,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -8393,7 +8393,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -8419,7 +8419,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -8441,7 +8441,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -8509,7 +8509,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -8519,7 +8519,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -8554,7 +8554,7 @@ package QueryReview; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(make_checksum parse_timestamp)); @@ -8590,7 +8590,7 @@ sub new { COALESCE(?, $now), GREATEST(last_seen, COALESCE(?, $now))) SQL - MKDEBUG && _d('SQL to insert into review table:', $sql); + PTDEBUG && _d('SQL to insert into review table:', $sql); my $insert_sth = $args{dbh}->prepare($sql); my @review_cols = grep { !$skip_cols{$_} } @{$args{tbl_struct}->{cols}}; @@ -8598,7 +8598,7 @@ sub new { . join(', ', map { $args{quoter}->quote($_) } @review_cols) . ", CONV(checksum, 10, 16) AS checksum_conv FROM $args{db_tbl}" . " WHERE checksum=CONV(?, 16, 10)"; - MKDEBUG && _d('SQL to select from review table:', $sql); + PTDEBUG && _d('SQL to select from review table:', $sql); my $select_sth = $args{dbh}->prepare($sql); my $self = { @@ -8647,7 +8647,7 @@ sub set_history_options { ? "COALESCE(?, $self->{ts_default})" : '?' } @cols) . ')'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $self->{history_sth} = $args{dbh}->prepare($sql); $self->{history_metrics} = \@metrics; @@ -8719,7 +8719,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -8737,17 +8737,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -8789,19 +8789,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -8819,7 +8819,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -8839,7 +8839,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -8852,7 +8852,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -8861,10 +8861,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -8911,7 +8911,7 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -8934,7 +8934,7 @@ sub parse_event { my $packet = @args{@required_args}; if ( $packet->{data_len} == 0 ) { - MKDEBUG && _d('No TCP data'); + PTDEBUG && _d('No TCP data'); $args{stats}->{no_tcp_data}++ if $args{stats}; return; } @@ -8945,7 +8945,7 @@ sub parse_event { if ( my $server = $self->{server} ) { # Watch only the given server. $server .= ":$self->{port}"; if ( $src_host ne $server && $dst_host ne $server ) { - MKDEBUG && _d('Packet is not to or from', $server); + PTDEBUG && _d('Packet is not to or from', $server); $args{stats}->{not_watched_server}++ if $args{stats}; return; } @@ -8965,10 +8965,10 @@ sub parse_event { warn 'Packet is not to or from memcached server: ', Dumper($packet); return; } - MKDEBUG && _d('Client:', $client); + PTDEBUG && _d('Client:', $client); if ( !exists $self->{sessions}->{$client} ) { - MKDEBUG && _d('New session'); + PTDEBUG && _d('New session'); $self->{sessions}->{$client} = { client => $client, state => undef, @@ -8992,7 +8992,7 @@ sub parse_event { die 'Packet origin unknown'; } - MKDEBUG && _d('Done with packet; event:', Dumper($event)); + PTDEBUG && _d('Done with packet; event:', Dumper($event)); $args{stats}->{events_parsed}++ if $args{stats}; return $event; } @@ -9002,18 +9002,18 @@ sub _packet_from_server { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from server; client state:', $session->{state}); + PTDEBUG && _d('Packet is from server; client state:', $session->{state}); my $data = $packet->{data}; if ( !$session->{state} ) { - MKDEBUG && _d('Ignoring mid-stream server response'); + PTDEBUG && _d('Ignoring mid-stream server response'); $args{stats}->{ignored_midstream_server_response}++ if $args{stats}; return; } if ( $session->{state} eq 'awaiting reply' ) { - MKDEBUG && _d('State is awaiting reply'); + PTDEBUG && _d('State is awaiting reply'); my ($line1, $rest) = $packet->{data} =~ m/\A(.*?)\r\n(.*)?/s; if ( !$line1 ) { $args{stats}->{unknown_server_data}++ if $args{stats}; @@ -9022,30 +9022,30 @@ sub _packet_from_server { my @vals = $line1 =~ m/(\S+)/g; $session->{res} = shift @vals; - MKDEBUG && _d('Result of last', $session->{cmd}, 'cmd:', $session->{res}); + PTDEBUG && _d('Result of last', $session->{cmd}, 'cmd:', $session->{res}); if ( $session->{cmd} eq 'incr' || $session->{cmd} eq 'decr' ) { - MKDEBUG && _d('It is an incr or decr'); + PTDEBUG && _d('It is an incr or decr'); if ( $session->{res} !~ m/\D/ ) { # It's an integer, not an error - MKDEBUG && _d('Got a value for the incr/decr'); + PTDEBUG && _d('Got a value for the incr/decr'); $session->{val} = $session->{res}; $session->{res} = ''; } } elsif ( $session->{res} eq 'VALUE' ) { - MKDEBUG && _d('It is the result of a "get"'); + PTDEBUG && _d('It is the result of a "get"'); my ($key, $flags, $bytes) = @vals; defined $session->{flags} or $session->{flags} = $flags; defined $session->{bytes} or $session->{bytes} = $bytes; if ( $rest && $bytes ) { - MKDEBUG && _d('There is a value'); + PTDEBUG && _d('There is a value'); if ( length($rest) > $bytes ) { - MKDEBUG && _d('Got complete response'); + PTDEBUG && _d('Got complete response'); $session->{val} = substr($rest, 0, $bytes); } else { - MKDEBUG && _d('Got partial response, saving for later'); + PTDEBUG && _d('Got partial response, saving for later'); push @{$session->{partial}}, [ $packet->{seq}, $rest ]; $session->{gathered} += length($rest); $session->{state} = 'partial recv'; @@ -9054,24 +9054,24 @@ sub _packet_from_server { } } elsif ( $session->{res} eq 'END' ) { - MKDEBUG && _d('Got an END without any data, firing NOT_FOUND'); + PTDEBUG && _d('Got an END without any data, firing NOT_FOUND'); $session->{res} = 'NOT_FOUND'; } elsif ( $session->{res} !~ m/STORED|DELETED|NOT_FOUND/ ) { - MKDEBUG && _d('Unknown result'); + PTDEBUG && _d('Unknown result'); } else { $args{stats}->{unknown_server_response}++ if $args{stats}; } } else { # Should be 'partial recv' - MKDEBUG && _d('Session state: ', $session->{state}); + PTDEBUG && _d('Session state: ', $session->{state}); push @{$session->{partial}}, [ $packet->{seq}, $data ]; $session->{gathered} += length($data); - MKDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', + PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', scalar(@{$session->{partial}}), 'packets from server'); if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. - MKDEBUG && _d('End of partial response, preparing event'); + PTDEBUG && _d('End of partial response, preparing event'); my $val = join('', map { $_->[1] } sort { $a->[0] <=> $b->[0] } @@ -9079,12 +9079,12 @@ sub _packet_from_server { $session->{val} = substr($val, 0, $session->{bytes}); } else { - MKDEBUG && _d('Partial response continues, no action'); + PTDEBUG && _d('Partial response continues, no action'); return; # Prevent firing event. } } - MKDEBUG && _d('Creating event, deleting session'); + PTDEBUG && _d('Creating event, deleting session'); my $event = make_event($session, $packet); delete $self->{sessions}->{$session->{client}}; # memcached is stateless! $session->{raw_packets} = []; # Avoid keeping forever @@ -9096,11 +9096,11 @@ sub _packet_from_client { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from client; state:', $session->{state}); + PTDEBUG && _d('Packet is from client; state:', $session->{state}); my $event; if ( ($session->{state} || '') =~m/awaiting reply|partial recv/ ) { - MKDEBUG && _d("Expected data from the client, looks like interrupted"); + PTDEBUG && _d("Expected data from the client, looks like interrupted"); $session->{res} = 'INTERRUPTED'; $event = make_event($session, $packet); my $client = $session->{client}; @@ -9112,17 +9112,17 @@ sub _packet_from_client { my ($cmd, $key, $flags, $exptime, $bytes); if ( !$session->{state} ) { - MKDEBUG && _d('Session state: ', $session->{state}); + PTDEBUG && _d('Session state: ', $session->{state}); ($line1, $val) = $packet->{data} =~ m/\A(.*?)\r\n(.+)?/s; if ( !$line1 ) { - MKDEBUG && _d('Unknown memcached data from client, skipping packet'); + PTDEBUG && _d('Unknown memcached data from client, skipping packet'); $args{stats}->{unknown_client_data}++ if $args{stats}; return; } my @vals = $line1 =~ m/(\S+)/g; $cmd = lc shift @vals; - MKDEBUG && _d('$cmd is a ', $cmd); + PTDEBUG && _d('$cmd is a ', $cmd); if ( $cmd eq 'set' || $cmd eq 'add' || $cmd eq 'replace' ) { ($key, $flags, $exptime, $bytes) = @vals; $session->{bytes} = $bytes; @@ -9130,14 +9130,14 @@ sub _packet_from_client { elsif ( $cmd eq 'get' ) { ($key) = @vals; if ( $val ) { - MKDEBUG && _d('Multiple cmds:', $val); + PTDEBUG && _d('Multiple cmds:', $val); $val = undef; } } elsif ( $cmd eq 'delete' ) { ($key) = @vals; # TODO: handle the if ( $val ) { - MKDEBUG && _d('Multiple cmds:', $val); + PTDEBUG && _d('Multiple cmds:', $val); $val = undef; } } @@ -9145,7 +9145,7 @@ sub _packet_from_client { ($key) = @vals; } else { - MKDEBUG && _d("Don't know how to handle", $cmd, "command"); + PTDEBUG && _d("Don't know how to handle", $cmd, "command"); $args{stats}->{unknown_client_command}++ if $args{stats}; return; } @@ -9157,26 +9157,26 @@ sub _packet_from_client { $session->{ts} = $packet->{ts}; } else { - MKDEBUG && _d('Session state: ', $session->{state}); + PTDEBUG && _d('Session state: ', $session->{state}); $val = $packet->{data}; } $session->{state} = 'awaiting reply'; # Assume we got the whole packet if ( $val ) { if ( $session->{bytes} + 2 == length($val) ) { # +2 for the \r\n - MKDEBUG && _d('Complete send'); + PTDEBUG && _d('Complete send'); $val =~ s/\r\n\Z//; # We got the whole thing. $session->{val} = $val; } else { # We apparently did NOT get the whole thing. - MKDEBUG && _d('Partial send, saving for later'); + PTDEBUG && _d('Partial send, saving for later'); push @{$session->{partial}}, [ $packet->{seq}, $val ]; $session->{gathered} += length($val); - MKDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', + PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', scalar(@{$session->{partial}}), 'packets from client'); if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. - MKDEBUG && _d('Message looks complete now, saving value'); + PTDEBUG && _d('Message looks complete now, saving value'); $val = join('', map { $_->[1] } sort { $a->[0] <=> $b->[0] } @@ -9185,7 +9185,7 @@ sub _packet_from_client { $session->{val} = $val; } else { - MKDEBUG && _d('Message not complete'); + PTDEBUG && _d('Message not complete'); $val = '[INCOMPLETE]'; $session->{state} = 'partial send'; } @@ -9221,7 +9221,7 @@ sub _get_errors_fh { my $o = $self->{o}; if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) { my $errors_file = $o->get('tcpdump-errors'); - MKDEBUG && _d('tcpdump-errors file:', $errors_file); + PTDEBUG && _d('tcpdump-errors file:', $errors_file); open $errors_fh, '>>', $errors_file or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR"; } @@ -9274,7 +9274,7 @@ package MemcachedEvent; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -9318,12 +9318,12 @@ sub parse_event { return unless $event; if ( !$event->{cmd} || !$event->{key} ) { - MKDEBUG && _d('Event has no cmd or key:', Dumper($event)); + PTDEBUG && _d('Event has no cmd or key:', Dumper($event)); return; } if ( !$cmds{$event->{cmd}} ) { - MKDEBUG && _d("Don't know how to handle cmd:", $event->{cmd}); + PTDEBUG && _d("Don't know how to handle cmd:", $event->{cmd}); return; } @@ -9339,7 +9339,7 @@ sub parse_event { $event->{Memc_miss} = 'Yes' if $event->{res} eq 'NOT_FOUND'; } else { - MKDEBUG && _d('Event has no res:', Dumper($event)); + PTDEBUG && _d('Event has no res:', Dumper($event)); } if ( $cmd_handler_for{$event->{cmd}} ) { @@ -9359,7 +9359,7 @@ sub handle_storage_cmd { my ( $event ) = @_; if ( !$event->{res} ) { - MKDEBUG && _d('No result for event:', Dumper($event)); + PTDEBUG && _d('No result for event:', Dumper($event)); return; } @@ -9373,7 +9373,7 @@ sub handle_retr_cmd { my ( $event ) = @_; if ( !$event->{res} ) { - MKDEBUG && _d('No result for event:', Dumper($event)); + PTDEBUG && _d('No result for event:', Dumper($event)); return; } @@ -9421,7 +9421,7 @@ package BinaryLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -9471,10 +9471,10 @@ sub parse_event { $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. $line =~ s/$delim// if $delim; - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ( $line =~ m/^\/\*.+\*\/;/ ) { - MKDEBUG && _d('Comment line'); + PTDEBUG && _d('Comment line'); next LINE; } @@ -9483,10 +9483,10 @@ sub parse_event { if ( $del ) { $self->{delim_len} = $delim_len = length $del; $self->{delim} = $delim = quotemeta $del; - MKDEBUG && _d('delimiter:', $delim); + PTDEBUG && _d('delimiter:', $delim); } else { - MKDEBUG && _d('Delimiter reset to ;'); + PTDEBUG && _d('Delimiter reset to ;'); $self->{delim} = $delim = undef; $self->{delim_len} = $delim_len = 0; } @@ -9496,14 +9496,14 @@ sub parse_event { next LINE if $line =~ m/End of log file/; if ( !$got_offset && (my ( $offset ) = $line =~ m/$binlog_line_1/m) ) { - MKDEBUG && _d('Got the at offset line'); + PTDEBUG && _d('Got the at offset line'); push @properties, 'offset', $offset; $got_offset++; } elsif ( !$got_hdr && $line =~ m/^#(\d{6}\s+\d{1,2}:\d\d:\d\d)/ ) { ($ts, $sid, $end, $type, $rest) = $line =~ m/$binlog_line_2/m; - MKDEBUG && _d('Got the header line; type:', $type, 'rest:', $rest); + PTDEBUG && _d('Got the header line; type:', $type, 'rest:', $rest); push @properties, 'cmd', 'Query', 'ts', $ts, 'server_id', $sid, 'end_log_pos', $end; $got_hdr++; @@ -9512,18 +9512,18 @@ sub parse_event { elsif ( $line =~ m/^(?:#|use |SET)/i ) { if ( my ( $db ) = $line =~ m/^use ([^;]+)/ ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; } elsif ( my ($setting) = $line =~ m/^SET\s+([^;]*)/ ) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, map { s/\s+//; lc } split(/,|\s*=\s*/, $setting); } } else { - MKDEBUG && _d("Got the query/arg line at pos", $pos); + PTDEBUG && _d("Got the query/arg line at pos", $pos); $found_arg++; if ( $got_offset && $got_hdr ) { if ( $type eq 'Xid' ) { @@ -9536,15 +9536,15 @@ sub parse_event { 'error_code', $c; } elsif ( $type eq 'Start:' ) { - MKDEBUG && _d("Binlog start"); + PTDEBUG && _d("Binlog start"); } else { - MKDEBUG && _d('Unknown event type:', $type); + PTDEBUG && _d('Unknown event type:', $type); next EVENT; } } else { - MKDEBUG && _d("It's not a query/arg, it's just some SQL fluff"); + PTDEBUG && _d("It's not a query/arg, it's just some SQL fluff"); push @properties, 'cmd', 'Query', 'ts', undef; } @@ -9558,10 +9558,10 @@ sub parse_event { if ( $del ) { $self->{delim_len} = $delim_len = length $del; $self->{delim} = $delim = quotemeta $del; - MKDEBUG && _d('delimiter:', $delim); + PTDEBUG && _d('delimiter:', $delim); } else { - MKDEBUG && _d('Delimiter reset to ;'); + PTDEBUG && _d('Delimiter reset to ;'); $del = ';'; $self->{delim} = $delim = undef; $self->{delim_len} = $delim_len = 0; @@ -9579,7 +9579,7 @@ sub parse_event { } # LINE if ( $found_arg ) { - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -9588,7 +9588,7 @@ sub parse_event { return $event; } else { - MKDEBUG && _d('Event had no arg'); + PTDEBUG && _d('Event had no arg'); } } # EVENT @@ -9624,7 +9624,7 @@ package GeneralLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -9669,10 +9669,10 @@ sub parse_event { defined($line = shift @$pending) or defined($line = $next_event->()) ) { - MKDEBUG && _d($line); + PTDEBUG && _d($line); my ($ts, $thread_id, $cmd, $arg) = $line =~ m/$genlog_line_1/; if ( !($thread_id && $cmd) ) { - MKDEBUG && _d('Not start of general log event'); + PTDEBUG && _d('Not start of general log event'); next; } my @properties = ('pos_in_log', $pos_in_log, 'ts', $ts, @@ -9689,17 +9689,17 @@ sub parse_event { my (undef, $next_thread_id, $next_cmd) = $line =~ m/$genlog_line_1/; if ( $next_thread_id && $next_cmd ) { - MKDEBUG && _d('Event done'); + PTDEBUG && _d('Event done'); $done = 1; push @$pending, $line; } else { - MKDEBUG && _d('More arg:', $line); + PTDEBUG && _d('More arg:', $line); $arg .= $line; } } else { - MKDEBUG && _d('No more lines'); + PTDEBUG && _d('No more lines'); $done = 1; } } until ( $done ); @@ -9720,7 +9720,7 @@ sub parse_event { my ($user, undef, $db) = $arg =~ /(\S+)/g; my $host; ($user, $host) = split(/@/, $user); - MKDEBUG && _d('Connect', $user, '@', $host, 'on', $db); + PTDEBUG && _d('Connect', $user, '@', $host, 'on', $db); push @properties, 'user', $user if $user; push @properties, 'host', $host if $host; @@ -9732,7 +9732,7 @@ sub parse_event { $cmd = 'Init DB'; $arg =~ s/^DB\s+//; my ($db) = $arg =~ /(\S+)/; - MKDEBUG && _d('Init DB:', $db); + PTDEBUG && _d('Init DB:', $db); push @properties, 'db', $db if $db; $db_for->{$thread_id} = $db; } @@ -9743,7 +9743,7 @@ sub parse_event { push @properties, 'Query_time', 0; - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -9785,7 +9785,7 @@ package ProtocolParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; eval { require IO::Uncompress::Inflate; @@ -9823,11 +9823,11 @@ sub parse_event { if ( $packet->{data_len} ) { if ( $packet_from eq 'client' ) { push @{$session->{client_packets}}, $packet; - MKDEBUG && _d('Saved client packet'); + PTDEBUG && _d('Saved client packet'); } else { push @{$session->{server_packets}}, $packet; - MKDEBUG && _d('Saved server packet'); + PTDEBUG && _d('Saved server packet'); } } @@ -9851,7 +9851,7 @@ sub parse_event { } if ( $packet->{data_len} == 0 ) { - MKDEBUG && _d('No TCP data'); + PTDEBUG && _d('No TCP data'); return; } @@ -9864,7 +9864,7 @@ sub _parse_packet { my ( $self, $packet, $misc ) = @_; my ($packet_from, $session) = $self->_get_session($packet); - MKDEBUG && _d('State:', $session->{state}); + PTDEBUG && _d('State:', $session->{state}); push @{$session->{raw_packets}}, $packet->{raw_packet} unless $misc->{recurse}; @@ -9872,12 +9872,12 @@ sub _parse_packet { if ( $session->{buff} ) { $session->{buff_left} -= $packet->{data_len}; if ( $session->{buff_left} > 0 ) { - MKDEBUG && _d('Added data to buff; expecting', $session->{buff_left}, + PTDEBUG && _d('Added data to buff; expecting', $session->{buff_left}, 'more bytes'); return; } - MKDEBUG && _d('Got all data; buff left:', $session->{buff_left}); + PTDEBUG && _d('Got all data; buff left:', $session->{buff_left}); $packet->{data} = $session->{buff} . $packet->{data}; $packet->{data_len} += length $session->{buff}; $session->{buff} = ''; @@ -9895,17 +9895,17 @@ sub _parse_packet { else { die 'Packet origin unknown'; } - MKDEBUG && _d('State:', $session->{state}); + PTDEBUG && _d('State:', $session->{state}); if ( $session->{out_of_order} ) { - MKDEBUG && _d('Session packets are out of order'); + PTDEBUG && _d('Session packets are out of order'); push @{$session->{packets}}, $packet; $session->{ts_min} = $packet->{ts} if $packet->{ts} lt ($session->{ts_min} || ''); $session->{ts_max} = $packet->{ts} if $packet->{ts} gt ($session->{ts_max} || ''); if ( $session->{have_all_packets} ) { - MKDEBUG && _d('Have all packets; ordering and processing'); + PTDEBUG && _d('Have all packets; ordering and processing'); delete $session->{out_of_order}; delete $session->{have_all_packets}; map { @@ -9914,7 +9914,7 @@ sub _parse_packet { } } - MKDEBUG && _d('Done with packet; event:', Dumper($event)); + PTDEBUG && _d('Done with packet; event:', Dumper($event)); return $event; } @@ -9927,7 +9927,7 @@ sub _get_session { if ( my $server = $self->{server} ) { # Watch only the given server. $server .= ":$self->{port}"; if ( $src_host ne $server && $dst_host ne $server ) { - MKDEBUG && _d('Packet is not to or from', $server); + PTDEBUG && _d('Packet is not to or from', $server); return; } } @@ -9946,10 +9946,10 @@ sub _get_session { warn 'Packet is not to or from server: ', Dumper($packet); return; } - MKDEBUG && _d('Client:', $client); + PTDEBUG && _d('Client:', $client); if ( !exists $self->{sessions}->{$client} ) { - MKDEBUG && _d('New session'); + PTDEBUG && _d('New session'); $self->{sessions}->{$client} = { client => $client, state => undef, @@ -9976,7 +9976,7 @@ sub make_event { my $start_request = $session->{start_request} || 0; my $start_reply = $session->{start_reply} || 0; my $end_reply = $session->{end_reply} || 0; - MKDEBUG && _d('Request start:', $start_request, + PTDEBUG && _d('Request start:', $start_request, 'reply start:', $start_reply, 'reply end:', $end_reply); my $event = { Query_time => $self->timestamp_diff($start_request, $start_reply), @@ -9994,7 +9994,7 @@ sub _get_errors_fh { my $o = $self->{o}; if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) { my $errors_file = $o->get('tcpdump-errors'); - MKDEBUG && _d('tcpdump-errors file:', $errors_file); + PTDEBUG && _d('tcpdump-errors file:', $errors_file); open $errors_fh, '>>', $errors_file or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR"; } @@ -10018,7 +10018,7 @@ sub fail_session { print $errors_fh "\n"; } } - MKDEBUG && _d('Failed session', $session->{client}, 'because', $reason); + PTDEBUG && _d('Failed session', $session->{client}, 'because', $reason); delete $self->{sessions}->{$session->{client}}; return; } @@ -10045,7 +10045,7 @@ sub uncompress_data { die "I need data" unless $data; die "I need a len argument" unless $len; die "I need a scalar reference to data" unless ref $data eq 'SCALAR'; - MKDEBUG && _d('Uncompressing data'); + PTDEBUG && _d('Uncompressing data'); our $InflateError; my $comp_bin_data = pack('H*', $$data); @@ -10091,7 +10091,7 @@ use base 'ProtocolParser'; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -10107,10 +10107,10 @@ sub _packet_from_server { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from server; client state:', $session->{state}); + PTDEBUG && _d('Packet is from server; client state:', $session->{state}); if ( !$session->{state} ) { - MKDEBUG && _d('Ignoring mid-stream server response'); + PTDEBUG && _d('Ignoring mid-stream server response'); return; } @@ -10123,7 +10123,7 @@ sub _packet_from_server { if ( $line1 ) { $session->{have_header} = 1; $packet->{content_len} = length $content; - MKDEBUG && _d('Got out of order header with', + PTDEBUG && _d('Got out of order header with', $packet->{content_len}, 'bytes of content'); } my $have_len = $packet->{content_len} || $packet->{data_len}; @@ -10132,7 +10132,7 @@ sub _packet_from_server { $session->{have_all_packets} = 1 if $session->{attribs}->{bytes} && $have_len >= $session->{attribs}->{bytes}; - MKDEBUG && _d('Have', $have_len, 'of', $session->{attribs}->{bytes}); + PTDEBUG && _d('Have', $have_len, 'of', $session->{attribs}->{bytes}); return; } @@ -10151,17 +10151,17 @@ sub _packet_from_server { my ($version, $code, $phrase) = $line1 =~ m/(\S+)/g; $session->{attribs}->{Status_code} = $code; - MKDEBUG && _d('Status code for last', $session->{attribs}->{arg}, + PTDEBUG && _d('Status code for last', $session->{attribs}->{arg}, 'request:', $session->{attribs}->{Status_code}); my $content_len = $content ? length $content : 0; - MKDEBUG && _d('Got', $content_len, 'bytes of content'); + PTDEBUG && _d('Got', $content_len, 'bytes of content'); if ( $session->{attribs}->{bytes} && $content_len < $session->{attribs}->{bytes} ) { $session->{data_len} = $session->{attribs}->{bytes}; $session->{buff} = $content; $session->{buff_left} = $session->{attribs}->{bytes} - $content_len; - MKDEBUG && _d('Contents not complete,', $session->{buff_left}, + PTDEBUG && _d('Contents not complete,', $session->{buff_left}, 'bytes left'); $session->{state} = 'recving content'; return; @@ -10169,18 +10169,18 @@ sub _packet_from_server { } elsif ( $session->{state} eq 'recving content' ) { if ( $session->{buff} ) { - MKDEBUG && _d('Receiving content,', $session->{buff_left}, + PTDEBUG && _d('Receiving content,', $session->{buff_left}, 'bytes left'); return; } - MKDEBUG && _d('Contents received'); + PTDEBUG && _d('Contents received'); } else { warn "Server response in unknown state"; return; } - MKDEBUG && _d('Creating event, deleting session'); + PTDEBUG && _d('Creating event, deleting session'); $session->{end_reply} = $session->{ts_max} || $packet->{ts}; my $event = $self->make_event($session, $packet); delete $self->{sessions}->{$session->{client}}; # http is stateless! @@ -10192,11 +10192,11 @@ sub _packet_from_client { die "I need a packet" unless $packet; die "I need a session" unless $session; - MKDEBUG && _d('Packet is from client; state:', $session->{state}); + PTDEBUG && _d('Packet is from client; state:', $session->{state}); my $event; if ( ($session->{state} || '') =~ m/awaiting / ) { - MKDEBUG && _d('More client headers:', $packet->{data}); + PTDEBUG && _d('More client headers:', $packet->{data}); return; } @@ -10205,19 +10205,19 @@ sub _packet_from_client { my ($line1, undef) = $self->_parse_header($session, $packet->{data}, $packet->{data_len}); my ($request, $page, $version) = $line1 =~ m/(\S+)/g; if ( !$request || !$page ) { - MKDEBUG && _d("Didn't get a request or page:", $request, $page); + PTDEBUG && _d("Didn't get a request or page:", $request, $page); return; } $request = lc $request; my $vh = $session->{attribs}->{Virtual_host} || ''; my $arg = "$request $vh$page"; - MKDEBUG && _d('arg:', $arg); + PTDEBUG && _d('arg:', $arg); if ( $request eq 'get' || $request eq 'post' ) { @{$session->{attribs}}{qw(arg)} = ($arg); } else { - MKDEBUG && _d("Don't know how to handle a", $request, "request"); + PTDEBUG && _d("Don't know how to handle a", $request, "request"); return; } @@ -10238,28 +10238,28 @@ sub _parse_header { die "I need data" unless $data; my ($header, $content) = split(/\r\n\r\n/, $data); my ($line1, $header_vals) = $header =~ m/\A(\S+ \S+ .+?)\r\n(.+)?/s; - MKDEBUG && _d('HTTP header:', $line1); + PTDEBUG && _d('HTTP header:', $line1); return unless $line1; if ( !$header_vals ) { - MKDEBUG && _d('No header vals'); + PTDEBUG && _d('No header vals'); return $line1, undef; } my @headers; foreach my $val ( split(/\r\n/, $header_vals) ) { last unless $val; - MKDEBUG && _d('HTTP header:', $val); + PTDEBUG && _d('HTTP header:', $val); if ( $val =~ m/^Content-Length/i ) { ($session->{attribs}->{bytes}) = $val =~ /: (\d+)/; - MKDEBUG && _d('Saved Content-Length:', $session->{attribs}->{bytes}); + PTDEBUG && _d('Saved Content-Length:', $session->{attribs}->{bytes}); } if ( $val =~ m/Content-Encoding/i ) { ($session->{compressed}) = $val =~ /: (\w+)/; - MKDEBUG && _d('Saved Content-Encoding:', $session->{compressed}); + PTDEBUG && _d('Saved Content-Encoding:', $session->{compressed}); } if ( $val =~ m/^Host/i ) { ($session->{attribs}->{Virtual_host}) = $val =~ /: (\S+)/; - MKDEBUG && _d('Saved Host:', ($session->{attribs}->{Virtual_host})); + PTDEBUG && _d('Saved Host:', ($session->{attribs}->{Virtual_host})); } } return $line1, $content; @@ -10293,7 +10293,7 @@ package ExecutionThrottler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(sum min max); use Time::HiRes qw(time); @@ -10331,7 +10331,7 @@ sub throttle { my $rate_avg = (sum(@{$self->{int_rates}}) || 0) / (scalar @{$self->{int_rates}} || 1); my $running_avg = $self->_save_rate_avg($rate_avg); - MKDEBUG && _d('Average rate for last interval:', $rate_avg); + PTDEBUG && _d('Average rate for last interval:', $rate_avg); if ( $args{stats} ) { $args{stats}->{throttle_checked_rate}++; @@ -10343,7 +10343,7 @@ sub throttle { if ( $rate_avg > $self->{rate_max} ) { $self->{skip_prob} += $self->{step}; $self->{skip_prob} = 1.0 if $self->{skip_prob} > 1.0; - MKDEBUG && _d('Rate max exceeded'); + PTDEBUG && _d('Rate max exceeded'); $args{stats}->{throttle_rate_max_exceeded}++ if $args{stats}; } else { @@ -10352,7 +10352,7 @@ sub throttle { $args{stats}->{throttle_rate_ok}++ if $args{stats}; } - MKDEBUG && _d('Skip probability:', $self->{skip_prob}); + PTDEBUG && _d('Skip probability:', $self->{skip_prob}); $self->{last_check} = $time; } else { @@ -10364,7 +10364,7 @@ sub throttle { $args{stats}->{throttle_rate_max} = max( ($args{stats}->{throttle_rate_max} || ()), $current_rate); } - MKDEBUG && _d('Current rate:', $current_rate); + PTDEBUG && _d('Current rate:', $current_rate); } if ( $args{event} ) { @@ -10430,7 +10430,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -10451,7 +10451,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -10460,15 +10460,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -10484,7 +10484,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -10502,23 +10502,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -10547,11 +10547,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -10580,7 +10580,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -10591,11 +10591,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -10610,7 +10610,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -10670,7 +10670,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -10679,7 +10679,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -10688,21 +10688,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -10723,17 +10723,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -10746,7 +10746,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -10755,13 +10755,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -10774,12 +10774,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -10791,7 +10791,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -10799,7 +10799,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -10807,7 +10807,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -10850,7 +10850,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -10912,12 +10912,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -10938,7 +10938,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -10948,14 +10948,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -10996,7 +10996,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -11045,7 +11045,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -11186,7 +11186,7 @@ package FileIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -11217,14 +11217,14 @@ sub get_file_itr { if ( !@filenames ) { push @final_filenames, '-'; - MKDEBUG && _d('Auto-adding "-" to the list of filenames'); + PTDEBUG && _d('Auto-adding "-" to the list of filenames'); } - MKDEBUG && _d('Final filenames:', @final_filenames); + PTDEBUG && _d('Final filenames:', @final_filenames); return sub { while ( @final_filenames ) { my $fn = shift @final_filenames; - MKDEBUG && _d('Filename:', $fn); + PTDEBUG && _d('Filename:', $fn); if ( $fn eq '-' ) { # Magical STDIN filename. return (*STDIN, undef, undef); } @@ -11265,7 +11265,7 @@ package ExplainAnalyzer; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -11291,14 +11291,14 @@ sub explain_query { my ($query, $dbh) = @args{qw(query dbh)}; $query = $self->{QueryRewriter}->convert_to_select($query); if ( $query !~ m/^\s*select/i ) { - MKDEBUG && _d("Cannot EXPLAIN non-SELECT query:", + PTDEBUG && _d("Cannot EXPLAIN non-SELECT query:", (length $query <= 100 ? $query : substr($query, 0, 100) . "...")); return; } my $sql = "EXPLAIN $query"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $explain = $dbh->selectall_arrayref($sql, { Slice => {} }); - MKDEBUG && _d("Result of EXPLAIN:", Dumper($explain)); + PTDEBUG && _d("Result of EXPLAIN:", Dumper($explain)); return $explain; } @@ -11366,7 +11366,7 @@ sub get_index_usage { }; } - MKDEBUG && _d("Index usage for", + PTDEBUG && _d("Index usage for", (length $query <= 100 ? $query : substr($query, 0, 100) . "..."), ":", Dumper(\@result)); return \@result; @@ -11381,7 +11381,7 @@ sub get_usage_for { { $usage = $self->{usage}->{$db}->{$checksum}; } - MKDEBUG && _d("Usage for", + PTDEBUG && _d("Usage for", (length $checksum <= 100 ? $checksum : substr($checksum, 0, 100) . "..."), "on", $db, ":", Dumper($usage)); return $usage; @@ -11409,7 +11409,7 @@ sub sparkline { die "I need a $arg argument" unless defined $args{$arg}; } my ($explain) = @args{@required_args}; - MKDEBUG && _d("Making sparkline for", Dumper($explain)); + PTDEBUG && _d("Making sparkline for", Dumper($explain)); my $access_code = { 'ALL' => 'a', @@ -11453,7 +11453,7 @@ sub sparkline { } } - MKDEBUG && _d("sparkline:", $sparkline); + PTDEBUG && _d("sparkline:", $sparkline); return $sparkline; } @@ -11485,7 +11485,7 @@ package Runtime; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -11513,12 +11513,12 @@ sub time_left { my ( $self, %args ) = @_; if ( $self->{stop} ) { - MKDEBUG && _d("No time left because stop was called"); + PTDEBUG && _d("No time left because stop was called"); return 0; } my $now = $self->{now}->(%args); - MKDEBUG && _d("Current time:", $now); + PTDEBUG && _d("Current time:", $now); if ( !defined $self->{start_time} ) { $self->{start_time} = $now; @@ -11531,11 +11531,11 @@ sub time_left { if ( !$self->{end_time} ) { $self->{end_time} = $now + $runtime; - MKDEBUG && _d("End time:", $self->{end_time}); + PTDEBUG && _d("End time:", $self->{end_time}); } $self->{time_left} = $self->{end_time} - $now; - MKDEBUG && _d("Time left:", $self->{time_left}); + PTDEBUG && _d("Time left:", $self->{time_left}); return $self->{time_left}; } @@ -11553,10 +11553,10 @@ sub time_elapsed { return 0 unless $start_time; my $now = $self->{now}->(%args); - MKDEBUG && _d("Current time:", $now); + PTDEBUG && _d("Current time:", $now); my $time_elapsed = $now - $start_time; - MKDEBUG && _d("Time elapsed:", $time_elapsed); + PTDEBUG && _d("Time elapsed:", $time_elapsed); if ( $time_elapsed < 0 ) { warn "Current time $now is earlier than start time $start_time"; } @@ -11569,7 +11569,7 @@ sub reset { $self->{end_time} = undef; $self->{time_left} = undef; $self->{stop} = 0; - MKDEBUG && _d("Reset runtime"); + PTDEBUG && _d("Reset runtime"); return; } @@ -11613,7 +11613,7 @@ package Pipeline; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -11659,7 +11659,7 @@ sub add { if ( $self->{instrument} ) { $self->{instrumentation}->{$name} = { time => 0, calls => 0 }; } - MKDEBUG && _d("Added pipeline process", $name); + PTDEBUG && _d("Added pipeline process", $name); return; } @@ -11684,7 +11684,7 @@ sub execute { my $stats = $args{stats}; # optional - MKDEBUG && _d("Pipeline starting at", time); + PTDEBUG && _d("Pipeline starting at", time); my $instrument = $self->{instrument}; my $processes = $self->{procs}; EVENT: @@ -11696,7 +11696,7 @@ sub execute { while ( $procno < scalar @{$self->{procs}} ) { my $call_start = $instrument ? time : 0; - MKDEBUG && _d("Pipeline process", $self->{names}->[$procno]); + PTDEBUG && _d("Pipeline process", $self->{names}->[$procno]); $output = $processes->[$procno]->($pipeline_data); if ( $instrument ) { @@ -11708,7 +11708,7 @@ sub execute { $self->{instrumentation}->{Pipeline}->{count}++; } if ( !$output ) { - MKDEBUG && _d("Pipeline restarting early after", + PTDEBUG && _d("Pipeline restarting early after", $self->{names}->[$procno]); if ( $stats ) { $stats->{"pipeline_restarted_after_" @@ -11727,7 +11727,7 @@ sub execute { } } - MKDEBUG && _d("Pipeline stopped at", time); + PTDEBUG && _d("Pipeline stopped at", time); return; } @@ -11785,7 +11785,7 @@ $OUTPUT_AUTOFLUSH = 1; Transformers->import(qw(shorten micro_t percentage_of ts make_checksum any_unix_timestamp parse_timestamp unix_timestamp crc32)); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use sigtrap 'handler', \&sig_int, 'normal-signals'; @@ -11944,7 +11944,7 @@ sub main { my $sql = $o->read_para_after( __FILE__, qr/MAGIC_create_review/); $sql =~ s/query_review/IF NOT EXISTS $db_tbl/; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $qv_dbh->do($sql); } @@ -11987,7 +11987,7 @@ sub main { my $sql = $o->read_para_after( __FILE__, qr/MAGIC_create_review_history/); $sql =~ s/query_review_history/IF NOT EXISTS $hdb_tbl/; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $qv_dbh2->do($sql); } @@ -12028,7 +12028,7 @@ sub main { # Re-set --select with its original values plus the history # table values. $o->set('select', [keys %select]); - MKDEBUG && _d("--select after parsing --review-history table:", + PTDEBUG && _d("--select after parsing --review-history table:", @{$o->get('select')}); } @@ -12065,7 +12065,7 @@ sub main { # Enable timings to instrument code for either of these two opts. # Else, don't instrument to avoid cost of measurement. my $instrument = $o->get('pipeline-profile') || $o->get('execute-throttle'); - MKDEBUG && _d('Instrument:', $instrument); + PTDEBUG && _d('Instrument:', $instrument); my $pipeline = new Pipeline( instrument => $instrument, @@ -12116,7 +12116,7 @@ sub main { } my ($fh, $filename, $filesize) = $next_file->(); if ( $fh ) { - MKDEBUG && _d('Reading', $filename); + PTDEBUG && _d('Reading', $filename); push @read_files, $filename || "STDIN"; # Create callback to read next event. Some inputs, like @@ -12146,7 +12146,7 @@ sub main { } } else { - MKDEBUG && _d("No more input"); + PTDEBUG && _d("No more input"); # This will cause terminator proc to terminate the pipeline. $args->{input_fh} = undef; $args->{more_events} = 0; @@ -12252,7 +12252,7 @@ sub main { # So host-name* requires a colon between it and a port. ($server, $port) = $watch_server =~ m/^((?:\d+\.\d+\.\d+\.\d+|[\w\.\-]+\w))(?:[\:\.](\S+))?/; - MKDEBUG && _d('Watch server', $server, 'port', $port); + PTDEBUG && _d('Watch server', $server, 'port', $port); } foreach my $module ( @$type ) { @@ -12285,7 +12285,7 @@ sub main { $args->{event} = $event; return $args; } - MKDEBUG && _d("No more events, input EOF"); + PTDEBUG && _d("No more events, input EOF"); return; # next input } # No input, let pipeline run so the last report is printed. @@ -12298,7 +12298,7 @@ sub main { if ( my $patterns = $o->get('embedded-attributes') ) { $misc->{embed} = qr/$patterns->[0]/o; $misc->{capture} = qr/$patterns->[1]/o; - MKDEBUG && _d('Patterns for embedded attributes:', $misc->{embed}, + PTDEBUG && _d('Patterns for embedded attributes:', $misc->{embed}, $misc->{capture}); } $pipeline_data->{misc} = $misc; @@ -12314,7 +12314,7 @@ sub main { my ( %args ) = @_; my $event = $args{event}; return unless $event && $event->{ts}; - MKDEBUG && _d("Log time:", $event->{ts}); + PTDEBUG && _d("Log time:", $event->{ts}); return unix_timestamp(parse_timestamp($event->{ts})); }; } @@ -12344,21 +12344,21 @@ sub main { = $args->{event}->{ts} =~ m/^$Transformers::mysql_ts$/ ) { my $rt = $o->get('run-time'); if ( $run_time_interval == 60 ) { - MKDEBUG && _d("Run-time interval in seconds"); + PTDEBUG && _d("Run-time interval in seconds"); my $this_minute = unix_timestamp(parse_timestamp( "$y$m$d $h:$i:00")); do { $this_minute += $rt } until $this_minute > $ts; $args->{next_ts_interval} = $this_minute; } elsif ( $run_time_interval == 3600 ) { - MKDEBUG && _d("Run-time interval in minutes"); + PTDEBUG && _d("Run-time interval in minutes"); my $this_hour = unix_timestamp(parse_timestamp( "$y$m$d $h:00:00")); do { $this_hour += $rt } until $this_hour > $ts; $args->{next_ts_interval} = $this_hour; } elsif ( $run_time_interval == 86400 ) { - MKDEBUG && _d("Run-time interval in days"); + PTDEBUG && _d("Run-time interval in days"); my $this_day = unix_timestamp(parse_timestamp( "$y$m$d 00:00:00")); $args->{next_ts_interval} = $this_day + $rt; @@ -12366,11 +12366,11 @@ sub main { else { die "Invalid run-time interval: $run_time_interval"; } - MKDEBUG && _d("First ts interval:", + PTDEBUG && _d("First ts interval:", $args->{next_ts_interval}); } else { - MKDEBUG && _d("Failed to parse MySQL ts:", + PTDEBUG && _d("Failed to parse MySQL ts:", $args->{event}->{ts}); } } @@ -12402,13 +12402,13 @@ sub main { $aux_dbh->{InactiveDestroy} = 1; # Don't die on fork(). } $aux_dbh ||= $qv_dbh || $qv_dbh2 || $ex_dbh || $ps_dbh || $ep_dbh; - MKDEBUG && _d('aux dbh:', $aux_dbh); + PTDEBUG && _d('aux dbh:', $aux_dbh); my $time_callback = sub { my ( $exp ) = @_; return unless $aux_dbh; my $sql = "SELECT UNIX_TIMESTAMP($exp)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $aux_dbh->selectall_arrayref($sql)->[0]->[0]; }; if ( $o->get('since') ) { @@ -12422,18 +12422,18 @@ sub main { my $event = $args->{event}; return $args unless $event; if ( $args->{past_since} ) { - MKDEBUG && _d('Already past --since'); + PTDEBUG && _d('Already past --since'); return $args; } if ( $event->{ts} ) { my $ts = any_unix_timestamp($event->{ts}, $time_callback); if ( ($ts || 0) >= $since ) { - MKDEBUG && _d('Event is at or past --since'); + PTDEBUG && _d('Event is at or past --since'); $args->{past_since} = 1; return $args; } } - MKDEBUG && _d('Event is before --since (or ts unknown)'); + PTDEBUG && _d('Event is before --since (or ts unknown)'); return; # next event }, ); @@ -12448,18 +12448,18 @@ sub main { my $event = $args->{event}; return $args unless $event; if ( $args->{at_until} ) { - MKDEBUG && _d('Already past --until'); + PTDEBUG && _d('Already past --until'); return; } if ( $event->{ts} ) { my $ts = any_unix_timestamp($event->{ts}, $time_callback); if ( ($ts || 0) >= $until ) { - MKDEBUG && _d('Event at or after --until'); + PTDEBUG && _d('Event at or after --until'); $args->{at_until} = 1; return; } } - MKDEBUG && _d('Event is before --until (or ts unknown)'); + PTDEBUG && _d('Event is before --until (or ts unknown)'); return $args; }, ); @@ -12475,7 +12475,7 @@ sub main { # Start the (next) iteration. if ( !$args->{iter_start} ) { my $iter_start = $args->{iter_start} = time; - MKDEBUG && _d('Iteration', $args->{iter}, + PTDEBUG && _d('Iteration', $args->{iter}, 'started at', ts($iter_start)); if ( $o->get('print-iterations') ) { @@ -12491,13 +12491,13 @@ sub main { my $time_left = $args->{time_left}; if ( !$args->{more_events} || defined $time_left && $time_left <= 0 ) { - MKDEBUG && _d("Runtime elapsed or no more events, reporting"); + PTDEBUG && _d("Runtime elapsed or no more events, reporting"); $report = 1; } elsif ( $run_time_mode eq 'interval' && $args->{next_ts_interval} && $args->{unix_ts} >= $args->{next_ts_interval} ) { - MKDEBUG && _d("Event is in the next interval, reporting"); + PTDEBUG && _d("Event is in the next interval, reporting"); # Get the next ts interval based on the current log ts. # Log ts can make big jumps, so just += $rt might not @@ -12512,7 +12512,7 @@ sub main { } if ( $report ) { - MKDEBUG && _d("Iteration", $args->{iter}, "stopped at",ts(time)); + PTDEBUG && _d("Iteration", $args->{iter}, "stopped at",ts(time)); # Get this before calling print_reports() because that sub # resets each ea and we may need this later for stats. @@ -12589,7 +12589,7 @@ sub main { # iter has finished. if ( my $max_iters = $o->get('iterations') ) { $args->{iters_left} = $max_iters - $args->{iter}; - MKDEBUG && _d($args->{iters_left}, "iterations left"); + PTDEBUG && _d($args->{iters_left}, "iterations left"); } # Next iteration. @@ -12620,7 +12620,7 @@ sub main { # The first sure-fire state that terminates the pipeline is # having no more input. if ( !$args->{input_fh} ) { - MKDEBUG && _d("No more input, terminating pipeline"); + PTDEBUG && _d("No more input, terminating pipeline"); # This shouldn't happen, but I want to know if it does. warn "There's an event in the pipeline but no current input: " @@ -12634,18 +12634,18 @@ sub main { # The second sure-first state is having no more iterations. my $iters_left = $args->{iters_left}; if ( defined $iters_left && $iters_left <= 0 ) { - MKDEBUG && _d("No more iterations, terminating pipeline"); + PTDEBUG && _d("No more iterations, terminating pipeline"); $oktorun = 0; # 2. terminate pipeline return; # 1. exit pipeline early } # There's time or iters left so keep running. if ( $args->{event} ) { - MKDEBUG && _d("Event in pipeline, continuing"); + PTDEBUG && _d("Event in pipeline, continuing"); return $args; } else { - MKDEBUG && _d("No event in pipeline, get next event"); + PTDEBUG && _d("No event in pipeline, get next event"); return; } }, @@ -12770,7 +12770,7 @@ sub main { my $group_by_val = $event->{arg}; return unless defined $group_by_val; $event->{distill} = $qr->distill($group_by_val, %distill_args); - MKDEBUG && !$event->{distill} && _d('Cannot distill', + PTDEBUG && !$event->{distill} && _d('Cannot distill', $event->{arg}); return $args; }, @@ -12799,7 +12799,7 @@ sub main { if ( $o->get('filter') ) { my $filter = $o->get('filter'); if ( -f $filter && -r $filter ) { - MKDEBUG && _d('Reading file', $filter, 'for --filter code'); + PTDEBUG && _d('Reading file', $filter, 'for --filter code'); open my $fh, "<", $filter or die "Cannot open $filter: $OS_ERROR"; $filter = do { local $/ = undef; <$fh> }; close $fh; @@ -12809,7 +12809,7 @@ sub main { } my $code = 'sub { my ( $args ) = @_; my $event = $args->{event}; ' . "$filter && return \$args; };"; - MKDEBUG && _d('--filter code:', $code); + PTDEBUG && _d('--filter code:', $code); my $sub = eval $code or die "Error compiling --filter code: $code\n$EVAL_ERROR"; @@ -12830,11 +12830,11 @@ sub main { my ( $args ) = @_; my $event = $args->{event}; if ( ++$seen{$event->{$group_by_val}} <= $num_samples ) { - MKDEBUG && _d("--sample permits event", + PTDEBUG && _d("--sample permits event", $event->{$group_by_val}); return $args; } - MKDEBUG && _d("--sample rejects event", $event->{$group_by_val}); + PTDEBUG && _d("--sample rejects event", $event->{$group_by_val}); return; }, ); @@ -12848,7 +12848,7 @@ sub main { my ($rate_max, $int, $step) = @{$o->get('execute-throttle')}; $step ||= 5; $step /= 100; # step specified as percent but $et expect 0.1=10%, etc. - MKDEBUG && _d('Execute throttle:', $rate_max, $int, $step); + PTDEBUG && _d('Execute throttle:', $rate_max, $int, $step); my $get_rate = sub { my $instrument = $pipeline->instrumentation; @@ -12898,7 +12898,7 @@ sub main { my $cur_time = time(); my $curdb; my $default_db = $o->get('execute')->{D}; - MKDEBUG && _d('Default db:', $default_db); + PTDEBUG && _d('Default db:', $default_db); $pipeline->add( name => 'execute', @@ -12907,7 +12907,7 @@ sub main { my $event = $args->{event}; $event->{Exec_orig_time} = $event->{Query_time}; if ( ($event->{Skip_exec} || '') eq 'Yes' ) { - MKDEBUG && _d('Not executing event because of ', + PTDEBUG && _d('Not executing event because of ', '--execute-throttle'); # Zero Query_time to 'Exec time' will show the real time # spent executing queries. @@ -12941,7 +12941,7 @@ sub main { } }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); $stats{execute_error}++; # Don't try to re-execute the statement. Just skip it. if ( $EVAL_ERROR =~ m/server has gone away/ ) { @@ -12980,7 +12980,7 @@ sub main { process => sub { my ( $args ) = @_; my $event = $args->{event}; - MKDEBUG && _d('callback: print'); + PTDEBUG && _d('callback: print'); $w->write(*STDOUT, $event); return $args; }, @@ -13064,7 +13064,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -13089,12 +13089,12 @@ sub main { if ( $EVAL_ERROR ) { warn "The pipeline caused an error: $EVAL_ERROR"; } - MKDEBUG && _d("Pipeline data:", Dumper($pipeline_data)); + PTDEBUG && _d("Pipeline data:", Dumper($pipeline_data)); # Disconnect all open $dbh's map { $dp->disconnect($_); - MKDEBUG && _d('Disconnected dbh', $_); + PTDEBUG && _d('Disconnected dbh', $_); } grep { $_ } ($qv_dbh, $qv_dbh2, $ex_dbh, $ps_dbh, $ep_dbh, $aux_dbh); @@ -13131,7 +13131,7 @@ sub print_reports { my ($orderby_attrib, $orderby_func) = split(/:/, $orderby[$i]); $orderby_attrib = check_orderby_attrib($orderby_attrib, $eas->[$i], $o); - MKDEBUG && _d('Doing reports for groupby', $groupby[$i], 'orderby', + PTDEBUG && _d('Doing reports for groupby', $groupby[$i], 'orderby', $orderby_attrib, $orderby_func); my ($worst, $other) = get_worst_queries( @@ -13266,18 +13266,18 @@ sub find_role { my $comment = $args{comment}; if ( !$dbh || !$dbh->ping ) { - MKDEBUG && _d('Getting a dbh from', $current, $comment); + PTDEBUG && _d('Getting a dbh from', $current, $comment); $dbh = $dp->get_dbh( $dp->get_cxn_params($o->get($current)), {AutoCommit => 1}); $dbh->{InactiveDestroy} = 1; # Don't die on fork(). } if ( $o->get('mirror') ) { my ( $is_read_only ) = $dbh->selectrow_array('SELECT @@global.read_only'); - MKDEBUG && _d("read_only on", $current, $comment, ':', + PTDEBUG && _d("read_only on", $current, $comment, ':', $is_read_only, '(want', $read_only, ')'); if ( $is_read_only != $read_only ) { $current = $current eq 'execute' ? 'processlist' : 'execute'; - MKDEBUG && _d("read_only wrong", $comment, "getting a dbh from", $current); + PTDEBUG && _d("read_only wrong", $comment, "getting a dbh from", $current); $dbh = $dp->get_dbh( $dp->get_cxn_params($o->get($current)), {AutoCommit => 1}); $dbh->{InactiveDestroy} = 1; # Don't die on fork(). @@ -13303,7 +13303,7 @@ sub make_alt_attrib { my ( $alt_attrib ) = @_; my @alts = split('\|', $alt_attrib); my $attrib = shift @alts; - MKDEBUG && _d('Primary attrib:', $attrib, 'aliases:', @alts); + PTDEBUG && _d('Primary attrib:', $attrib, 'aliases:', @alts); my @lines; push @lines, 'sub { my ( $args ) = @_; ', @@ -13319,7 +13319,7 @@ sub make_alt_attrib { . 'return $args; }'; } @alts), 'return $args; }'; - MKDEBUG && _d('attrib alias sub for', $attrib, ':', @lines); + PTDEBUG && _d('attrib alias sub for', $attrib, ':', @lines); my $sub = eval join("\n", @lines); die if $EVAL_ERROR; return $sub; @@ -13343,7 +13343,7 @@ sub check_orderby_attrib { ( $orderby_attrib, undef ) = split(/:/, $default_orderby); } - MKDEBUG && _d('orderby attrib:', $orderby_attrib); + PTDEBUG && _d('orderby attrib:', $orderby_attrib); return $orderby_attrib; } @@ -13372,7 +13372,7 @@ sub read_timeout { alarm 0; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Read error:', $EVAL_ERROR); + PTDEBUG && _d('Read error:', $EVAL_ERROR); die $EVAL_ERROR unless $EVAL_ERROR =~ m/read timeout/; $oktorun = 0; $res = undef; # res is a blank string after a timeout @@ -13394,7 +13394,7 @@ sub get_cxn { } my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), $args{opts}); - MKDEBUG && _d('Connected dbh', $dbh); + PTDEBUG && _d('Connected dbh', $dbh); return $dbh; } @@ -13443,7 +13443,7 @@ sub print_table_access_report { my ($ea, $worst, $qp, $qr, $o, $q) = @args{@required_args}; my %seen; - MKDEBUG && _d('Doing table access report'); + PTDEBUG && _d('Doing table access report'); foreach my $worst_info ( @$worst ) { my $item = $worst_info->[0]; @@ -13474,7 +13474,7 @@ sub print_table_access_report { } }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); warn "Cannot get table access for query $_"; } } @@ -13494,7 +13494,7 @@ sub update_query_review_tables { my $attribs = $ea->get_attributes(); - MKDEBUG && _d('Updating query review tables'); + PTDEBUG && _d('Updating query review tables'); foreach my $worst_info ( @$worst ) { my $item = $worst_info->[0]; @@ -13545,7 +13545,7 @@ sub verify_run_time { my ( %args ) = @_; my $run_mode = lc $args{run_mode}; my $run_time = defined $args{run_time} ? lc $args{run_time} : undef; - MKDEBUG && _d("Verifying run time mode", $run_mode, "and time", $run_time); + PTDEBUG && _d("Verifying run time mode", $run_mode, "and time", $run_time); die "Invalid --run-time-mode: $run_mode\n" unless $run_mode =~ m/clock|event|interval/; diff --git a/bin/pt-show-grants b/bin/pt-show-grants index 3bb1f3b8..9c0a8606 100755 --- a/bin/pt-show-grants +++ b/bin/pt-show-grants @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1070,7 +1070,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1088,7 +1088,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1097,10 +1097,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1112,23 +1112,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1159,7 +1159,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1209,7 +1209,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1254,7 +1254,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1264,21 +1264,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1290,15 +1290,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1316,7 +1316,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1342,7 +1342,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1403,7 +1403,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1421,17 +1421,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1473,19 +1473,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1503,7 +1503,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1523,7 +1523,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1536,7 +1536,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1545,10 +1545,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1587,7 +1587,7 @@ package pt_show_grants; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub main { @ARGV = @_; # set global ARGV for this package @@ -1623,14 +1623,14 @@ sub main { if ( my $users = $o->get('only') ) { my @users = map { my ( $user, $host ) = parse_user($_); - MKDEBUG && _d('Parsed only', $_, 'as user', $user, 'and host', $host); + PTDEBUG && _d('Parsed only', $_, 'as user', $user, 'and host', $host); { User => $user, Host => $host }; } grep { if ( $_ !~ /\@/ ) { # If the user does not have an @, then get all grants for # the user on all hosts (issue 551). - MKDEBUG && _d('Will get all grants for', $_, 'on all hosts'); + PTDEBUG && _d('Will get all grants for', $_, 'on all hosts'); push @all_hosts, $_; 0; } @@ -1645,7 +1645,7 @@ sub main { if ( my $users = $o->get('ignore') ) { my %users = map { my ( $user, $host ) = parse_user($_); - MKDEBUG && _d('Parsed ignore', $_, 'as user', $user, 'and host',$host); + PTDEBUG && _d('Parsed ignore', $_, 'as user', $user, 'and host',$host); my $user_host = "'$user'\@'$host'"; $user_host => 1; } @@ -1681,7 +1681,7 @@ sub main { my $where = join(' OR ', map { "User='$_'" } @all_hosts); my $sql = "SELECT DISTINCT User, Host FROM mysql.user WHERE $where " . "ORDER BY User, Host"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); push @$users, @{ $dbh->selectall_arrayref($sql, { Slice => {} }) }; } my $ignore_users = $o->get('ignore'); @@ -1691,11 +1691,11 @@ sub main { foreach my $u ( @$users ) { my $user_host = "'$u->{User}'\@'$u->{Host}'"; if ( $ignore_users && $ignore_users->{$user_host} ) { - MKDEBUG && _d('Ignoring user', $user_host); + PTDEBUG && _d('Ignoring user', $user_host); next USER; } else { - MKDEBUG && _d('Checking user', $user_host); + PTDEBUG && _d('Checking user', $user_host); } my @grants; @@ -1703,7 +1703,7 @@ sub main { @grants = @{ $dbh->selectcol_arrayref("SHOW GRANTS FOR $user_host") }; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); $exit_status = 1; } next unless @grants; @@ -1742,15 +1742,15 @@ sub main { if ( $o->get('revoke') ) { my @revoke = map { my $grant = $_; - MKDEBUG && _d($grant); + PTDEBUG && _d($grant); my ( $grants, $on_what, $user ) = $grant =~ m/GRANT (.*?) ON ((?:`|\*).*?) TO ('[^']*'\@'[^']+')?/; - MKDEBUG && _d('grants:', $grants, 'on_what:', $on_what, + PTDEBUG && _d('grants:', $grants, 'on_what:', $on_what, 'user:', $user); if ( !$user ) { # Anonymous user: ''@'' (issue 445). - MKDEBUG && _d('Anonymous user'); + PTDEBUG && _d('Anonymous user'); $user = "''\@''"; } diff --git a/bin/pt-slave-delay b/bin/pt-slave-delay index 37a6f797..d76d86b8 100755 --- a/bin/pt-slave-delay +++ b/bin/pt-slave-delay @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1057,7 +1057,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1068,7 +1068,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1086,7 +1086,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1098,7 +1098,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1130,7 +1130,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1153,7 +1153,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1171,7 +1171,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1180,10 +1180,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1195,23 +1195,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1242,7 +1242,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1292,7 +1292,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1337,7 +1337,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1347,21 +1347,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1373,15 +1373,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1399,7 +1399,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1425,7 +1425,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1486,7 +1486,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1504,17 +1504,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1556,19 +1556,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1586,7 +1586,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1606,7 +1606,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1619,7 +1619,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1628,10 +1628,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1672,7 +1672,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1852,36 +1852,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1928,7 +1928,7 @@ package Retry; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1949,35 +1949,35 @@ sub retry { my $tryno = 0; while ( ++$tryno <= $tries ) { - MKDEBUG && _d("Retry", $tryno, "of", $tries); + PTDEBUG && _d("Retry", $tryno, "of", $tries); my $result; eval { $result = $try->(tryno=>$tryno); }; if ( defined $result ) { - MKDEBUG && _d("Try code succeeded"); + PTDEBUG && _d("Try code succeeded"); if ( my $on_success = $args{on_success} ) { - MKDEBUG && _d("Calling on_success code"); + PTDEBUG && _d("Calling on_success code"); $on_success->(tryno=>$tryno, result=>$result); } return $result; } if ( $EVAL_ERROR ) { - MKDEBUG && _d("Try code died:", $EVAL_ERROR); + PTDEBUG && _d("Try code died:", $EVAL_ERROR); die $EVAL_ERROR unless $args{retry_on_die}; } if ( $tryno < $tries ) { - MKDEBUG && _d("Try code failed, calling wait code"); + PTDEBUG && _d("Try code failed, calling wait code"); $wait->(tryno=>$tryno); } } - MKDEBUG && _d("Try code did not succeed"); + PTDEBUG && _d("Try code did not succeed"); if ( my $on_failure = $args{on_failure} ) { - MKDEBUG && _d("Calling on_failure code"); + PTDEBUG && _d("Calling on_failure code"); $on_failure->(); } @@ -2014,7 +2014,7 @@ use sigtrap qw(handler finish untrapped normal-signals); Transformers->import(qw(ts)); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $now; my $o; @@ -2071,7 +2071,7 @@ sub main { my $master_dbh; if ( $master_dsn ) { - MKDEBUG && _d('Connecting to master via DSN from cmd-line'); + PTDEBUG && _d('Connecting to master via DSN from cmd-line'); $master_dbh = get_dbh($dp, $master_dsn); } elsif ( $o->get('use-master') @@ -2079,7 +2079,7 @@ sub main { { # Try to connect to the slave's master just by looking at its # SLAVE STATUS. - MKDEBUG && _d('The I/O thread is waiting, connecting to master'); + PTDEBUG && _d('The I/O thread is waiting, connecting to master'); my $spec = "h=$status->{master_host},P=$status->{master_port}"; $master_dbh = get_dbh($dp, $dp->parse($spec, $slave_dsn)); } @@ -2089,7 +2089,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -2149,7 +2149,7 @@ sub main { if ( !$master_dbh && $status->{slave_io_state} =~ m/free enough relay log/ ) { - MKDEBUG && _d("The I/O thread is stuck, connecting to master"); + PTDEBUG && _d("The I/O thread is stuck, connecting to master"); # If we're daemonized and --ask-pass is given, there's no way # to ask for a password. if ( $o->get('daemonize') && $o->get('ask-pass') ) { @@ -2165,7 +2165,7 @@ sub main { # Get binlog position. if ( $master_dbh ) { - MKDEBUG && _d('Getting binlog pos from master'); + PTDEBUG && _d('Getting binlog pos from master'); my $res = $master_dbh->selectrow_hashref("SHOW MASTER STATUS"); die "Binary logging is disabled on the MASTER-HOST" unless $res && %$res && $res->{file}; @@ -2178,7 +2178,7 @@ sub main { } } else { - MKDEBUG && _d('Getting binlog pos from slave'); + PTDEBUG && _d('Getting binlog pos from slave'); # Use the position on master at which the I/O thread is reading. # If the I/O thread is not far behind, which it usually is not, # this is basically the same as the master's File/Position, but @@ -2195,7 +2195,7 @@ sub main { } if ( ( $status->{slave_sql_running} || '' ) eq 'No' ) { - MKDEBUG && _d('Slave not running'); + PTDEBUG && _d('Slave not running'); # Find the most recent binlog position that's older than # the delay amount. my $pos; @@ -2208,11 +2208,11 @@ sub main { if ( $pos ) { my $position = $positions[$pos]; - MKDEBUG && _d('Chosen position:', ts($position->[$TS]), + PTDEBUG && _d('Chosen position:', ts($position->[$TS]), $position->[$FILE], '/', $position->[$POS]); } else { - MKDEBUG && _d('No position found'); + PTDEBUG && _d('No position found'); } # Make the slave server delay if possible; otherwise sleep and check @@ -2278,7 +2278,7 @@ sub main { sub info { my ( $message ) = @_; - $o->get('quiet') ? MKDEBUG && _d('info: now:', $now, 'message:', $message) + $o->get('quiet') ? PTDEBUG && _d('info: now:', $now, 'message:', $message) : print ts($now), " ", $message, "\n"; } diff --git a/bin/pt-slave-find b/bin/pt-slave-find index 5baa0db3..dd294b3d 100755 --- a/bin/pt-slave-find +++ b/bin/pt-slave-find @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1070,7 +1070,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1088,7 +1088,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1097,10 +1097,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1112,23 +1112,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1159,7 +1159,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1209,7 +1209,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1254,7 +1254,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1264,21 +1264,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1290,15 +1290,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1316,7 +1316,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1342,7 +1342,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1403,7 +1403,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1424,7 +1424,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -1433,15 +1433,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -1457,7 +1457,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -1475,23 +1475,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -1520,11 +1520,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -1553,7 +1553,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -1564,11 +1564,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -1583,7 +1583,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -1643,7 +1643,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -1652,7 +1652,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -1661,21 +1661,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -1696,17 +1696,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -1719,7 +1719,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -1728,13 +1728,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -1747,12 +1747,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -1764,7 +1764,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -1772,7 +1772,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -1780,7 +1780,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -1823,7 +1823,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -1885,12 +1885,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -1911,7 +1911,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -1921,14 +1921,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -1969,7 +1969,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -2018,7 +2018,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2036,17 +2036,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2088,19 +2088,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2118,7 +2118,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2138,7 +2138,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2151,7 +2151,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2160,10 +2160,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2204,7 +2204,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -2214,7 +2214,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -2225,7 +2225,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -2243,7 +2243,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -2255,7 +2255,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -2287,7 +2287,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -2467,36 +2467,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -2542,7 +2542,7 @@ package pt_slave_find; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(secs_to_time ts)); @@ -2660,14 +2660,14 @@ sub print_slaves { die "I need a node" unless $node; $level ||= 0; - MKDEBUG && _d("Printing slaves, starting level", $level); + PTDEBUG && _d("Printing slaves, starting level", $level); # Print this node. $print_node->(%args); # If this node has slaves, print them. if ( $node->{children} ) { - MKDEBUG && _d($ms->short_host($node), "has slaves"); + PTDEBUG && _d($ms->short_host($node), "has slaves"); my @slaves = reverse @{$node->{children}}; foreach my $slave ( @slaves ) { print_slaves(%args, node=>$slave, level=>$level + 1); @@ -2688,7 +2688,7 @@ sub print_node_hostname { my $host = $ms->short_host($node); my $prefix = $level ? (' ' x (($level-1)*3) . '+- ') : ''; - MKDEBUG && _d('level', $level, 'host', $host); + PTDEBUG && _d('level', $level, 'host', $host); print "$prefix$host\n"; return; @@ -2705,7 +2705,7 @@ sub print_node_summary { my $prefix = $level ? (' ' x (($level-1)*3) . '+- ') : ''; my $indent = ' ' x ($level * 3); - MKDEBUG && _d('level', $level, 'host', $host); + PTDEBUG && _d('level', $level, 'host', $host); print "$prefix$host\n"; diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart index 70a43db9..9649242c 100755 --- a/bin/pt-slave-restart +++ b/bin/pt-slave-restart @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # Quoter package @@ -22,7 +22,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -99,7 +99,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -183,7 +183,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -227,7 +227,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -264,7 +264,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -273,7 +273,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -292,7 +292,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -300,7 +300,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -338,7 +338,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -351,7 +351,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -377,14 +377,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -393,13 +393,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -407,17 +407,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -431,7 +431,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -441,7 +441,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -455,7 +455,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -478,7 +478,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -507,7 +507,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -538,7 +538,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -605,7 +605,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -654,7 +654,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -678,12 +678,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -692,23 +692,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -717,7 +717,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -727,7 +727,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -801,11 +801,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1020,7 +1020,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1030,7 +1030,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1054,7 +1054,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1067,7 +1067,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1094,7 +1094,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1124,7 +1124,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1134,7 +1134,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1145,7 +1145,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1163,7 +1163,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1175,7 +1175,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1207,7 +1207,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1230,7 +1230,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1248,7 +1248,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1257,10 +1257,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1272,23 +1272,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1319,7 +1319,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1369,7 +1369,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1414,7 +1414,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1424,21 +1424,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1450,15 +1450,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1476,7 +1476,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1502,7 +1502,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1563,7 +1563,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1584,7 +1584,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -1593,15 +1593,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -1617,7 +1617,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -1635,23 +1635,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -1680,11 +1680,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -1713,7 +1713,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -1724,11 +1724,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -1743,7 +1743,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -1803,7 +1803,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -1812,7 +1812,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -1821,21 +1821,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -1856,17 +1856,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -1879,7 +1879,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -1888,13 +1888,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -1907,12 +1907,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -1924,7 +1924,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -1932,7 +1932,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -1940,7 +1940,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -1983,7 +1983,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -2045,12 +2045,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -2071,7 +2071,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -2081,14 +2081,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -2129,7 +2129,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -2178,7 +2178,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2196,17 +2196,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2248,19 +2248,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2278,7 +2278,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2298,7 +2298,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2311,7 +2311,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2320,10 +2320,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2366,7 +2366,7 @@ use List::Util qw(min max); use Time::HiRes qw(sleep); use sigtrap qw(handler finish untrapped normal-signals); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; $OUTPUT_AUTOFLUSH = 1; @@ -2411,7 +2411,7 @@ sub main { # ######################################################################## my $sentinel = $o->get('sentinel'); if ( $o->get('stop') ) { - MKDEBUG && _d('Creating sentinel file', $sentinel); + PTDEBUG && _d('Creating sentinel file', $sentinel); my $file = IO::File->new($sentinel, ">>") or die "Cannot open $sentinel: $OS_ERROR\n"; print $file "Remove this file to permit pt-slave-restart to run\n" @@ -2422,16 +2422,16 @@ sub main { unless $o->get('quiet'); # Exit unlesss --monitor is given. if ( !$o->got('monitor') ) { - MKDEBUG && _d('Nothing more to do, quitting'); + PTDEBUG && _d('Nothing more to do, quitting'); return 0; } else { # Wait for all other running instances to quit, assuming they have the # same --interval as this invocation. Then remove the file and # continue. - MKDEBUG && _d('Waiting for other instances to quit'); + PTDEBUG && _d('Waiting for other instances to quit'); sleep $o->get('max-sleep'); - MKDEBUG && _d('Unlinking', $sentinel); + PTDEBUG && _d('Unlinking', $sentinel); unlink $sentinel or die "Cannot unlink $sentinel: $OS_ERROR"; } @@ -2456,7 +2456,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -2489,7 +2489,7 @@ sub main { }; if ( $EVAL_ERROR ) { chomp $EVAL_ERROR; - MKDEBUG && _d('Not watching', $dp->as_string($dsn), + PTDEBUG && _d('Not watching', $dp->as_string($dsn), 'because', $EVAL_ERROR); } }, @@ -2521,10 +2521,10 @@ sub main { $children{$dp->as_string($host->{dsn})} = $pid if $must_fork; } - MKDEBUG && _d('Child PIDs:', values %children); + PTDEBUG && _d('Child PIDs:', values %children); # Wait for the children to exit. foreach my $host ( keys %children ) { - MKDEBUG && _d('Waiting to reap', $host); + PTDEBUG && _d('Waiting to reap', $host); my $pid = waitpid($children{$host}, 0); $exit_status ||= $CHILD_ERROR >> 8; } @@ -2542,7 +2542,7 @@ sub main { sub watch_server { my ( $dsn, $dbh, $was_forked, $ms ) = @_; - MKDEBUG && _d('Watching server', $dp->as_string($dsn), + PTDEBUG && _d('Watching server', $dp->as_string($dsn), 'forked:', $was_forked); my $start_sql = $vp->version_ge($dbh, '4.0.5') @@ -2581,7 +2581,7 @@ sub watch_server { my %actions = ( refetch_relay_log => sub { my ( $stat, $dbh ) = @_; - MKDEBUG && _d('Found relay log corruption'); + PTDEBUG && _d('Found relay log corruption'); # Can't do CHANGE MASTER TO with a running slave. $stop->execute(); $chmt->execute( @@ -2589,17 +2589,17 @@ sub watch_server { }, skip => sub { my ( $stat, $dbh ) = @_; - MKDEBUG && _d('Found non-relay-log error'); + PTDEBUG && _d('Found non-relay-log error'); $set_skip->execute(); }, repair_table => sub { my ( $stat, $dbh ) = @_; - MKDEBUG && _d('Found corrupt table'); + PTDEBUG && _d('Found corrupt table'); # [ qr/Incorrect key file for table './foo/bar.MYI' my ( $db, $tbl ) = $stat->{last_error} =~ m!([^/]+)/(.*?)\.MYI!; if ( $db && $tbl ) { my $sql = "REPAIR TABLE " . $q->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } }, @@ -2623,9 +2623,9 @@ sub watch_server { next STAT; } - MKDEBUG && _d('Last/current relay log file:', + PTDEBUG && _d('Last/current relay log file:', $last_log, $stat->{relay_log_file}); - MKDEBUG && _d('Last/current relay log pos:', + PTDEBUG && _d('Last/current relay log pos:', $last_pos, $stat->{relay_log_pos}); if ( !$last_log || $last_log ne $stat->{relay_log_file} # Avoid infinite loops @@ -2699,7 +2699,7 @@ sub watch_server { } } else { - MKDEBUG && _d('The slave is stopped, but without error'); + PTDEBUG && _d('The slave is stopped, but without error'); $increase_sleep = 1; } } @@ -2740,7 +2740,7 @@ sub watch_server { sleep $sleep_time; } - MKDEBUG && _d('All done with server', $dp->as_string($dsn)); + PTDEBUG && _d('All done with server', $dp->as_string($dsn)); if ( $was_forked ) { $dp->disconnect($dbh); exit(0); diff --git a/bin/pt-table-checksum b/bin/pt-table-checksum index b16698ed..a7ba4d40 100755 --- a/bin/pt-table-checksum +++ b/bin/pt-table-checksum @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -186,7 +186,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -231,7 +231,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -241,21 +241,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -267,15 +267,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -293,7 +293,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -319,7 +319,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -380,7 +380,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -464,7 +464,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -508,7 +508,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -545,7 +545,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -554,7 +554,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -573,7 +573,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -581,7 +581,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -619,7 +619,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -632,7 +632,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -658,14 +658,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -674,13 +674,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -688,17 +688,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -712,7 +712,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -722,7 +722,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -736,7 +736,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -759,7 +759,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -788,7 +788,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -819,7 +819,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -886,7 +886,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -935,7 +935,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -959,12 +959,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -973,23 +973,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -998,7 +998,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1008,7 +1008,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1082,11 +1082,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1301,7 +1301,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1311,7 +1311,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1335,7 +1335,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1348,7 +1348,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1375,7 +1375,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1405,7 +1405,7 @@ package Cxn; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0; @@ -1458,7 +1458,7 @@ sub connect { } $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 }); } - MKDEBUG && _d($dbh, 'Connected dbh to', $self->{name}); + PTDEBUG && _d($dbh, 'Connected dbh to', $self->{name}); return $self->set_dbh($dbh); } @@ -1467,18 +1467,18 @@ sub set_dbh { my ($self, $dbh) = @_; if ( $self->{dbh} && $self->{dbh} == $dbh && $self->{dbh_set} ) { - MKDEBUG && _d($dbh, 'Already set dbh'); + PTDEBUG && _d($dbh, 'Already set dbh'); return $dbh; } - MKDEBUG && _d($dbh, 'Setting dbh'); + PTDEBUG && _d($dbh, 'Setting dbh'); $dbh->{FetchHashKeyName} = 'NAME_lc'; my $sql = 'SELECT @@hostname, @@server_id'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($hostname, $server_id) = $dbh->selectrow_array($sql); - MKDEBUG && _d($dbh, 'hostname:', $hostname, $server_id); + PTDEBUG && _d($dbh, 'hostname:', $hostname, $server_id); if ( $hostname ) { $self->{hostname} = $hostname; } @@ -1511,7 +1511,7 @@ sub name { sub DESTROY { my ($self) = @_; if ( $self->{dbh} ) { - MKDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name}); + PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name}); $self->{dbh}->disconnect(); } return; @@ -1545,7 +1545,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1664,7 +1664,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1674,7 +1674,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1685,7 +1685,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1703,7 +1703,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1715,7 +1715,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1747,7 +1747,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1775,36 +1775,36 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = 'USE ' . $q->quote($db); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); $sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return; } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $href->{$key} =~ s/\b[ ]{2,}/ /g; $href->{$key} .= "\n"; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; } @@ -1829,7 +1829,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -1890,7 +1890,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -1908,7 +1908,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -1917,25 +1917,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -1949,66 +1949,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -2024,7 +2024,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -2050,7 +2050,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -2072,7 +2072,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -2129,11 +2129,11 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); eval { $sth->execute(@params); }; if ($EVAL_ERROR) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return; } my @tables = @{$sth->fetchall_arrayref({})}; @@ -2175,7 +2175,7 @@ package TableNibbler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2199,14 +2199,14 @@ sub generate_asc_stmt { die "Index '$index' does not exist in table" unless exists $tbl_struct->{keys}->{$index}; - MKDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend index', $index); my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; if ( $args{asc_first} ) { @asc_cols = $asc_cols[0]; - MKDEBUG && _d('Ascending only first column'); + PTDEBUG && _d('Ascending only first column'); } - MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); + PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); my @asc_slice; my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; @@ -2217,7 +2217,7 @@ sub generate_asc_stmt { } push @asc_slice, $col_posn{$col}; } - MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); + PTDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); my $asc_stmt = { cols => \@cols, @@ -2338,7 +2338,7 @@ sub generate_del_stmt { else { @del_cols = @{$tbl->{cols}}; } - MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); + PTDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; foreach my $col ( @del_cols ) { @@ -2348,7 +2348,7 @@ sub generate_del_stmt { } push @del_slice, $col_posn{$col}; } - MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); + PTDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); my $del_stmt = { cols => \@cols, @@ -2432,7 +2432,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2453,7 +2453,7 @@ sub get_slaves { my $slaves = []; my $method = $o->get('recursion-method'); - MKDEBUG && _d('Slave recursion method:', $method); + PTDEBUG && _d('Slave recursion method:', $method); if ( !$method || $method =~ m/proocesslist|hosts/i ) { my @required_args = qw(dbh dsn); foreach my $arg ( @required_args ) { @@ -2469,7 +2469,7 @@ sub get_slaves { callback => sub { my ( $dsn, $dbh, $level, $parent ) = @_; return unless $level; - MKDEBUG && _d('Found slave:', $dp->as_string($dsn)); + PTDEBUG && _d('Found slave:', $dp->as_string($dsn)); push @$slaves, $make_cxn->(dsn => $dsn, dbh => $dbh); return; }, @@ -2501,7 +2501,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -2510,15 +2510,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -2534,7 +2534,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -2552,23 +2552,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -2597,11 +2597,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -2630,7 +2630,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -2641,11 +2641,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -2660,7 +2660,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -2720,7 +2720,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -2729,7 +2729,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -2738,21 +2738,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -2773,17 +2773,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -2796,7 +2796,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -2805,13 +2805,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -2824,12 +2824,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -2841,7 +2841,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -2849,7 +2849,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -2857,7 +2857,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -2900,7 +2900,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -2962,12 +2962,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -2988,7 +2988,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -2998,14 +2998,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -3046,7 +3046,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -3074,7 +3074,7 @@ sub get_cxn_from_dsn_table { die "I need a $arg argument" unless $args{$arg}; } my ($dsn_table_dsn, $make_cxn, $dp, $q) = @args{@required_args}; - MKDEBUG && _d('DSN table DSN:', $dsn_table_dsn); + PTDEBUG && _d('DSN table DSN:', $dsn_table_dsn); my $dsn = $dp->parse($dsn_table_dsn); my $dsn_table; @@ -3092,12 +3092,12 @@ sub get_cxn_from_dsn_table { my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn); my $dbh = $dsn_tbl_cxn->connect(); my $sql = "SELECT dsn FROM $dsn_table ORDER BY id"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $dsn_strings = $dbh->selectcol_arrayref($sql); my @cxn; if ( $dsn_strings ) { foreach my $dsn_string ( @$dsn_strings ) { - MKDEBUG && _d('DSN from DSN table:', $dsn_string); + PTDEBUG && _d('DSN from DSN table:', $dsn_string); push @cxn, $make_cxn->(dsn_string => $dsn_string); } } @@ -3132,7 +3132,7 @@ package RowChecksum; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Data::Dumper; @@ -3203,7 +3203,7 @@ sub make_row_checksum { $query .= "$fnv_func(" . join(', ', @{$cols->{select}}) . ')'; } - MKDEBUG && _d('Row checksum:', $query); + PTDEBUG && _d('Row checksum:', $query); return $query; } @@ -3221,7 +3221,7 @@ sub make_chunk_checksum { my $q = $self->{Quoter}; my %crc_args = $self->get_crc_args(%args); - MKDEBUG && _d("Checksum strat:", Dumper(\%crc_args)); + PTDEBUG && _d("Checksum strat:", Dumper(\%crc_args)); my $row_checksum = $self->make_row_checksum( %args, @@ -3242,7 +3242,7 @@ sub make_chunk_checksum { } my $select = "COUNT(*) AS cnt, $crc AS crc"; - MKDEBUG && _d('Chunk checksum:', $select); + PTDEBUG && _d('Chunk checksum:', $select); return $select; } @@ -3326,14 +3326,14 @@ sub _get_hash_func { foreach my $func ( @funcs ) { eval { my $sql = "SELECT $func('test-string')"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $args{dbh}->do($sql); }; if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) { $error .= qq{$func cannot be used because "$1"\n}; - MKDEBUG && _d($func, 'cannot be used because', $1); + PTDEBUG && _d($func, 'cannot be used because', $1); } - MKDEBUG && _d('Chosen hash func:', $result); + PTDEBUG && _d('Chosen hash func:', $result); return $func; } die $error || 'No hash functions (CRC32, MD5, etc.) are available'; @@ -3373,13 +3373,13 @@ sub _get_crc_type { $sth->execute(); $type = $sth->{mysql_type_name}->[0]; $length = $sth->{mysql_length}->[0]; - MKDEBUG && _d($sql, $type, $length); + PTDEBUG && _d($sql, $type, $length); if ( $type eq 'bigint' && $length < 20 ) { $type = 'int'; } }; $sth->finish; - MKDEBUG && _d('crc_type:', $type, 'length:', $length); + PTDEBUG && _d('crc_type:', $type, 'length:', $length); return $type; } @@ -3401,7 +3401,7 @@ sub _optimize_xor { my $crc_width = length($unsliced) < 16 ? 16 : length($unsliced); do { # Try different positions till sliced result equals non-sliced. - MKDEBUG && _d('Trying slice', $opt_slice); + PTDEBUG && _d('Trying slice', $opt_slice); $dbh->do('SET @crc := "", @cnt := 0'); my $slices = $self->_make_xor_slices( row_checksum => "\@crc := $func('a')", @@ -3412,18 +3412,18 @@ sub _optimize_xor { my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x"; $sliced = ($dbh->selectrow_array($sql))[0]; if ( $sliced ne $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'does not work'); + PTDEBUG && _d('Slice', $opt_slice, 'does not work'); $start += 16; ++$opt_slice; } } while ( $start < $crc_width && $sliced ne $unsliced ); if ( $sliced eq $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'works'); + PTDEBUG && _d('Slice', $opt_slice, 'works'); return $opt_slice; } else { - MKDEBUG && _d('No slice works'); + PTDEBUG && _d('No slice works'); return undef; } } @@ -3478,7 +3478,7 @@ sub find_replication_differences { . "WHERE (master_cnt <> this_cnt OR master_crc <> this_crc " . "OR ISNULL(master_crc) <> ISNULL(this_crc))" . ($args{where} ? " AND ($args{where})" : ""); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} }); return $diffs; } @@ -3511,7 +3511,7 @@ package NibbleIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -3531,12 +3531,12 @@ sub new { my $one_nibble = !defined $args{one_nibble} || $args{one_nibble} ? $row_est <= $chunk_size * $o->get('chunk-size-limit') : 0; - MKDEBUG && _d('One nibble:', $one_nibble ? 'yes' : 'no'); + PTDEBUG && _d('One nibble:', $one_nibble ? 'yes' : 'no'); if ( $args{resume} && !defined $args{resume}->{lower_boundary} && !defined $args{resume}->{upper_boundary} ) { - MKDEBUG && _d('Resuming from one nibble table'); + PTDEBUG && _d('Resuming from one nibble table'); $one_nibble = 1; } @@ -3558,7 +3558,7 @@ sub new { . " FROM " . $q->quote(@{$tbl}{qw(db tbl)}) . ($where ? " WHERE $where" : '') . " /*checksum table*/"; - MKDEBUG && _d('One nibble statement:', $nibble_sql); + PTDEBUG && _d('One nibble statement:', $nibble_sql); my $explain_nibble_sql = "EXPLAIN SELECT " @@ -3567,7 +3567,7 @@ sub new { . " FROM " . $q->quote(@{$tbl}{qw(db tbl)}) . ($where ? " WHERE $where" : '') . " /*explain checksum table*/"; - MKDEBUG && _d('Explain one nibble statement:', $explain_nibble_sql); + PTDEBUG && _d('Explain one nibble statement:', $explain_nibble_sql); $self = { %args, @@ -3587,7 +3587,7 @@ sub new { cols => \@cols, asc_only => 1, ); - MKDEBUG && _d('Ascend params:', Dumper($asc)); + PTDEBUG && _d('Ascend params:', Dumper($asc)); my $from = $q->quote(@{$tbl}{qw(db tbl)}) . " FORCE INDEX(`$index`)"; my $order_by = join(', ', map {$q->quote($_)} @{$index_cols}); @@ -3600,7 +3600,7 @@ sub new { . " ORDER BY $order_by" . " LIMIT 1" . " /*first lower boundary*/"; - MKDEBUG && _d('First lower boundary statement:', $first_lb_sql); + PTDEBUG && _d('First lower boundary statement:', $first_lb_sql); my $resume_lb_sql; if ( $args{resume} ) { @@ -3613,7 +3613,7 @@ sub new { . " ORDER BY $order_by" . " LIMIT 1" . " /*resume lower boundary*/"; - MKDEBUG && _d('Resume lower boundary statement:', $resume_lb_sql); + PTDEBUG && _d('Resume lower boundary statement:', $resume_lb_sql); } my $last_ub_sql @@ -3625,7 +3625,7 @@ sub new { . join(' DESC, ', map {$q->quote($_)} @{$index_cols}) . ' DESC' . " LIMIT 1" . " /*last upper boundary*/"; - MKDEBUG && _d('Last upper boundary statement:', $last_ub_sql); + PTDEBUG && _d('Last upper boundary statement:', $last_ub_sql); my $ub_sql = "SELECT /*!40001 SQL_NO_CACHE */ " @@ -3636,7 +3636,7 @@ sub new { . " ORDER BY $order_by" . " LIMIT ?, 2" . " /*next chunk boundary*/"; - MKDEBUG && _d('Upper boundary statement:', $ub_sql); + PTDEBUG && _d('Upper boundary statement:', $ub_sql); my $nibble_sql = ($args{dml} ? "$args{dml} " : "SELECT ") @@ -3648,7 +3648,7 @@ sub new { . ($where ? " AND ($where)" : '') . ($args{order_by} ? " ORDER BY $order_by" : "") . " /*checksum chunk*/"; - MKDEBUG && _d('Nibble statement:', $nibble_sql); + PTDEBUG && _d('Nibble statement:', $nibble_sql); my $explain_nibble_sql = "EXPLAIN SELECT " @@ -3660,10 +3660,10 @@ sub new { . ($where ? " AND ($where)" : '') . ($args{order_by} ? " ORDER BY $order_by" : "") . " /*explain checksum chunk*/"; - MKDEBUG && _d('Explain nibble statement:', $explain_nibble_sql); + PTDEBUG && _d('Explain nibble statement:', $explain_nibble_sql); my $limit = $chunk_size - 1; - MKDEBUG && _d('Initial chunk size (LIMIT):', $limit); + PTDEBUG && _d('Initial chunk size (LIMIT):', $limit); $self = { %args, @@ -3699,7 +3699,7 @@ sub next { my ($self) = @_; if ( !$self->{oktonibble} ) { - MKDEBUG && _d('Not ok to nibble'); + PTDEBUG && _d('Not ok to nibble'); return; } @@ -3714,7 +3714,7 @@ sub next { $self->_get_bounds(); if ( my $callback = $self->{callbacks}->{init} ) { $self->{oktonibble} = $callback->(%callback_args); - MKDEBUG && _d('init callback returned', $self->{oktonibble}); + PTDEBUG && _d('init callback returned', $self->{oktonibble}); if ( !$self->{oktonibble} ) { $self->{no_more_boundaries} = 1; return; @@ -3726,7 +3726,7 @@ sub next { while ( $self->{have_rows} || $self->_next_boundaries() ) { if ( !$self->{have_rows} ) { $self->{nibbleno}++; - MKDEBUG && _d($self->{nibble_sth}->{Statement}, 'params:', + PTDEBUG && _d($self->{nibble_sth}->{Statement}, 'params:', join(', ', (@{$self->{lower}}, @{$self->{upper}}))); if ( my $callback = $self->{callbacks}->{exec_nibble} ) { $self->{have_rows} = $callback->(%callback_args); @@ -3735,19 +3735,19 @@ sub next { $self->{nibble_sth}->execute(@{$self->{lower}}, @{$self->{upper}}); $self->{have_rows} = $self->{nibble_sth}->rows(); } - MKDEBUG && _d($self->{have_rows}, 'rows in nibble', $self->{nibbleno}); + PTDEBUG && _d($self->{have_rows}, 'rows in nibble', $self->{nibbleno}); } if ( $self->{have_rows} ) { my $row = $self->{nibble_sth}->fetchrow_arrayref(); if ( $row ) { $self->{rowno}++; - MKDEBUG && _d('Row', $self->{rowno}, 'in nibble',$self->{nibbleno}); + PTDEBUG && _d('Row', $self->{rowno}, 'in nibble',$self->{nibbleno}); return [ @$row ]; } } - MKDEBUG && _d('No rows in nibble or nibble skipped'); + PTDEBUG && _d('No rows in nibble or nibble skipped'); if ( my $callback = $self->{callbacks}->{after_nibble} ) { $callback->(%callback_args); } @@ -3755,7 +3755,7 @@ sub next { $self->{have_rows} = 0; } - MKDEBUG && _d('Done nibbling'); + PTDEBUG && _d('Done nibbling'); if ( my $callback = $self->{callbacks}->{done} ) { $callback->(%callback_args); } @@ -3772,7 +3772,7 @@ sub set_nibble_number { my ($self, $n) = @_; die "I need a number" unless $n; $self->{nibbleno} = $n; - MKDEBUG && _d('Set new nibble number:', $n); + PTDEBUG && _d('Set new nibble number:', $n); return; } @@ -3811,7 +3811,7 @@ sub set_boundary { die "I need a values arrayref parameter" unless $values && ref $values eq 'ARRAY'; $self->{$boundary} = $values; - MKDEBUG && _d('Set new', $boundary, 'boundary:', Dumper($values)); + PTDEBUG && _d('Set new', $boundary, 'boundary:', Dumper($values)); return; } @@ -3830,7 +3830,7 @@ sub set_chunk_size { return if $self->{one_nibble}; die "Chunk size must be > 0" unless $limit; $self->{limit} = $limit - 1; - MKDEBUG && _d('Set new chunk size (LIMIT):', $limit); + PTDEBUG && _d('Set new chunk size (LIMIT):', $limit); return; } @@ -3858,15 +3858,15 @@ sub _find_best_index { my $want_index = $args{chunk_index}; if ( $want_index ) { - MKDEBUG && _d('User wants to use index', $want_index); + PTDEBUG && _d('User wants to use index', $want_index); if ( !exists $indexes->{$want_index} ) { - MKDEBUG && _d('Cannot use user index because it does not exist'); + PTDEBUG && _d('Cannot use user index because it does not exist'); $want_index = undef; } } if ( !$want_index && $args{mysql_index} ) { - MKDEBUG && _d('MySQL wants to use index', $args{mysql_index}); + PTDEBUG && _d('MySQL wants to use index', $args{mysql_index}); $want_index = $args{mysql_index}; } @@ -3874,16 +3874,16 @@ sub _find_best_index { my @possible_indexes; if ( $want_index ) { if ( $indexes->{$want_index}->{is_unique} ) { - MKDEBUG && _d('Will use wanted index'); + PTDEBUG && _d('Will use wanted index'); $best_index = $want_index; } else { - MKDEBUG && _d('Wanted index is a possible index'); + PTDEBUG && _d('Wanted index is a possible index'); push @possible_indexes, $want_index; } } else { - MKDEBUG && _d('Auto-selecting best index'); + PTDEBUG && _d('Auto-selecting best index'); foreach my $index ( $tp->sort_indexes($tbl_struct) ) { if ( $index eq 'PRIMARY' || $indexes->{$index}->{is_unique} ) { $best_index = $index; @@ -3896,7 +3896,7 @@ sub _find_best_index { } if ( !$best_index && @possible_indexes ) { - MKDEBUG && _d('No PRIMARY or unique indexes;', + PTDEBUG && _d('No PRIMARY or unique indexes;', 'will use index with highest cardinality'); foreach my $index ( @possible_indexes ) { $indexes->{$index}->{cardinality} = _get_index_cardinality( @@ -3916,7 +3916,7 @@ sub _find_best_index { $best_index = $possible_indexes[0]; } - MKDEBUG && _d('Best index:', $best_index); + PTDEBUG && _d('Best index:', $best_index); return $best_index; } @@ -3927,13 +3927,13 @@ sub _get_index_cardinality { my $sql = "SHOW INDEXES FROM " . $q->quote(@{$tbl}{qw(db tbl)}) . " WHERE Key_name = '$index'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cardinality = 1; my $rows = $cxn->dbh()->selectall_hashref($sql, 'key_name'); foreach my $row ( values %$rows ) { $cardinality *= $row->{cardinality} if $row->{cardinality}; } - MKDEBUG && _d('Index', $index, 'cardinality:', $cardinality); + PTDEBUG && _d('Index', $index, 'cardinality:', $cardinality); return $cardinality; } @@ -3943,23 +3943,23 @@ sub get_row_estimate { my ($cxn, $tbl, $o, $tp, $q) = @args{@required_args}; if ( $args{where} ) { - MKDEBUG && _d('WHERE clause, using explain plan for row estimate'); + PTDEBUG && _d('WHERE clause, using explain plan for row estimate'); my $table = $q->quote(@{$tbl}{qw(db tbl)}); my $sql = "EXPLAIN SELECT * FROM $table WHERE $args{where}"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $cxn->dbh()->selectrow_hashref($sql); - MKDEBUG && _d(Dumper($expl)); + PTDEBUG && _d(Dumper($expl)); return ($expl->{rows} || 0), $expl->{key}; } else { - MKDEBUG && _d('No WHERE clause, using table status for row estimate'); + PTDEBUG && _d('No WHERE clause, using table status for row estimate'); return $tbl->{tbl_status}->{rows} || 0; } } sub _prepare_sths { my ($self) = @_; - MKDEBUG && _d('Preparing statement handles'); + PTDEBUG && _d('Preparing statement handles'); my $dbh = $self->{Cxn}->dbh(); @@ -3987,14 +3987,14 @@ sub _get_bounds { my $dbh = $self->{Cxn}->dbh(); $self->{first_lower} = $dbh->selectrow_arrayref($self->{first_lb_sql}); - MKDEBUG && _d('First lower boundary:', Dumper($self->{first_lower})); + PTDEBUG && _d('First lower boundary:', Dumper($self->{first_lower})); if ( my $nibble = $self->{resume} ) { if ( defined $nibble->{lower_boundary} && defined $nibble->{upper_boundary} ) { my $sth = $dbh->prepare($self->{resume_lb_sql}); my @ub = split ',', $nibble->{upper_boundary}; - MKDEBUG && _d($sth->{Statement}, 'params:', @ub); + PTDEBUG && _d($sth->{Statement}, 'params:', @ub); $sth->execute(@ub); $self->{next_lower} = $sth->fetchrow_arrayref(); $sth->finish(); @@ -4003,15 +4003,15 @@ sub _get_bounds { else { $self->{next_lower} = $self->{first_lower}; } - MKDEBUG && _d('Next lower boundary:', Dumper($self->{next_lower})); + PTDEBUG && _d('Next lower boundary:', Dumper($self->{next_lower})); if ( !$self->{next_lower} ) { - MKDEBUG && _d('At end of table, or no more boundaries to resume'); + PTDEBUG && _d('At end of table, or no more boundaries to resume'); $self->{no_more_boundaries} = 1; } $self->{last_upper} = $dbh->selectrow_arrayref($self->{last_ub_sql}); - MKDEBUG && _d('Last upper boundary:', Dumper($self->{last_upper})); + PTDEBUG && _d('Last upper boundary:', Dumper($self->{last_upper})); return; } @@ -4020,7 +4020,7 @@ sub _next_boundaries { my ($self) = @_; if ( $self->{no_more_boundaries} ) { - MKDEBUG && _d('No more boundaries'); + PTDEBUG && _d('No more boundaries'); return; # stop nibbling } @@ -4031,7 +4031,7 @@ sub _next_boundaries { } if ( $self->identical_boundaries($self->{lower}, $self->{next_lower}) ) { - MKDEBUG && _d('Infinite loop detected'); + PTDEBUG && _d('Infinite loop detected'); my $tbl = $self->{tbl}; my $index = $tbl->{tbl_struct}->{keys}->{$self->{index}}; my $n_cols = scalar @{$index->{cols}}; @@ -4055,18 +4055,18 @@ sub _next_boundaries { tbl => $self->{tbl}, NibbleIterator => $self, ); - MKDEBUG && _d('next_boundaries callback returned', $oktonibble); + PTDEBUG && _d('next_boundaries callback returned', $oktonibble); if ( !$oktonibble ) { $self->{no_more_boundaries} = 1; return; # stop nibbling } } - MKDEBUG && _d($self->{ub_sth}->{Statement}, 'params:', + PTDEBUG && _d($self->{ub_sth}->{Statement}, 'params:', join(', ', @{$self->{lower}}), $self->{limit}); $self->{ub_sth}->execute(@{$self->{lower}}, $self->{limit}); my $boundary = $self->{ub_sth}->fetchall_arrayref(); - MKDEBUG && _d('Next boundary:', Dumper($boundary)); + PTDEBUG && _d('Next boundary:', Dumper($boundary)); if ( $boundary && @$boundary ) { $self->{upper} = $boundary->[0]; # this nibble if ( $boundary->[1] ) { @@ -4074,13 +4074,13 @@ sub _next_boundaries { } else { $self->{no_more_boundaries} = 1; # for next call - MKDEBUG && _d('Last upper boundary:', Dumper($boundary->[0])); + PTDEBUG && _d('Last upper boundary:', Dumper($boundary->[0])); } } else { $self->{no_more_boundaries} = 1; # for next call $self->{upper} = $self->{last_upper}; - MKDEBUG && _d('Last upper boundary:', Dumper($self->{upper})); + PTDEBUG && _d('Last upper boundary:', Dumper($self->{upper})); } $self->{ub_sth}->finish(); @@ -4107,7 +4107,7 @@ sub DESTROY { my ( $self ) = @_; foreach my $key ( keys %$self ) { if ( $key =~ m/_sth$/ ) { - MKDEBUG && _d('Finish', $key); + PTDEBUG && _d('Finish', $key); $self->{$key}->finish(); } } @@ -4143,7 +4143,7 @@ use base 'NibbleIterator'; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4179,7 +4179,7 @@ sub new { . " WHERE " . $self->{sql}->{boundaries}->{'<'} . $tail_sql . " /*past lower chunk*/"; - MKDEBUG && _d('Past lower statement:', $past_lower_sql); + PTDEBUG && _d('Past lower statement:', $past_lower_sql); my $explain_past_lower_sql = "EXPLAIN SELECT " @@ -4189,14 +4189,14 @@ sub new { . " WHERE " . $self->{sql}->{boundaries}->{'<'} . $tail_sql . " /*explain past lower chunk*/"; - MKDEBUG && _d('Past lower statement:', $explain_past_lower_sql); + PTDEBUG && _d('Past lower statement:', $explain_past_lower_sql); my $past_upper_sql = $head_sql . " WHERE " . $self->{sql}->{boundaries}->{'>'} . $tail_sql . " /*past upper chunk*/"; - MKDEBUG && _d('Past upper statement:', $past_upper_sql); + PTDEBUG && _d('Past upper statement:', $past_upper_sql); my $explain_past_upper_sql = "EXPLAIN SELECT " @@ -4206,7 +4206,7 @@ sub new { . " WHERE " . $self->{sql}->{boundaries}->{'>'} . $tail_sql . " /*explain past upper chunk*/"; - MKDEBUG && _d('Past upper statement:', $explain_past_upper_sql); + PTDEBUG && _d('Past upper statement:', $explain_past_upper_sql); $self->{past_lower_sql} = $past_lower_sql; $self->{past_upper_sql} = $past_upper_sql; @@ -4222,7 +4222,7 @@ sub new { : []; } } - MKDEBUG && _d('Nibble past', @{$self->{past_nibbles}}); + PTDEBUG && _d('Nibble past', @{$self->{past_nibbles}}); } # not one nibble @@ -4248,7 +4248,7 @@ sub statements { sub _prepare_sths { my ($self) = @_; - MKDEBUG && _d('Preparing out-of-bound statement handles'); + PTDEBUG && _d('Preparing out-of-bound statement handles'); if ( !$self->{one_nibble} ) { my $dbh = $self->{Cxn}->dbh(); @@ -4268,7 +4268,7 @@ sub _next_boundaries { if ( my $past = shift @{$self->{past_nibbles}} ) { if ( $past eq 'lower' ) { - MKDEBUG && _d('Nibbling values below lower boundary'); + PTDEBUG && _d('Nibbling values below lower boundary'); $self->{nibble_sth} = $self->{past_lower_sth}; $self->{explain_nibble_sth} = $self->{explain_past_lower_sth}; $self->{lower} = []; @@ -4276,7 +4276,7 @@ sub _next_boundaries { $self->{next_lower} = undef; } elsif ( $past eq 'upper' ) { - MKDEBUG && _d('Nibbling values above upper boundary'); + PTDEBUG && _d('Nibbling values above upper boundary'); $self->{nibble_sth} = $self->{past_upper_sth}; $self->{explain_nibble_sth} = $self->{explain_past_upper_sth}; $self->{lower} = $self->boundaries()->{last_upper}; @@ -4289,7 +4289,7 @@ sub _next_boundaries { return 1; # continue nibbling } - MKDEBUG && _d('Done nibbling past boundaries'); + PTDEBUG && _d('Done nibbling past boundaries'); return; # stop nibbling } @@ -4297,7 +4297,7 @@ sub DESTROY { my ( $self ) = @_; foreach my $key ( keys %$self ) { if ( $key =~ m/_sth$/ ) { - MKDEBUG && _d('Finish', $key); + PTDEBUG && _d('Finish', $key); $self->{$key}->finish(); } } @@ -4332,7 +4332,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -4350,17 +4350,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -4402,19 +4402,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -4432,7 +4432,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -4452,7 +4452,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -4465,7 +4465,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -4474,10 +4474,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -4518,7 +4518,7 @@ package SchemaIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4548,7 +4548,7 @@ sub new { my %resume; if ( my $table = $args{resume} ) { - MKDEBUG && _d('Will resume from or after', $table); + PTDEBUG && _d('Will resume from or after', $table); my ($db, $tbl) = $args{Quoter}->split_unquote($table); die "Resume table must be database-qualified: $table" unless $db && $tbl; @@ -4591,11 +4591,11 @@ sub _make_filters { if ( $is_table ) { my ($db, $tbl) = $q->split_unquote($obj); $db ||= '*'; - MKDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); + PTDEBUG && _d('Filter', $filter, 'value:', $db, $tbl); $filters{$filter}->{$tbl} = $db; } else { # database - MKDEBUG && _d('Filter', $filter, 'value:', $obj); + PTDEBUG && _d('Filter', $filter, 'value:', $obj); $filters{$filter}->{$obj} = 1; } } @@ -4611,11 +4611,11 @@ sub _make_filters { my $pat = $o->get($filter); next REGEX_FILTER unless $pat; $filters{$filter} = qr/$pat/; - MKDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); + PTDEBUG && _d('Filter', $filter, 'value:', $filters{$filter}); } } - MKDEBUG && _d('Schema object filters:', Dumper(\%filters)); + PTDEBUG && _d('Schema object filters:', Dumper(\%filters)); return \%filters; } @@ -4626,7 +4626,7 @@ sub next { $self->{initialized} = 1; if ( $self->{resume}->{tbl} && !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) { - MKDEBUG && _d('Will resume after', + PTDEBUG && _d('Will resume after', join('.', @{$self->{resume}}{qw(db tbl)})); $self->{resume}->{after} = 1; } @@ -4652,7 +4652,7 @@ sub next { if ( my $schema = $self->{Schema} ) { $schema->add_schema_object($schema_obj); } - MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); + PTDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); } return $schema_obj; @@ -4664,14 +4664,14 @@ sub _iterate_files { if ( !$self->{fh} ) { my ($fh, $file) = $self->{file_itr}->(); if ( !$fh ) { - MKDEBUG && _d('No more files to iterate'); + PTDEBUG && _d('No more files to iterate'); return; } $self->{fh} = $fh; $self->{file} = $file; } my $fh = $self->{fh}; - MKDEBUG && _d('Getting next schema object from', $self->{file}); + PTDEBUG && _d('Getting next schema object from', $self->{file}); local $INPUT_RECORD_SEPARATOR = ''; CHUNK: @@ -4687,7 +4687,7 @@ sub _iterate_files { } elsif ($self->{db} && $chunk =~ m/CREATE TABLE/) { if ($chunk =~ m/DROP VIEW IF EXISTS/) { - MKDEBUG && _d('Table is a VIEW, skipping'); + PTDEBUG && _d('Table is a VIEW, skipping'); next CHUNK; } @@ -4716,7 +4716,7 @@ sub _iterate_files { } } # CHUNK - MKDEBUG && _d('No more schema objects in', $self->{file}); + PTDEBUG && _d('No more schema objects in', $self->{file}); close $self->{fh}; $self->{fh} = undef; @@ -4727,14 +4727,14 @@ sub _iterate_dbh { my ( $self ) = @_; my $q = $self->{Quoter}; my $dbh = $self->{dbh}; - MKDEBUG && _d('Getting next schema object from dbh', $dbh); + PTDEBUG && _d('Getting next schema object from dbh', $dbh); if ( !defined $self->{dbs} ) { my $sql = 'SHOW DATABASES'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @dbs = grep { $self->database_is_allowed($_) } @{$dbh->selectcol_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @dbs, 'databases'); + PTDEBUG && _d('Found', scalar @dbs, 'databases'); $self->{dbs} = \@dbs; } @@ -4742,13 +4742,13 @@ sub _iterate_dbh { do { $self->{db} = shift @{$self->{dbs}}; } until $self->_resume_from_database($self->{db}); - MKDEBUG && _d('Next database:', $self->{db}); + PTDEBUG && _d('Next database:', $self->{db}); return unless $self->{db}; } if ( !defined $self->{tbls} ) { my $sql = 'SHOW /*!50002 FULL*/ TABLES FROM ' . $q->quote($self->{db}); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @tbls = map { $_->[0]; # (tbl, type) } @@ -4759,7 +4759,7 @@ sub _iterate_dbh { && $self->table_is_allowed($self->{db}, $tbl); } @{$dbh->selectall_arrayref($sql)}; - MKDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); + PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); $self->{tbls} = \@tbls; } @@ -4771,9 +4771,9 @@ sub _iterate_dbh { { my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db}) . " LIKE \'$tbl\'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $tbl_status = $dbh->selectrow_hashref($sql); - MKDEBUG && _d(Dumper($tbl_status)); + PTDEBUG && _d(Dumper($tbl_status)); } if ( !$tbl_status @@ -4792,7 +4792,7 @@ sub _iterate_dbh { } } - MKDEBUG && _d('No more tables in database', $self->{db}); + PTDEBUG && _d('No more tables in database', $self->{db}); $self->{db} = undef; $self->{tbls} = undef; @@ -4808,30 +4808,30 @@ sub database_is_allowed { my $filter = $self->{filters}; if ( $db =~ m/information_schema|performance_schema|lost\+found/ ) { - MKDEBUG && _d('Database', $db, 'is a system database, ignoring'); + PTDEBUG && _d('Database', $db, 'is a system database, ignoring'); return 0; } if ( $self->{filters}->{'ignore-databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is in --ignore-databases list'); + PTDEBUG && _d('Database', $db, 'is in --ignore-databases list'); return 0; } if ( $filter->{'ignore-databases-regex'} && $db =~ $filter->{'ignore-databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); + PTDEBUG && _d('Database', $db, 'matches --ignore-databases-regex'); return 0; } if ( $filter->{'databases'} && !$filter->{'databases'}->{$db} ) { - MKDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); + PTDEBUG && _d('Database', $db, 'is not in --databases list, ignoring'); return 0; } if ( $filter->{'databases-regex'} && $db !~ $filter->{'databases-regex'} ) { - MKDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); + PTDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring'); return 0; } @@ -4855,25 +4855,25 @@ sub table_is_allowed { if ( $filter->{'ignore-tables'}->{$tbl} && ($filter->{'ignore-tables'}->{$tbl} eq '*' || $filter->{'ignore-tables'}->{$tbl} eq $db) ) { - MKDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); + PTDEBUG && _d('Table', $tbl, 'is in --ignore-tables list'); return 0; } if ( $filter->{'ignore-tables-regex'} && $tbl =~ $filter->{'ignore-tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); + PTDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex'); return 0; } if ( $filter->{'tables'} && !$filter->{'tables'}->{$tbl} ) { - MKDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); + PTDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring'); return 0; } if ( $filter->{'tables-regex'} && $tbl !~ $filter->{'tables-regex'} ) { - MKDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); + PTDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring'); return 0; } @@ -4881,7 +4881,7 @@ sub table_is_allowed { && $filter->{'tables'}->{$tbl} && $filter->{'tables'}->{$tbl} ne '*' && $filter->{'tables'}->{$tbl} ne $db ) { - MKDEBUG && _d('Table', $tbl, 'is only allowed in database', + PTDEBUG && _d('Table', $tbl, 'is only allowed in database', $filter->{'tables'}->{$tbl}); return 0; } @@ -4898,13 +4898,13 @@ sub engine_is_allowed { my $filter = $self->{filters}; if ( $filter->{'ignore-engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); + PTDEBUG && _d('Engine', $engine, 'is in --ignore-databases list'); return 0; } if ( $filter->{'engines'} && !$filter->{'engines'}->{$engine} ) { - MKDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); + PTDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring'); return 0; } @@ -4917,7 +4917,7 @@ sub _resume_from_database { return 1 unless $self->{resume}->{db}; if ( $db eq $self->{resume}->{db} ) { - MKDEBUG && _d('At resume db', $db); + PTDEBUG && _d('At resume db', $db); delete $self->{resume}->{db}; return 1; } @@ -4932,12 +4932,12 @@ sub _resume_from_table { if ( $tbl eq $self->{resume}->{tbl} ) { if ( !$self->{resume}->{after} ) { - MKDEBUG && _d('Resuming from table', $tbl); + PTDEBUG && _d('Resuming from table', $tbl); delete $self->{resume}->{tbl}; return 1; } else { - MKDEBUG && _d('Resuming after table', $tbl); + PTDEBUG && _d('Resuming after table', $tbl); delete $self->{resume}->{tbl}; } } @@ -4973,7 +4973,7 @@ package Retry; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4997,29 +4997,29 @@ sub retry { my $tryno = 0; TRY: while ( ++$tryno <= $tries ) { - MKDEBUG && _d("Try", $tryno, "of", $tries); + PTDEBUG && _d("Try", $tryno, "of", $tries); my $result; eval { $result = $try->(tryno=>$tryno); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Try code failed:", $EVAL_ERROR); + PTDEBUG && _d("Try code failed:", $EVAL_ERROR); $last_error = $EVAL_ERROR; if ( $tryno < $tries ) { # more retries my $retry = $fail->(tryno=>$tryno, error=>$last_error); last TRY unless $retry; - MKDEBUG && _d("Calling wait code"); + PTDEBUG && _d("Calling wait code"); $wait->(tryno=>$tryno); } } else { - MKDEBUG && _d("Try code succeeded"); + PTDEBUG && _d("Try code succeeded"); return $result; } } - MKDEBUG && _d('Try code did not succeed'); + PTDEBUG && _d('Try code did not succeed'); return $final_fail->(error=>$last_error); } @@ -5051,7 +5051,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -5231,36 +5231,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -5307,7 +5307,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -5455,7 +5455,7 @@ package ReplicaLagWaiter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::HiRes qw(sleep time); use Data::Dumper; @@ -5517,10 +5517,10 @@ sub wait { my @lagged_slaves = map { {cxn=>$_, lag=>undef} } @$slaves; while ( $oktorun->() && @lagged_slaves ) { - MKDEBUG && _d('Checking slave lag'); + PTDEBUG && _d('Checking slave lag'); for my $i ( 0..$#lagged_slaves ) { my $lag = $get_lag->($lagged_slaves[$i]->{cxn}); - MKDEBUG && _d($lagged_slaves[$i]->{cxn}->name(), + PTDEBUG && _d($lagged_slaves[$i]->{cxn}->name(), 'slave lag:', $lag); if ( !defined $lag || $lag > $max_lag ) { $lagged_slaves[$i]->{lag} = $lag; @@ -5538,7 +5538,7 @@ sub wait { : 1; } @lagged_slaves; $worst = $lagged_slaves[0]; - MKDEBUG && _d(scalar @lagged_slaves, 'slaves are lagging, worst:', + PTDEBUG && _d(scalar @lagged_slaves, 'slaves are lagging, worst:', $worst->{lag}, 'on', Dumper($worst->{cxn}->dsn())); if ( $pr ) { @@ -5548,12 +5548,12 @@ sub wait { ); } - MKDEBUG && _d('Calling sleep callback'); + PTDEBUG && _d('Calling sleep callback'); $sleep->($worst->{cxn}, $worst->{lag}); } } - MKDEBUG && _d('All slaves caught up'); + PTDEBUG && _d('All slaves caught up'); return; } @@ -5585,7 +5585,7 @@ package MySQLStatusWaiter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -5615,7 +5615,7 @@ sub _parse_spec { my ($spec, $get_status) = @args{@required_args}; if ( !@$spec ) { - MKDEBUG && _d('No spec, disabling status var waits'); + PTDEBUG && _d('No spec, disabling status var waits'); return; } @@ -5625,10 +5625,10 @@ sub _parse_spec { die "Invalid spec: $var_val" unless $var; if ( !$val ) { my $init_val = $get_status->($var); - MKDEBUG && _d('Initial', $var, 'value:', $init_val); + PTDEBUG && _d('Initial', $var, 'value:', $init_val); $val = int(($init_val * .20) + $init_val); } - MKDEBUG && _d('Wait if', $var, '>=', $val); + PTDEBUG && _d('Wait if', $var, '>=', $val); $max_val_for{$var} = $val; } @@ -5670,10 +5670,10 @@ sub wait { } while ( $oktorun->() ) { - MKDEBUG && _d('Checking status variables'); + PTDEBUG && _d('Checking status variables'); foreach my $var ( sort keys %vals_too_high ) { my $val = $get_status->($var); - MKDEBUG && _d($var, '=', $val); + PTDEBUG && _d($var, '=', $val); if ( !$val || $val >= $self->{max_val_for}->{$var} ) { $vals_too_high{$var} = $val; } @@ -5684,17 +5684,17 @@ sub wait { last unless scalar keys %vals_too_high; - MKDEBUG && _d(scalar keys %vals_too_high, 'values are too high:', + PTDEBUG && _d(scalar keys %vals_too_high, 'values are too high:', %vals_too_high); if ( $pr ) { $pr->update(sub { return 0; }); } - MKDEBUG && _d('Calling sleep callback'); + PTDEBUG && _d('Calling sleep callback'); $sleep->(); %vals_too_high = %{$self->{max_val_for}}; # recheck all vars } - MKDEBUG && _d('All var vals are low enough'); + PTDEBUG && _d('All var vals are low enough'); return; } @@ -5726,7 +5726,7 @@ package WeightedAvgRate; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -5747,23 +5747,23 @@ sub new { sub update { my ($self, $n, $t) = @_; - MKDEBUG && _d('Master op time:', $n, 'n /', $t, 's'); + PTDEBUG && _d('Master op time:', $n, 'n /', $t, 's'); if ( $self->{avg_n} && $self->{avg_t} ) { $self->{avg_n} = ($self->{avg_n} * $self->{weight}) + $n; $self->{avg_t} = ($self->{avg_t} * $self->{weight}) + $t; $self->{avg_rate} = $self->{avg_n} / $self->{avg_t}; - MKDEBUG && _d('Weighted avg rate:', $self->{avg_rate}, 'n/s'); + PTDEBUG && _d('Weighted avg rate:', $self->{avg_rate}, 'n/s'); } else { $self->{avg_n} = $n; $self->{avg_t} = $t; $self->{avg_rate} = $self->{avg_n} / $self->{avg_t}; - MKDEBUG && _d('Initial avg rate:', $self->{avg_rate}, 'n/s'); + PTDEBUG && _d('Initial avg rate:', $self->{avg_rate}, 'n/s'); } my $new_n = int($self->{avg_rate} * $self->{target_t}); - MKDEBUG && _d('Adjust n to', $new_n); + PTDEBUG && _d('Adjust n to', $new_n); return $new_n; } @@ -5794,7 +5794,7 @@ package pt_table_checksum; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(signal_h); use List::Util qw(max); @@ -5883,7 +5883,7 @@ sub main { return if $o->get('explain'); my $sql = 'SET /*!50108 @@binlog_format := "STATEMENT"*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); # Set transaction isolation level. We set binlog_format to STATEMENT, @@ -5897,7 +5897,7 @@ sub main { # See also http://code.google.com/p/maatkit/issues/detail?id=720 $sql = 'SET SESSION TRANSACTION ISOLATION LEVEL REPEATABLE READ'; eval { - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); }; if ( $EVAL_ERROR ) { @@ -5915,13 +5915,13 @@ sub main { # some locking, it will be more likely to be the victim than other # connections to the server, and thus disrupt the server less. $sql = 'SHOW SESSION VARIABLES LIKE "innodb_lock_wait_timeout"'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my (undef, $lock_wait_timeout) = $dbh->selectrow_array($sql); - MKDEBUG && _d('innodb_lock_wait_timeout', $lock_wait_timeout); + PTDEBUG && _d('innodb_lock_wait_timeout', $lock_wait_timeout); if ( ($lock_wait_timeout || 0) > $o->get('lock-wait-timeout') ) { $sql = 'SET SESSION innodb_lock_wait_timeout=1'; eval { - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); }; if ( $EVAL_ERROR ) { @@ -6002,10 +6002,10 @@ sub main { return $make_cxn->(@_, prev_dsn => $master_cxn->dsn()); }, ); - MKDEBUG && _d(scalar @$slaves, 'slaves found'); + PTDEBUG && _d(scalar @$slaves, 'slaves found'); if ( $o->get('check-slave-lag') ) { - MKDEBUG && _d('Will use --check-slave-lag to check for slave lag'); + PTDEBUG && _d('Will use --check-slave-lag to check for slave lag'); my $cxn = $make_cxn->( dsn_string => $o->get('check-slave-lag'), prev_dsn => $master_cxn->dsn(), @@ -6013,7 +6013,7 @@ sub main { $slave_lag_cxns = [ $cxn ]; } else { - MKDEBUG && _d('Will check slave lag on all slaves'); + PTDEBUG && _d('Will check slave lag on all slaves'); $slave_lag_cxns = $slaves; } @@ -6021,14 +6021,14 @@ sub main { # Possibly check replication slaves and exit. # ##################################################################### if ( $o->get('replicate-check') && $o->get('replicate-check-only') ) { - MKDEBUG && _d('Will --replicate-check and exit'); + PTDEBUG && _d('Will --replicate-check and exit'); foreach my $slave ( @$slaves ) { my $diffs = $rc->find_replication_differences( dbh => $slave->dbh(), repl_table => $repl_table, ); - MKDEBUG && _d(scalar @$diffs, 'checksum diffs on', + PTDEBUG && _d(scalar @$diffs, 'checksum diffs on', $slave->name()); if ( @$diffs ) { $exit_status |= 1; @@ -6041,7 +6041,7 @@ sub main { } } - MKDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun); + PTDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun); return $exit_status; } @@ -6049,7 +6049,7 @@ sub main { # Check for replication filters. # ##################################################################### if ( $o->get('check-replication-filters') ) { - MKDEBUG && _d("Checking slave replication filters"); + PTDEBUG && _d("Checking slave replication filters"); my @all_repl_filters; foreach my $slave ( @$slaves ) { my $repl_filters = $ms->get_replication_filters( @@ -6104,7 +6104,7 @@ sub main { # master cxn; do not use $master_dbh. my $dbh = $master_cxn->dbh(); if ( !$dbh || !$dbh->ping() ) { - MKDEBUG && _d('Lost connection to master while waiting for slave lag'); + PTDEBUG && _d('Lost connection to master while waiting for slave lag'); eval { $dbh = $master_cxn->connect() }; # connect or die trying if ( $EVAL_ERROR ) { $oktorun = 0; # Fatal error @@ -6122,7 +6122,7 @@ sub main { my ($cxn) = @_; my $dbh = $cxn->dbh(); if ( !$dbh || !$dbh->ping() ) { - MKDEBUG && _d('Lost connection to slave', $cxn->name(), + PTDEBUG && _d('Lost connection to slave', $cxn->name(), 'while waiting for slave lag'); eval { $dbh = $cxn->connect() }; # connect or die trying if ( $EVAL_ERROR ) { @@ -6150,7 +6150,7 @@ sub main { $get_status = sub { my ($var) = @_; - MKDEBUG && _d($sth->{Statement}, $var); + PTDEBUG && _d($sth->{Statement}, $var); $sth->execute($var); my (undef, $val) = $sth->fetchrow_array(); return $val; @@ -6224,7 +6224,7 @@ sub main { if ( $last_chunk && !$schema_iter->table_is_allowed(@{$last_chunk}{qw(db tbl)}) ) { - MKDEBUG && _d('Ignoring last table', @{$last_chunk}{qw(db tbl)}, + PTDEBUG && _d('Ignoring last table', @{$last_chunk}{qw(db tbl)}, 'and resuming from next table'); $last_chunk = undef; } @@ -6253,7 +6253,7 @@ sub main { if ( $last_chunk ) { # resuming if ( have_more_chunks(%args, last_chunk => $last_chunk) ) { $nibble_iter->set_nibble_number($last_chunk->{chunk}); - MKDEBUG && _d('Have more chunks; resuming from', + PTDEBUG && _d('Have more chunks; resuming from', $last_chunk->{chunk}, 'at', $last_chunk->{ts}); if ( !$o->get('quiet') ) { print "Resuming from $tbl->{db}.$tbl->{tbl} chunk " @@ -6262,7 +6262,7 @@ sub main { } else { # Problem resuming or no next lower boundary. - MKDEBUG && _d('No more chunks; resuming from next table'); + PTDEBUG && _d('No more chunks; resuming from next table'); $oktonibble = 0; # don't nibble table; next table } @@ -6290,7 +6290,7 @@ sub main { } else { if ( $nibble_iter->one_nibble() ) { - MKDEBUG && _d('Getting table row estimate on replicas'); + PTDEBUG && _d('Getting table row estimate on replicas'); my $chunk_size_limit = $o->get('chunk-size-limit'); my @too_large; foreach my $slave ( @$slaves ) { @@ -6302,12 +6302,12 @@ sub main { TableParser => $tp, Quoter => $q, ); - MKDEBUG && _d('Table on', $slave->name(), + PTDEBUG && _d('Table on', $slave->name(), 'has', $n_rows, 'rows'); if ( $n_rows && $n_rows > ($tbl->{chunk_size} * $chunk_size_limit) ) { - MKDEBUG && _d('Table too large on', $slave->name()); + PTDEBUG && _d('Table too large on', $slave->name()); push @too_large, [$slave->name(), $n_rows || 0]; } } @@ -6338,7 +6338,7 @@ sub main { OptionParser => $o, Quoter => $q, ); - MKDEBUG && _d($delete_sth->{Statement}); + PTDEBUG && _d($delete_sth->{Statement}); $delete_sth->execute($tbl->{db}, $tbl->{tbl}); } @@ -6377,7 +6377,7 @@ sub main { vals => [ @{$boundary->{lower}}, $nibble_iter->chunk_size() ], ); if ( ($expl->{key} || '') ne $nibble_iter->nibble_index() ) { - MKDEBUG && _d('Cannot nibble next chunk, aborting table'); + PTDEBUG && _d('Cannot nibble next chunk, aborting table'); if ( $o->get('quiet') < 2 ) { warn ts("Aborting $tbl->{db}.$tbl->{tbl} because " . ($nibble_iter->nibble_number() + 1) @@ -6438,7 +6438,7 @@ sub main { # Ensure that MySQL is using the chunk index. if ( ($expl->{key} || '') ne $nibble_iter->nibble_index() ) { - MKDEBUG && _d('Chunk', $args{nibbleno}, 'of table', + PTDEBUG && _d('Chunk', $args{nibbleno}, 'of table', "$tbl->{db}.$tbl->{tbl} not using chunk index, skipping"); return 0; # next boundary } @@ -6450,7 +6450,7 @@ sub main { if ( $nibble_iter->identical_boundaries( $boundary->{upper}, $boundary->{next_lower}) && $oversize_chunk ) { - MKDEBUG && _d('Chunk', $args{nibbleno}, 'of table', + PTDEBUG && _d('Chunk', $args{nibbleno}, 'of table', "$tbl->{db}.$tbl->{tbl} is too large, skipping"); return 0; # next boundary } @@ -6464,7 +6464,7 @@ sub main { Quoter => $q, OptionParser => $o, ); - MKDEBUG && _d('Nibble time:', $tbl->{nibble_time}); + PTDEBUG && _d('Nibble time:', $tbl->{nibble_time}); # We're executing REPLACE queries which don't return rows. # Returning 0 from this callback causes the nibble iter to @@ -6484,7 +6484,7 @@ sub main { # Nibble time will be zero if the chunk was skipped. if ( !defined $tbl->{nibble_time} ) { - MKDEBUG && _d('Skipping chunk', $chunk); + PTDEBUG && _d('Skipping chunk', $chunk); $tbl->{checksum_results}->{skipped}++; return; } @@ -6526,7 +6526,7 @@ sub main { $total_rows += $cnt; $total_time += $tbl->{nibble_time}; $total_rate = int($total_rows / $total_time); - MKDEBUG && _d('Total avg rate:', $total_rate); + PTDEBUG && _d('Total avg rate:', $total_rate); # Adjust chunk size. This affects the next chunk. if ( $o->get('chunk-time') ) { @@ -6585,7 +6585,7 @@ sub main { # Wait for all slaves to run all checksum chunks, # then check for differences. if ( $max_chunk && $o->get('replicate-check') && scalar @$slaves ) { - MKDEBUG && _d('Checking slave diffs'); + PTDEBUG && _d('Checking slave diffs'); my $check_pr; if ( $o->get('progress') ) { @@ -6615,7 +6615,7 @@ sub main { repl_table => $repl_table, where => "db='$tbl->{db}' AND tbl='$tbl->{tbl}'", ); - MKDEBUG && _d(scalar @$diffs, 'checksum diffs on', + PTDEBUG && _d(scalar @$diffs, 'checksum diffs on', $slave->name()); if ( @$diffs ) { $tbl->{checksum_results}->{diffs} = scalar @$diffs; @@ -6753,7 +6753,7 @@ sub main { } } - MKDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun); + PTDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun); return $exit_status; } @@ -6814,7 +6814,7 @@ sub exec_nibble { my $t_start = time; # Execute the REPLACE...SELECT checksum query. - MKDEBUG && _d($sth->{nibble}->{Statement}, + PTDEBUG && _d($sth->{nibble}->{Statement}, 'lower boundary:', @{$boundary->{lower}}, 'upper boundary:', @{$boundary->{upper}}); $sth->{nibble}->execute( @@ -6837,13 +6837,13 @@ sub exec_nibble { # Check if checksum query caused any warnings. my $sql_warn = 'SHOW WARNINGS'; - MKDEBUG && _d($sql_warn); + PTDEBUG && _d($sql_warn); my $warnings = $dbh->selectall_arrayref($sql_warn, { Slice => {} } ); foreach my $warning ( @$warnings ) { my $code = ($warning->{code} || 0); my $message = $warning->{message}; if ( $ignore_code{$code} ) { - MKDEBUG && _d('Ignoring warning:', $code, $message); + PTDEBUG && _d('Ignoring warning:', $code, $message); next; } elsif ( $warn_code{$code} @@ -6992,12 +6992,12 @@ sub check_repl_table { die "I need a $arg argument" unless $args{$arg}; } my ($dbh, $repl_table, $o, $tp, $q) = @args{@required_args}; - MKDEBUG && _d('Checking --replicate table', $repl_table); + PTDEBUG && _d('Checking --replicate table', $repl_table); # If the repl db doesn't exit, auto-create it, maybe. my ($db, $tbl) = $q->split_unquote($repl_table); my $sql = "SHOW DATABASES LIKE '$db'"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my @db_exists = $dbh->selectrow_array($sql); if ( !@db_exists && $o->get('create-replicate-table') ) { $sql = "CREATE DATABASE " . $q->quote($db) . " /* pt-table-checksum */"; @@ -7030,7 +7030,7 @@ sub check_repl_table { } } else { - MKDEBUG && _d('--replicate table', $repl_table, 'already exists'); + PTDEBUG && _d('--replicate table', $repl_table, 'already exists'); # Check it again but this time check the privs. my $have_tbl_privs = $tp->check_table( dbh => $dbh, @@ -7095,7 +7095,7 @@ sub use_repl_db { die "I need a $arg argument" unless $args{$arg}; } my ($dbh, $repl_table, $o, $q) = @args{@required_args}; - MKDEBUG && _d('use_repl_db'); + PTDEBUG && _d('use_repl_db'); my ($db, $tbl) = $q->split_unquote($repl_table); if ( my $tbl = $args{tbl} ) { @@ -7116,7 +7116,7 @@ sub use_repl_db { eval { my $sql = "USE " . $q->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); }; if ( $EVAL_ERROR ) { @@ -7142,11 +7142,11 @@ sub create_repl_table { die "I need a $arg argument" unless $args{$arg}; } my ($dbh, $repl_table, $o) = @args{@required_args}; - MKDEBUG && _d('Creating --replicate table', $repl_table); + PTDEBUG && _d('Creating --replicate table', $repl_table); my $sql = $o->read_para_after(__FILE__, qr/MAGIC_create_replicate/); $sql =~ s/CREATE TABLE checksums/CREATE TABLE $repl_table/; $sql =~ s/;$//; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); eval { $dbh->do($sql); }; @@ -7177,7 +7177,7 @@ sub explain_statement { my $expl; eval { - MKDEBUG && _d($sth->{Statement}, 'params:', @$vals); + PTDEBUG && _d($sth->{Statement}, 'params:', @$vals); $sth->execute(@$vals); $expl = $sth->fetchrow_hashref(); $sth->finish(); @@ -7187,7 +7187,7 @@ sub explain_statement { warn ts("Error executing " . $sth->{Statement} . ": $EVAL_ERROR\n"); $tbl->{checksum_results}->{errors}++; } - MKDEBUG && _d('EXPLAIN plan:', Dumper($expl)); + PTDEBUG && _d('EXPLAIN plan:', Dumper($expl)); return $expl; } @@ -7198,20 +7198,20 @@ sub last_chunk { die "I need a $arg argument" unless $args{$arg}; } my ($dbh, $repl_table, $q) = @args{@required_args}; - MKDEBUG && _d('Getting last chunk for --resume'); + PTDEBUG && _d('Getting last chunk for --resume'); my $sql = "SELECT * FROM $repl_table FORCE INDEX (ts_db_tbl) " . "WHERE master_cnt IS NOT NULL " . "ORDER BY ts DESC, db DESC, tbl DESC LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); my $last_chunk = $sth->fetchrow_hashref(); $sth->finish(); - MKDEBUG && _d('Last chunk:', Dumper($last_chunk)); + PTDEBUG && _d('Last chunk:', Dumper($last_chunk)); if ( !$last_chunk || !$last_chunk->{ts} ) { - MKDEBUG && _d('Replicate table is empty; will not resume'); + PTDEBUG && _d('Replicate table is empty; will not resume'); return; } @@ -7225,12 +7225,12 @@ sub have_more_chunks { die "I need a $arg argument" unless $args{$arg}; } my ($tbl, $last_chunk, $nibble_iter) = @args{@required_args}; - MKDEBUG && _d('Checking for more chunks beyond last chunk'); + PTDEBUG && _d('Checking for more chunks beyond last chunk'); # If there's no next lower boundary, then this is the last # chunk of the table. if ( !$nibble_iter->more_boundaries() ) { - MKDEBUG && _d('No more boundaries'); + PTDEBUG && _d('No more boundaries'); return 0; } @@ -7273,7 +7273,7 @@ sub wait_for_last_checksum { my $sql = "SELECT MAX(chunk) FROM $repl_table " . "WHERE db='$tbl->{db}' AND tbl='$tbl->{tbl}' " . "AND master_crc IS NOT NULL"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sleep_time = 0; my $n_slaves = scalar @$slaves - 1; @@ -7284,13 +7284,13 @@ sub wait_for_last_checksum { for my $i ( 0..$n_slaves ) { my $slave = $slaves->[$i]; if ( $skip_slave{$i} ) { - MKDEBUG && _d('Skipping slave', $slave->name(), + PTDEBUG && _d('Skipping slave', $slave->name(), 'due to previous error it caused'); next; } eval { my ($chunk) = $slave->dbh()->selectrow_array($sql); - MKDEBUG && _d($slave->name(), 'max chunk:', $chunk); + PTDEBUG && _d($slave->name(), 'max chunk:', $chunk); push @chunks, $chunk || 0; }; if ($EVAL_ERROR) { @@ -7317,7 +7317,7 @@ sub wait_for_last_checksum { # We shouldn't wait long here because we already waited # for all slaves to catchup at least until --max-lag. $sleep_time += 0.25 if $sleep_time <= $o->get('max-lag'); - MKDEBUG && _d('Sleep', $sleep_time, 'waiting for chunks'); + PTDEBUG && _d('Sleep', $sleep_time, 'waiting for chunks'); sleep $sleep_time; } } diff --git a/bin/pt-table-sync b/bin/pt-table-sync index c6820f62..ae91a97e 100755 --- a/bin/pt-table-sync +++ b/bin/pt-table-sync @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1166,7 +1166,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1189,7 +1189,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1207,7 +1207,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1216,10 +1216,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1231,23 +1231,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1278,7 +1278,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1328,7 +1328,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1373,7 +1373,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1383,21 +1383,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1409,15 +1409,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1435,7 +1435,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1461,7 +1461,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1522,7 +1522,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1532,7 +1532,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1543,7 +1543,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1561,7 +1561,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1573,7 +1573,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1605,7 +1605,7 @@ package TableSyncStream; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1724,7 +1724,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -1769,7 +1769,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -1830,7 +1830,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -1848,7 +1848,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -1857,25 +1857,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -1889,66 +1889,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -1964,7 +1964,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -1990,7 +1990,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -2012,7 +2012,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -2080,7 +2080,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -2090,7 +2090,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -2125,7 +2125,7 @@ package RowDiff; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2154,47 +2154,47 @@ sub compare_sets { do { if ( !$lr && !$left_done ) { - MKDEBUG && _d('Fetching row from left'); + PTDEBUG && _d('Fetching row from left'); eval { $lr = $left_sth->fetchrow_hashref(); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $left_done = !$lr || $EVAL_ERROR ? 1 : 0; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d('Left still has rows'); } if ( !$rr && !$right_done ) { - MKDEBUG && _d('Fetching row from right'); + PTDEBUG && _d('Fetching row from right'); eval { $rr = $right_sth->fetchrow_hashref(); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $right_done = !$rr || $EVAL_ERROR ? 1 : 0; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d('Right still has rows'); } my $cmp; if ( $lr && $rr ) { $cmp = $self->key_cmp(%args, lr => $lr, rr => $rr); - MKDEBUG && _d('Key comparison on left and right:', $cmp); + PTDEBUG && _d('Key comparison on left and right:', $cmp); } if ( $lr || $rr ) { if ( $lr && $rr && defined $cmp && $cmp == 0 ) { - MKDEBUG && _d('Left and right have the same key'); + PTDEBUG && _d('Left and right have the same key'); $syncer->same_row(%args, lr => $lr, rr => $rr); $self->{same_row}->(%args, lr => $lr, rr => $rr) if $self->{same_row}; $lr = $rr = undef; # Fetch another row from each side. } elsif ( !$rr || ( defined $cmp && $cmp < 0 ) ) { - MKDEBUG && _d('Left is not in right'); + PTDEBUG && _d('Left is not in right'); $syncer->not_in_right(%args, lr => $lr, rr => $rr); $self->{not_in_right}->(%args, lr => $lr, rr => $rr) if $self->{not_in_right}; $lr = undef; } else { - MKDEBUG && _d('Right is not in left'); + PTDEBUG && _d('Right is not in left'); $syncer->not_in_left(%args, lr => $lr, rr => $rr); $self->{not_in_left}->(%args, lr => $lr, rr => $rr) if $self->{not_in_left}; @@ -2203,7 +2203,7 @@ sub compare_sets { } $left_done = $right_done = 1 if $done && $done->(%args); } while ( !($left_done && $right_done) ); - MKDEBUG && _d('No more rows'); + PTDEBUG && _d('No more rows'); $syncer->done_with_rows(); } @@ -2214,7 +2214,7 @@ sub key_cmp { die "I need a $arg argument" unless exists $args{$arg}; } my ($lr, $rr, $key_cols, $tbl_struct) = @args{@required_args}; - MKDEBUG && _d('Comparing keys using columns:', join(',', @$key_cols)); + PTDEBUG && _d('Comparing keys using columns:', join(',', @$key_cols)); my $callback = $self->{key_cmp}; my $trf = $self->{trf}; @@ -2223,16 +2223,16 @@ sub key_cmp { my $l = $lr->{$col}; my $r = $rr->{$col}; if ( !defined $l || !defined $r ) { - MKDEBUG && _d($col, 'is not defined in both rows'); + PTDEBUG && _d($col, 'is not defined in both rows'); return defined $l ? 1 : defined $r ? -1 : 0; } else { if ( $tbl_struct->{is_numeric}->{$col} ) { # Numeric column - MKDEBUG && _d($col, 'is numeric'); + PTDEBUG && _d($col, 'is numeric'); ($l, $r) = $trf->($l, $r, $tbl_struct, $col) if $trf; my $cmp = $l <=> $r; if ( $cmp ) { - MKDEBUG && _d('Column', $col, 'differs:', $l, '!=', $r); + PTDEBUG && _d('Column', $col, 'differs:', $l, '!=', $r); $callback->($col, $l, $r) if $callback; return $cmp; } @@ -2243,15 +2243,15 @@ sub key_cmp { if ( $coll && ( $coll ne 'latin1_swedish_ci' || $l =~ m/[^\040-\177]/ || $r =~ m/[^\040-\177]/) ) { - MKDEBUG && _d('Comparing', $col, 'via MySQL'); + PTDEBUG && _d('Comparing', $col, 'via MySQL'); $cmp = $self->db_cmp($coll, $l, $r); } else { - MKDEBUG && _d('Comparing', $col, 'in lowercase'); + PTDEBUG && _d('Comparing', $col, 'in lowercase'); $cmp = lc $l cmp lc $r; } if ( $cmp ) { - MKDEBUG && _d('Column', $col, 'differs:', $l, 'ne', $r); + PTDEBUG && _d('Column', $col, 'differs:', $l, 'ne', $r); $callback->($col, $l, $r) if $callback; return $cmp; } @@ -2265,7 +2265,7 @@ sub db_cmp { my ( $self, $collation, $l, $r ) = @_; if ( !$self->{sth}->{$collation} ) { if ( !$self->{charset_for} ) { - MKDEBUG && _d('Fetching collations from MySQL'); + PTDEBUG && _d('Fetching collations from MySQL'); my @collations = @{$self->{dbh}->selectall_arrayref( 'SHOW COLLATION', {Slice => { collation => 1, charset => 1 }})}; foreach my $collation ( @collations ) { @@ -2275,7 +2275,7 @@ sub db_cmp { } my $sql = "SELECT STRCMP(_$self->{charset_for}->{$collation}? COLLATE $collation, " . "_$self->{charset_for}->{$collation}? COLLATE $collation) AS res"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $self->{sth}->{$collation} = $self->{dbh}->prepare($sql); } my $sth = $self->{sth}->{$collation}; @@ -2311,7 +2311,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -2405,11 +2405,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -2421,12 +2421,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -2436,15 +2436,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -2454,11 +2454,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -2479,7 +2479,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -2491,11 +2491,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -2508,7 +2508,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -2527,7 +2527,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -2545,7 +2545,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -2571,7 +2571,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -2616,7 +2616,7 @@ package ChangeHandler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $DUPE_KEY = qr/Duplicate entry/; our @ACTIONS = qw(DELETE REPLACE INSERT UPDATE); @@ -2648,7 +2648,7 @@ sub new { sub fetch_back { my ( $self, $dbh ) = @_; $self->{fetch_back} = $dbh; - MKDEBUG && _d('Set fetch back dbh', $dbh); + PTDEBUG && _d('Set fetch back dbh', $dbh); return; } @@ -2666,7 +2666,7 @@ sub set_src { else { die "src argument must be either 'left' or 'right'" } - MKDEBUG && _d('Set src to', $src); + PTDEBUG && _d('Set src to', $src); $self->fetch_back($dbh) if $dbh; return; } @@ -2683,7 +2683,7 @@ sub dst { sub _take_action { my ( $self, $sql, $dbh ) = @_; - MKDEBUG && _d('Calling subroutines on', $dbh, $sql); + PTDEBUG && _d('Calling subroutines on', $dbh, $sql); foreach my $action ( @{$self->{actions}} ) { $action->($sql, $dbh); } @@ -2692,7 +2692,7 @@ sub _take_action { sub change { my ( $self, $action, $row, $cols, $dbh ) = @_; - MKDEBUG && _d($dbh, $action, 'where', $self->make_where_clause($row, $cols)); + PTDEBUG && _d($dbh, $action, 'where', $self->make_where_clause($row, $cols)); return unless $action; @@ -2708,7 +2708,7 @@ sub change { $self->_take_action($self->$func($row, $cols), $dbh); }; if ( $EVAL_ERROR =~ m/$DUPE_KEY/ ) { - MKDEBUG && _d('Duplicate key violation; will queue and rewrite'); + PTDEBUG && _d('Duplicate key violation; will queue and rewrite'); $self->{queue}++; $self->{replace} = 1; $self->__queue($action, $row, $cols, $dbh); @@ -2722,7 +2722,7 @@ sub change { sub __queue { my ( $self, $action, $row, $cols, $dbh ) = @_; - MKDEBUG && _d('Queueing change for later'); + PTDEBUG && _d('Queueing change for later'); if ( $self->{replace} ) { $action = $action eq 'DELETE' ? $action : 'REPLACE'; } @@ -2734,16 +2734,16 @@ sub process_rows { my $error_count = 0; TRY: { if ( $queue_level && $queue_level < $self->{queue} ) { # see redo below! - MKDEBUG && _d('Not processing now', $queue_level, '<', $self->{queue}); + PTDEBUG && _d('Not processing now', $queue_level, '<', $self->{queue}); return; } - MKDEBUG && _d('Processing rows:'); + PTDEBUG && _d('Processing rows:'); my ($row, $cur_act); eval { foreach my $action ( @ACTIONS ) { my $func = "make_$action"; my $rows = $self->{$action}; - MKDEBUG && _d(scalar(@$rows), 'to', $action); + PTDEBUG && _d(scalar(@$rows), 'to', $action); $cur_act = $action; while ( @$rows ) { $row = shift @$rows; @@ -2755,7 +2755,7 @@ sub process_rows { $error_count = 0; }; if ( !$error_count++ && $EVAL_ERROR =~ m/$DUPE_KEY/ ) { - MKDEBUG && _d('Duplicate key violation; re-queueing and rewriting'); + PTDEBUG && _d('Duplicate key violation; re-queueing and rewriting'); $self->{queue}++; # Defer rows to the very end $self->{replace} = 1; $self->__queue($cur_act, @$row); @@ -2769,7 +2769,7 @@ sub process_rows { sub make_DELETE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make DELETE'); + PTDEBUG && _d('Make DELETE'); return "DELETE FROM $self->{dst_db_tbl} WHERE " . $self->make_where_clause($row, $cols) . ' LIMIT 1'; @@ -2777,7 +2777,7 @@ sub make_DELETE { sub make_UPDATE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make UPDATE'); + PTDEBUG && _d('Make UPDATE'); if ( $self->{replace} ) { return $self->make_row('REPLACE', $row, $cols); } @@ -2786,7 +2786,7 @@ sub make_UPDATE { my @cols; if ( my $dbh = $self->{fetch_back} ) { my $sql = $self->make_fetch_back_query($where); - MKDEBUG && _d('Fetching data on dbh', $dbh, 'for UPDATE:', $sql); + PTDEBUG && _d('Fetching data on dbh', $dbh, 'for UPDATE:', $sql); my $res = $dbh->selectrow_hashref($sql); @{$row}{keys %$res} = values %$res; @cols = $self->sort_cols($res); @@ -2804,7 +2804,7 @@ sub make_UPDATE { sub make_INSERT { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make INSERT'); + PTDEBUG && _d('Make INSERT'); if ( $self->{replace} ) { return $self->make_row('REPLACE', $row, $cols); } @@ -2813,7 +2813,7 @@ sub make_INSERT { sub make_REPLACE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make REPLACE'); + PTDEBUG && _d('Make REPLACE'); return $self->make_row('REPLACE', $row, $cols); } @@ -2823,7 +2823,7 @@ sub make_row { if ( my $dbh = $self->{fetch_back} ) { my $where = $self->make_where_clause($row, $cols); my $sql = $self->make_fetch_back_query($where); - MKDEBUG && _d('Fetching data on dbh', $dbh, 'for', $verb, ':', $sql); + PTDEBUG && _d('Fetching data on dbh', $dbh, 'for', $verb, ':', $sql); my $res = $dbh->selectrow_hashref($sql); @{$row}{keys %$res} = values %$res; @cols = $self->sort_cols($res); @@ -2904,7 +2904,7 @@ sub make_fetch_back_query { ); if ( !$cols ) { - MKDEBUG && _d('Failed to make explicit columns list from tbl struct'); + PTDEBUG && _d('Failed to make explicit columns list from tbl struct'); $cols = '*'; } } @@ -2939,7 +2939,7 @@ package TableChunker; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(floor ceil); use List::Util qw(min max); @@ -2987,7 +2987,7 @@ sub find_chunk_columns { push @possible_indexes, $index; } - MKDEBUG && _d('Possible chunk indexes in order:', + PTDEBUG && _d('Possible chunk indexes in order:', join(', ', map { $_->{name} } @possible_indexes)); my $can_chunk_exact = 0; @@ -3005,14 +3005,14 @@ sub find_chunk_columns { $can_chunk_exact = 1 if $args{exact} && scalar @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { my $chunk_type = $args{exact} ? 'Exact' : 'Inexact'; _d($chunk_type, 'chunkable:', join(', ', map { "$_->{column} on $_->{index}" } @candidate_cols)); } my @result; - MKDEBUG && _d('Ordering columns by order in tbl, PK first'); + PTDEBUG && _d('Ordering columns by order in tbl, PK first'); if ( $tbl_struct->{keys}->{PRIMARY} ) { my $pk_first_col = $tbl_struct->{keys}->{PRIMARY}->{cols}->[0]; @result = grep { $_->{column} eq $pk_first_col } @candidate_cols; @@ -3023,7 +3023,7 @@ sub find_chunk_columns { push @result, sort { $col_pos{$a->{column}} <=> $col_pos{$b->{column}} } @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { _d('Chunkable columns:', join(', ', map { "$_->{column} on $_->{index}" } @result)); _d('Can chunk exactly:', $can_chunk_exact); @@ -3038,18 +3038,18 @@ sub calculate_chunks { foreach my $arg ( @required_args ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Calculate chunks for', + PTDEBUG && _d('Calculate chunks for', join(", ", map {"$_=".(defined $args{$_} ? $args{$_} : "undef")} qw(db tbl chunk_col min max rows_in_range chunk_size zero_chunk exact) )); if ( !$args{rows_in_range} ) { - MKDEBUG && _d("Empty table"); + PTDEBUG && _d("Empty table"); return '1=1'; } if ( $args{rows_in_range} < $args{chunk_size} ) { - MKDEBUG && _d("Chunk size larger than rows in range"); + PTDEBUG && _d("Chunk size larger than rows in range"); return '1=1'; } @@ -3058,7 +3058,7 @@ sub calculate_chunks { my $chunk_col = $args{chunk_col}; my $tbl_struct = $args{tbl_struct}; my $col_type = $tbl_struct->{type_for}->{$chunk_col}; - MKDEBUG && _d('chunk col type:', $col_type); + PTDEBUG && _d('chunk col type:', $col_type); my %chunker; if ( $tbl_struct->{is_numeric}->{$chunk_col} || $col_type =~ /date|time/ ) { @@ -3070,7 +3070,7 @@ sub calculate_chunks { else { die "Cannot chunk $col_type columns"; } - MKDEBUG && _d("Chunker:", Dumper(\%chunker)); + PTDEBUG && _d("Chunker:", Dumper(\%chunker)); my ($col, $start_point, $end_point, $interval, $range_func) = @chunker{qw(col start_point end_point interval range_func)}; @@ -3110,7 +3110,7 @@ sub calculate_chunks { } } else { - MKDEBUG && _d('No chunks; using single chunk 1=1'); + PTDEBUG && _d('No chunks; using single chunk 1=1'); push @chunks, '1=1'; } @@ -3170,19 +3170,19 @@ sub _chunk_numeric { } if ( !defined $start_point ) { - MKDEBUG && _d('Start point is undefined'); + PTDEBUG && _d('Start point is undefined'); $start_point = 0; } if ( !defined $end_point || $end_point < $start_point ) { - MKDEBUG && _d('End point is undefined or before start point'); + PTDEBUG && _d('End point is undefined or before start point'); $end_point = 0; } - MKDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); my $have_zero_chunk = 0; if ( $args{zero_chunk} ) { if ( $start_point != $end_point && $start_point >= 0 ) { - MKDEBUG && _d('Zero chunking'); + PTDEBUG && _d('Zero chunking'); my $nonzero_val = $self->get_nonzero_value( %args, db_tbl => $db_tbl, @@ -3198,10 +3198,10 @@ sub _chunk_numeric { $have_zero_chunk = 1; } else { - MKDEBUG && _d("Cannot zero chunk"); + PTDEBUG && _d("Cannot zero chunk"); } } - MKDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); my $interval = $args{chunk_size} * ($end_point - $start_point) @@ -3213,7 +3213,7 @@ sub _chunk_numeric { if ( $args{exact} ) { $interval = $args{chunk_size}; } - MKDEBUG && _d('Chunk interval:', $interval, 'units'); + PTDEBUG && _d('Chunk interval:', $interval, 'units'); return ( col => $q->quote($args{chunk_col}), @@ -3240,21 +3240,21 @@ sub _chunk_char { $sql = "SELECT MIN($chunk_col), MAX($chunk_col) FROM $db_tbl " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my ($min_col, $max_col) = ($row->[0], $row->[1]); $sql = "SELECT ORD(?) AS min_col_ord, ORD(?) AS max_col_ord"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ord_sth = $dbh->prepare($sql); # avoid quoting issues $ord_sth->execute($min_col, $max_col); $row = $ord_sth->fetchrow_arrayref(); my ($min_col_ord, $max_col_ord) = ($row->[0], $row->[1]); - MKDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); + PTDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); my $base; my @chars; - MKDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); + PTDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); if ( ($args{tbl_struct}->{charset} || "") eq "latin1" ) { my @sorted_latin1_chars = ( 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, @@ -3282,16 +3282,16 @@ sub _chunk_char { my $tmp_tbl = '__maatkit_char_chunking_map'; my $tmp_db_tbl = $q->quote($args{db}, $tmp_tbl); $sql = "DROP TABLE IF EXISTS $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); my $col_def = $args{tbl_struct}->{defs}->{$chunk_col}; $sql = "CREATE TEMPORARY TABLE $tmp_db_tbl ($col_def) " . "ENGINE=MEMORY"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); $sql = "INSERT INTO $tmp_db_tbl VALUE (CHAR(?))"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ins_char_sth = $dbh->prepare($sql); # avoid quoting issues for my $char_code ( $min_col_ord..$max_col_ord ) { $ins_char_sth->execute($char_code); @@ -3300,7 +3300,7 @@ sub _chunk_char { $sql = "SELECT `$chunk_col` FROM $tmp_db_tbl " . "WHERE `$chunk_col` BETWEEN ? AND ? " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sel_char_sth = $dbh->prepare($sql); $sel_char_sth->execute($min_col, $max_col); @@ -3308,22 +3308,22 @@ sub _chunk_char { $base = scalar @chars; $sql = "DROP TABLE $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } - MKDEBUG && _d("Base", $base, "chars:", @chars); + PTDEBUG && _d("Base", $base, "chars:", @chars); $sql = "SELECT MAX(LENGTH($chunk_col)) FROM $db_tbl ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my $max_col_len = $row->[0]; - MKDEBUG && _d("Max column value:", $max_col, $max_col_len); + PTDEBUG && _d("Max column value:", $max_col, $max_col_len); my $n_values; for my $n_chars ( 1..$max_col_len ) { $n_values = $base**$n_chars; if ( $n_values >= $args{chunk_size} ) { - MKDEBUG && _d($n_chars, "chars in base", $base, "expresses", + PTDEBUG && _d($n_chars, "chars in base", $base, "expresses", $n_values, "values"); last; } @@ -3368,7 +3368,7 @@ sub get_first_chunkable_column { my $wanted_col = $args{chunk_column}; my $wanted_idx = $args{chunk_index}; - MKDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); + PTDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); if ( $wanted_col && $wanted_idx ) { foreach my $chunkable_col ( @cols ) { @@ -3399,7 +3399,7 @@ sub get_first_chunkable_column { } } - MKDEBUG && _d('First chunkable col/index:', $col, $idx); + PTDEBUG && _d('First chunkable col/index:', $col, $idx); return $col, $idx; } @@ -3461,9 +3461,9 @@ sub get_range_statistics { my $sql = "SELECT MIN($col), MAX($col) FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE ($where)" : ''); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); ($min, $max) = $dbh->selectrow_array($sql); - MKDEBUG && _d("Actual end points:", $min, $max); + PTDEBUG && _d("Actual end points:", $min, $max); ($min, $max) = $self->get_valid_end_points( %args, @@ -3474,7 +3474,7 @@ sub get_range_statistics { min => $min, max => $max, ); - MKDEBUG && _d("Valid end points:", $min, $max); + PTDEBUG && _d("Valid end points:", $min, $max); }; if ( $EVAL_ERROR ) { die "Error getting min and max values for table $db_tbl " @@ -3484,7 +3484,7 @@ sub get_range_statistics { my $sql = "EXPLAIN SELECT * FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE $where" : ''); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); return ( @@ -3499,7 +3499,7 @@ sub inject_chunks { foreach my $arg ( qw(database table chunks chunk_num query) ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Injecting chunk', $args{chunk_num}); + PTDEBUG && _d('Injecting chunk', $args{chunk_num}); my $query = $args{query}; my $comment = sprintf("/*%s.%s:%d/%d*/", $args{database}, $args{table}, @@ -3514,7 +3514,7 @@ sub inject_chunks { my $db_tbl = $self->{Quoter}->quote(@args{qw(database table)}); my $index_hint = $args{index_hint} || ''; - MKDEBUG && _d('Parameters:', + PTDEBUG && _d('Parameters:', Dumper({WHERE => $where, DB_TBL => $db_tbl, INDEX_HINT => $index_hint})); $query =~ s!/\*WHERE\*/! $where!; $query =~ s!/\*DB_TBL\*/!$db_tbl!; @@ -3533,7 +3533,7 @@ sub value_to_number { } my $val = $args{value}; my ($col_type, $dbh) = @args{@required_args}; - MKDEBUG && _d('Converting MySQL', $col_type, $val); + PTDEBUG && _d('Converting MySQL', $col_type, $val); return unless defined $val; # value is NULL @@ -3551,7 +3551,7 @@ sub value_to_number { elsif ( $col_type =~ m/^(?:timestamp|date|time)$/ ) { my $func = $mysql_conv_func_for{$col_type}; my $sql = "SELECT $func(?)"; - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val); ($num) = $sth->fetchrow_array(); @@ -3562,7 +3562,7 @@ sub value_to_number { else { die "I don't know how to chunk $col_type\n"; } - MKDEBUG && _d('Converts to', $num); + PTDEBUG && _d('Converts to', $num); return $num; } @@ -3588,14 +3588,14 @@ sub range_num { sub range_time { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT SEC_TO_TIME($start), SEC_TO_TIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_date { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_DAYS($start), FROM_DAYS(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -3603,14 +3603,14 @@ sub range_datetime { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $start SECOND), " . "DATE_ADD('$self->{EPOCH}', INTERVAL LEAST($max, $start + $interval) SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_timestamp { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_UNIXTIME($start), FROM_UNIXTIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -3618,10 +3618,10 @@ sub timestampdiff { my ( $self, $dbh, $time ) = @_; my $sql = "SELECT (COALESCE(TO_DAYS('$time'), 0) * 86400 + TIME_TO_SEC('$time')) " . "- TO_DAYS('$self->{EPOCH} 00:00:00') * 86400"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $diff ) = $dbh->selectrow_array($sql); $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $diff SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $check ) = $dbh->selectrow_array($sql); die <<" EOF" Incorrect datetime math: given $time, calculated $diff but checked to $check. @@ -3653,7 +3653,7 @@ sub get_valid_end_points { my $valid_min = $real_min; if ( defined $valid_min ) { - MKDEBUG && _d("Validating min end point:", $real_min); + PTDEBUG && _d("Validating min end point:", $real_min); $valid_min = $self->_get_valid_end_point( %args, val => $real_min, @@ -3666,7 +3666,7 @@ sub get_valid_end_points { my $valid_max = $real_max; if ( defined $valid_max ) { - MKDEBUG && _d("Validating max end point:", $real_min); + PTDEBUG && _d("Validating max end point:", $real_min); $valid_max = $self->_get_valid_end_point( %args, val => $real_max, @@ -3695,13 +3695,13 @@ sub _get_valid_end_point { : undef; if ( !$validate ) { - MKDEBUG && _d("No validator for", $col_type, "values"); + PTDEBUG && _d("No validator for", $col_type, "values"); return $val; } return $val if defined $validate->($dbh, $val); - MKDEBUG && _d("Value is invalid, getting first valid value"); + PTDEBUG && _d("Value is invalid, getting first valid value"); $val = $self->get_first_valid_value( %args, val => $val, @@ -3731,20 +3731,20 @@ sub get_first_valid_value { . "WHERE $col $cmp ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : "") . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sth = $dbh->prepare($sql); my $last_val = $val; while ( $tries-- ) { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); - MKDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); + PTDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); if ( !defined $next_val ) { - MKDEBUG && _d('No more rows in table'); + PTDEBUG && _d('No more rows in table'); last; } if ( defined $validate->($dbh, $next_val) ) { - MKDEBUG && _d('First valid value:', $next_val); + PTDEBUG && _d('First valid value:', $next_val); $sth->finish(); return $next_val; } @@ -3761,14 +3761,14 @@ sub _validate_temporal_value { my $sql = "SELECT IF(TIME_FORMAT(?,'%H:%i:%s')=?, TIME_TO_SEC(?), TO_DAYS(?))"; my $res; eval { - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val, $val, $val, $val); ($res) = $sth->fetchrow_array(); $sth->finish(); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } return $res; } @@ -3787,13 +3787,13 @@ sub get_nonzero_value { : sub { return $_[1]; }; if ( !$is_nonzero->($dbh, $val) ) { # quasi-double-negative, sorry - MKDEBUG && _d('Discarding zero value:', $val); + PTDEBUG && _d('Discarding zero value:', $val); my $sql = "SELECT $col FROM $db_tbl " . ($args{index_hint} ? "$args{index_hint} " : "") . "WHERE $col > ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : '') . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); my $last_val = $val; @@ -3801,7 +3801,7 @@ sub get_nonzero_value { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); if ( $is_nonzero->($dbh, $next_val) ) { - MKDEBUG && _d('First non-zero value:', $next_val); + PTDEBUG && _d('First non-zero value:', $next_val); $sth->finish(); return $next_val; } @@ -3872,7 +3872,7 @@ package TableChecksum; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); @@ -3927,13 +3927,13 @@ sub get_crc_type { $sth->execute(); $type = $sth->{mysql_type_name}->[0]; $length = $sth->{mysql_length}->[0]; - MKDEBUG && _d($sql, $type, $length); + PTDEBUG && _d($sql, $type, $length); if ( $type eq 'bigint' && $length < 20 ) { $type = 'int'; } }; $sth->finish; - MKDEBUG && _d('crc_type:', $type, 'length:', $length); + PTDEBUG && _d('crc_type:', $type, 'length:', $length); return ($type, $length); } @@ -3950,26 +3950,26 @@ sub best_algorithm { || $args{replicate} # CHECKSUM can't do INSERT.. SELECT || !$vp->version_ge($dbh, '4.1.1')) # CHECKSUM doesn't exist { - MKDEBUG && _d('Cannot use CHECKSUM algorithm'); + PTDEBUG && _d('Cannot use CHECKSUM algorithm'); @choices = grep { $_ ne 'CHECKSUM' } @choices; } if ( !$vp->version_ge($dbh, '4.1.1') ) { - MKDEBUG && _d('Cannot use BIT_XOR algorithm because MySQL < 4.1.1'); + PTDEBUG && _d('Cannot use BIT_XOR algorithm because MySQL < 4.1.1'); @choices = grep { $_ ne 'BIT_XOR' } @choices; } if ( $alg && grep { $_ eq $alg } @choices ) { - MKDEBUG && _d('User requested', $alg, 'algorithm'); + PTDEBUG && _d('User requested', $alg, 'algorithm'); return $alg; } if ( $args{count} && grep { $_ ne 'CHECKSUM' } @choices ) { - MKDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired'); + PTDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired'); @choices = grep { $_ ne 'CHECKSUM' } @choices; } - MKDEBUG && _d('Algorithms, in order:', @choices); + PTDEBUG && _d('Algorithms, in order:', @choices); return $choices[0]; } @@ -3990,18 +3990,18 @@ sub choose_hash_func { eval { $func = shift(@funcs); my $sql = "SELECT $func('test-string')"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $args{dbh}->do($sql); $result = $func; }; if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) { $error .= qq{$func cannot be used because "$1"\n}; - MKDEBUG && _d($func, 'cannot be used because', $1); + PTDEBUG && _d($func, 'cannot be used because', $1); } } while ( @funcs && !$result ); die $error unless $result; - MKDEBUG && _d('Chosen hash func:', $result); + PTDEBUG && _d('Chosen hash func:', $result); return $result; } @@ -4019,7 +4019,7 @@ sub optimize_xor { my $crc_wid = length($unsliced) < 16 ? 16 : length($unsliced); do { # Try different positions till sliced result equals non-sliced. - MKDEBUG && _d('Trying slice', $opt_slice); + PTDEBUG && _d('Trying slice', $opt_slice); $dbh->do('SET @crc := "", @cnt := 0'); my $slices = $self->make_xor_slices( query => "\@crc := $func('a')", @@ -4030,18 +4030,18 @@ sub optimize_xor { my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x"; $sliced = ($dbh->selectrow_array($sql))[0]; if ( $sliced ne $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'does not work'); + PTDEBUG && _d('Slice', $opt_slice, 'does not work'); $start += 16; ++$opt_slice; } } while ( $start < $crc_wid && $sliced ne $unsliced ); if ( $sliced eq $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'works'); + PTDEBUG && _d('Slice', $opt_slice, 'works'); return $opt_slice; } else { - MKDEBUG && _d('No slice works'); + PTDEBUG && _d('No slice works'); return undef; } } @@ -4220,7 +4220,7 @@ sub find_replication_differences { . "WHERE master_cnt <> this_cnt OR master_crc <> this_crc " . "OR ISNULL(master_crc) <> ISNULL(this_crc)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} }); return @$diffs; } @@ -4253,7 +4253,7 @@ package TableSyncChunk; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4293,7 +4293,7 @@ sub can_sync { my $colno; if ( $args{chunk_col} || $args{chunk_index} ) { - MKDEBUG && _d('Checking requested col', $args{chunk_col}, + PTDEBUG && _d('Checking requested col', $args{chunk_col}, 'and/or index', $args{chunk_index}); for my $i ( 0..$#chunkable_cols ) { if ( $args{chunk_col} ) { @@ -4307,7 +4307,7 @@ sub can_sync { } if ( !$colno ) { - MKDEBUG && _d('Cannot chunk on column', $args{chunk_col}, + PTDEBUG && _d('Cannot chunk on column', $args{chunk_col}, 'and/or using index', $args{chunk_index}); return; } @@ -4316,7 +4316,7 @@ sub can_sync { $colno = 0; # First, best chunkable column/index. } - MKDEBUG && _d('Can chunk on column', $chunkable_cols[$colno]->{column}, + PTDEBUG && _d('Can chunk on column', $chunkable_cols[$colno]->{column}, 'using index', $chunkable_cols[$colno]->{index}); return ( 1, @@ -4351,7 +4351,7 @@ sub prepare_to_sync { @chunks = $chunker->calculate_chunks(%args, %range_params); } else { - MKDEBUG && _d('No range statistics; using single chunk 1=1'); + PTDEBUG && _d('No range statistics; using single chunk 1=1'); @chunks = '1=1'; } @@ -4378,7 +4378,7 @@ sub set_checksum_queries { sub prepare_sync_cycle { my ( $self, $host ) = @_; my $sql = 'SET @crc := "", @cnt := 0'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $host->{dbh}->do($sql); return; } @@ -4432,8 +4432,8 @@ sub same_row { } } elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) { - MKDEBUG && _d('Rows:', Dumper($lr, $rr)); - MKDEBUG && _d('Will examine this chunk before moving to next'); + PTDEBUG && _d('Rows:', Dumper($lr, $rr)); + PTDEBUG && _d('Will examine this chunk before moving to next'); $self->{state} = 1; # Must examine this chunk row-by-row } } @@ -4484,12 +4484,12 @@ sub done_with_rows { my ( $self ) = @_; if ( $self->{state} == 1 ) { $self->{state} = 2; - MKDEBUG && _d('Setting state =', $self->{state}); + PTDEBUG && _d('Setting state =', $self->{state}); } else { $self->{state} = 0; $self->{chunk_num}++; - MKDEBUG && _d('Setting state =', $self->{state}, + PTDEBUG && _d('Setting state =', $self->{state}, 'chunk_num =', $self->{chunk_num}); } return; @@ -4497,9 +4497,9 @@ sub done_with_rows { sub done { my ( $self ) = @_; - MKDEBUG && _d('Done with', $self->{chunk_num}, 'of', + PTDEBUG && _d('Done with', $self->{chunk_num}, 'of', scalar(@{$self->{chunks}}), 'chunks'); - MKDEBUG && $self->{state} && _d('Chunk differs; must examine rows'); + PTDEBUG && $self->{state} && _d('Chunk differs; must examine rows'); return $self->{state} == 0 && $self->{chunk_num} >= scalar(@{$self->{chunks}}) } @@ -4507,11 +4507,11 @@ sub done { sub pending_changes { my ( $self ) = @_; if ( $self->{state} ) { - MKDEBUG && _d('There are pending changes'); + PTDEBUG && _d('There are pending changes'); return 1; } else { - MKDEBUG && _d('No pending changes'); + PTDEBUG && _d('No pending changes'); return 0; } } @@ -4525,7 +4525,7 @@ sub key_cols { else { @cols = $self->{chunk_col}; } - MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); + PTDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); return \@cols; } @@ -4557,7 +4557,7 @@ package TableSyncNibble; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -4585,19 +4585,19 @@ sub can_sync { my $nibble_index = $self->{TableParser}->find_best_index($args{tbl_struct}); if ( $nibble_index ) { - MKDEBUG && _d('Best nibble index:', Dumper($nibble_index)); + PTDEBUG && _d('Best nibble index:', Dumper($nibble_index)); if ( !$args{tbl_struct}->{keys}->{$nibble_index}->{is_unique} ) { - MKDEBUG && _d('Best nibble index is not unique'); + PTDEBUG && _d('Best nibble index is not unique'); return; } if ( $args{chunk_index} && $args{chunk_index} ne $nibble_index ) { - MKDEBUG && _d('Best nibble index is not requested index', + PTDEBUG && _d('Best nibble index is not requested index', $args{chunk_index}); return; } } else { - MKDEBUG && _d('No best nibble index returned'); + PTDEBUG && _d('No best nibble index returned'); return; } @@ -4610,10 +4610,10 @@ sub can_sync { eval { my $sql = "SHOW TABLE STATUS FROM `$db` LIKE " . $self->{Quoter}->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $table_status = $dbh->selectrow_hashref($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); if ( $table_status ) { my $n_rows = defined $table_status->{Rows} ? $table_status->{Rows} : defined $table_status->{rows} ? $table_status->{rows} @@ -4621,9 +4621,9 @@ sub can_sync { $small_table = 1 if defined $n_rows && $n_rows <= 100; } } - MKDEBUG && _d('Small table:', $small_table); + PTDEBUG && _d('Small table:', $small_table); - MKDEBUG && _d('Can nibble using index', $nibble_index); + PTDEBUG && _d('Can nibble using index', $nibble_index); return ( 1, chunk_index => $nibble_index, @@ -4687,7 +4687,7 @@ sub set_checksum_queries { sub prepare_sync_cycle { my ( $self, $host ) = @_; my $sql = 'SET @crc := "", @cnt := 0'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $host->{dbh}->do($sql); return; } @@ -4729,16 +4729,16 @@ sub __get_boundaries { my $row; # Next upper boundary row or cached_row if ( $self->{cached_boundaries} ) { - MKDEBUG && _d('Using cached boundaries'); + PTDEBUG && _d('Using cached boundaries'); return $self->{cached_boundaries}; } if ( $self->{cached_row} && $self->{cached_nibble} == $self->{nibble} ) { - MKDEBUG && _d('Using cached row for boundaries'); + PTDEBUG && _d('Using cached row for boundaries'); $row = $self->{cached_row}; } else { - MKDEBUG && _d('Getting next upper boundary row'); + PTDEBUG && _d('Getting next upper boundary row'); my $sql; ($sql, $lb) = $self->__make_boundary_sql(%args); # $lb from outer scope! @@ -4753,7 +4753,7 @@ sub __get_boundaries { } $row = $self->{dbh}->selectrow_hashref($sql); - MKDEBUG && _d($row ? 'Got a row' : "Didn't get a row"); + PTDEBUG && _d($row ? 'Got a row' : "Didn't get a row"); } if ( $row ) { @@ -4762,7 +4762,7 @@ sub __get_boundaries { $ub =~ s/\?/$q->quote_val($row->{$s->{scols}->[$i]}, $self->{tbl_struct}->{is_numeric}->{$s->{scols}->[$i++]} || 0)/eg; } else { - MKDEBUG && _d('No upper boundary'); + PTDEBUG && _d('No upper boundary'); $ub = '1=1'; } @@ -4772,7 +4772,7 @@ sub __get_boundaries { $self->{cached_nibble} = $self->{nibble}; $self->{cached_boundaries} = $where; - MKDEBUG && _d('WHERE clause:', $where); + PTDEBUG && _d('WHERE clause:', $where); return $where; } @@ -4796,8 +4796,8 @@ sub __make_boundary_sql { } $sql .= " ORDER BY " . join(',', map { $q->quote($_) } @{$self->{key_cols}}) . ' LIMIT ' . ($self->{chunk_size} - 1) . ', 1'; - MKDEBUG && _d('Lower boundary:', $lb); - MKDEBUG && _d('Next boundary sql:', $sql); + PTDEBUG && _d('Lower boundary:', $lb); + PTDEBUG && _d('Next boundary sql:', $sql); return $sql, $lb; } @@ -4809,10 +4809,10 @@ sub __get_explain_index { $explain = $self->{dbh}->selectall_arrayref("EXPLAIN $sql",{Slice => {}}); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return; } - MKDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); + PTDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); return $explain->[0]->{key}; } @@ -4825,8 +4825,8 @@ sub same_row { } } elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) { - MKDEBUG && _d('Rows:', Dumper($lr, $rr)); - MKDEBUG && _d('Will examine this nibble before moving to next'); + PTDEBUG && _d('Rows:', Dumper($lr, $rr)); + PTDEBUG && _d('Will examine this nibble before moving to next'); $self->{state} = 1; # Must examine this nibble row-by-row } } @@ -4847,32 +4847,32 @@ sub done_with_rows { my ( $self ) = @_; if ( $self->{state} == 1 ) { $self->{state} = 2; - MKDEBUG && _d('Setting state =', $self->{state}); + PTDEBUG && _d('Setting state =', $self->{state}); } else { $self->{state} = 0; $self->{nibble}++; delete $self->{cached_boundaries}; - MKDEBUG && _d('Setting state =', $self->{state}, + PTDEBUG && _d('Setting state =', $self->{state}, ', nibble =', $self->{nibble}); } } sub done { my ( $self ) = @_; - MKDEBUG && _d('Done with nibble', $self->{nibble}); - MKDEBUG && $self->{state} && _d('Nibble differs; must examine rows'); + PTDEBUG && _d('Done with nibble', $self->{nibble}); + PTDEBUG && $self->{state} && _d('Nibble differs; must examine rows'); return $self->{state} == 0 && $self->{nibble} && !$self->{cached_row}; } sub pending_changes { my ( $self ) = @_; if ( $self->{state} ) { - MKDEBUG && _d('There are pending changes'); + PTDEBUG && _d('There are pending changes'); return 1; } else { - MKDEBUG && _d('No pending changes'); + PTDEBUG && _d('No pending changes'); return 0; } } @@ -4886,7 +4886,7 @@ sub key_cols { else { @cols = @{$self->{key_cols}}; } - MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); + PTDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); return \@cols; } @@ -4918,7 +4918,7 @@ package TableSyncGroupBy; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4952,7 +4952,7 @@ sub prepare_to_sync { while ( $args{tbl_struct}->{is_col}->{$self->{count_col}} ) { $self->{count_col} = "_$self->{count_col}"; } - MKDEBUG && _d('COUNT column will be named', $self->{count_col}); + PTDEBUG && _d('COUNT column will be named', $self->{count_col}); $self->{done} = 0; @@ -5073,7 +5073,7 @@ package TableSyncer; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -5095,16 +5095,16 @@ sub get_best_plugin { foreach my $arg ( qw(plugins tbl_struct) ) { die "I need a $arg argument" unless $args{$arg}; } - MKDEBUG && _d('Getting best plugin'); + PTDEBUG && _d('Getting best plugin'); foreach my $plugin ( @{$args{plugins}} ) { - MKDEBUG && _d('Trying plugin', $plugin->name); + PTDEBUG && _d('Trying plugin', $plugin->name); my ($can_sync, %plugin_args) = $plugin->can_sync(%args); if ( $can_sync ) { - MKDEBUG && _d('Can sync with', $plugin->name, Dumper(\%plugin_args)); + PTDEBUG && _d('Can sync with', $plugin->name, Dumper(\%plugin_args)); return $plugin, %plugin_args; } } - MKDEBUG && _d('No plugin can sync the table'); + PTDEBUG && _d('No plugin can sync the table'); return; } @@ -5115,7 +5115,7 @@ sub sync_table { foreach my $arg ( @required_args ) { die "I need a $arg argument" unless $args{$arg}; } - MKDEBUG && _d('Syncing table with args:', + PTDEBUG && _d('Syncing table with args:', map { "$_: " . Dumper($args{$_}) } qw(plugins src dst tbl_struct cols chunk_size)); @@ -5144,21 +5144,21 @@ sub sync_table { while ( $tbl_struct->{is_col}->{$crc_col} ) { $crc_col = "_$crc_col"; # Prepend more _ until not a column. } - MKDEBUG && _d('CRC column:', $crc_col); + PTDEBUG && _d('CRC column:', $crc_col); my $index_hint; my $hint = ($vp->version_ge($src->{dbh}, '4.0.9') && $vp->version_ge($dst->{dbh}, '4.0.9') ? 'FORCE' : 'USE') . ' INDEX'; if ( $args{chunk_index} ) { - MKDEBUG && _d('Using given chunk index for index hint'); + PTDEBUG && _d('Using given chunk index for index hint'); $index_hint = "$hint (" . $q->quote($args{chunk_index}) . ")"; } elsif ( $plugin_args{chunk_index} && $args{index_hint} ) { - MKDEBUG && _d('Using chunk index chosen by plugin for index hint'); + PTDEBUG && _d('Using chunk index chosen by plugin for index hint'); $index_hint = "$hint (" . $q->quote($plugin_args{chunk_index}) . ")"; } - MKDEBUG && _d('Index hint:', $index_hint); + PTDEBUG && _d('Index hint:', $index_hint); eval { $plugin->prepare_to_sync( @@ -5199,8 +5199,8 @@ sub sync_table { die "Failed to USE database on source or destination: $EVAL_ERROR"; } - MKDEBUG && _d('left dbh', $src->{dbh}); - MKDEBUG && _d('right dbh', $dst->{dbh}); + PTDEBUG && _d('left dbh', $src->{dbh}); + PTDEBUG && _d('right dbh', $dst->{dbh}); chomp(my $hostname = `hostname`); my $trace_msg @@ -5214,7 +5214,7 @@ sub sync_table { . ($ENV{USER} ? "user:$ENV{USER} " : "") . ($hostname ? "host:$hostname" : "") : ""; - MKDEBUG && _d("Binlog trace message:", $trace_msg); + PTDEBUG && _d("Binlog trace message:", $trace_msg); $self->lock_and_wait(%args, lock_level => 2); # per-table lock @@ -5222,7 +5222,7 @@ sub sync_table { my $cycle = 0; while ( !$plugin->done() ) { - MKDEBUG && _d('Beginning sync cycle', $cycle); + PTDEBUG && _d('Beginning sync cycle', $cycle); my $src_sql = $plugin->get_sql( database => $src->{db}, table => $src->{tbl}, @@ -5248,8 +5248,8 @@ sub sync_table { $dst_sql .= ' FOR UPDATE'; } } - MKDEBUG && _d('src:', $src_sql); - MKDEBUG && _d('dst:', $dst_sql); + PTDEBUG && _d('src:', $src_sql); + PTDEBUG && _d('dst:', $dst_sql); $callback->($src_sql, $dst_sql) if $callback; @@ -5282,7 +5282,7 @@ sub sync_table { ); $ch->process_rows(1, $trace_msg); - MKDEBUG && _d('Finished sync cycle', $cycle); + PTDEBUG && _d('Finished sync cycle', $cycle); $cycle++; } @@ -5320,7 +5320,7 @@ sub make_checksum_queries { die "Source and destination checksum algorithms are different: ", "$src_algo on source, $dst_algo on destination" } - MKDEBUG && _d('Chosen algo:', $src_algo); + PTDEBUG && _d('Chosen algo:', $src_algo); my $src_func = $checksum->choose_hash_func(dbh => $src->{dbh}, %args); my $dst_func = $checksum->choose_hash_func(dbh => $dst->{dbh}, %args); @@ -5328,7 +5328,7 @@ sub make_checksum_queries { die "Source and destination hash functions are different: ", "$src_func on source, $dst_func on destination"; } - MKDEBUG && _d('Chosen hash func:', $src_func); + PTDEBUG && _d('Chosen hash func:', $src_func); my $crc_wid = $checksum->get_crc_wid($src->{dbh}, $src_func); @@ -5352,21 +5352,21 @@ sub make_checksum_queries { opt_slice => $opt_slice, replicate => undef, # replicate means something different to this sub ); # than what we use it for; do not pass it! - MKDEBUG && _d('Chunk sql:', $chunk_sql); + PTDEBUG && _d('Chunk sql:', $chunk_sql); my $row_sql = $checksum->make_row_checksum( %args, function => $src_func, ); - MKDEBUG && _d('Row sql:', $row_sql); + PTDEBUG && _d('Row sql:', $row_sql); return $chunk_sql, $row_sql; } sub lock_table { my ( $self, $dbh, $where, $db_tbl, $mode ) = @_; my $query = "LOCK TABLES $db_tbl $mode"; - MKDEBUG && _d($query); + PTDEBUG && _d($query); $dbh->do($query); - MKDEBUG && _d('Acquired table lock on', $where, 'in', $mode, 'mode'); + PTDEBUG && _d('Acquired table lock on', $where, 'in', $mode, 'mode'); } sub unlock { @@ -5382,12 +5382,12 @@ sub unlock { foreach my $dbh ( $src->{dbh}, $dst->{dbh} ) { if ( $args{transaction} ) { - MKDEBUG && _d('Committing', $dbh); + PTDEBUG && _d('Committing', $dbh); $dbh->commit(); } else { my $sql = 'UNLOCK TABLES'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } } @@ -5406,32 +5406,32 @@ sub lock_and_wait { my $dst = $args{dst}; return unless $args{lock} && $args{lock} == $args{lock_level}; - MKDEBUG && _d('lock and wait, lock level', $args{lock}); + PTDEBUG && _d('lock and wait, lock level', $args{lock}); foreach my $dbh ( $src->{dbh}, $dst->{dbh} ) { if ( $args{transaction} ) { - MKDEBUG && _d('Committing', $dbh); + PTDEBUG && _d('Committing', $dbh); $dbh->commit(); } else { my $sql = 'UNLOCK TABLES'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } } if ( $args{lock} == 3 ) { my $sql = 'FLUSH TABLES WITH READ LOCK'; - MKDEBUG && _d($src->{dbh}, $sql); + PTDEBUG && _d($src->{dbh}, $sql); $src->{dbh}->do($sql); } else { if ( $args{transaction} ) { if ( $args{src_sth} ) { - MKDEBUG && _d('Executing statement on source to lock rows'); + PTDEBUG && _d('Executing statement on source to lock rows'); my $sql = "START TRANSACTION /*!40108 WITH CONSISTENT SNAPSHOT */"; - MKDEBUG && _d($src->{dbh}, $sql); + PTDEBUG && _d($src->{dbh}, $sql); $src->{dbh}->do($sql); $args{src_sth}->execute(); @@ -5502,13 +5502,13 @@ sub lock_and_wait { } if ( $args{changing_src} ) { - MKDEBUG && _d('Not locking destination because changing source ', + PTDEBUG && _d('Not locking destination because changing source ', '(syncing via replication or sync-to-master)'); } else { if ( $args{lock} == 3 ) { my $sql = 'FLUSH TABLES WITH READ LOCK'; - MKDEBUG && _d($dst->{dbh}, ',', $sql); + PTDEBUG && _d($dst->{dbh}, ',', $sql); $dst->{dbh}->do($sql); } elsif ( !$args{transaction} ) { @@ -5524,7 +5524,7 @@ sub lock_and_wait { } foreach my $dbh ( $src->{dbh}, $dst->{dbh}, $src->{misc_dbh} ) { next unless $dbh; - MKDEBUG && _d('Caught error, unlocking/committing on', $dbh); + PTDEBUG && _d('Caught error, unlocking/committing on', $dbh); $dbh->do('UNLOCK TABLES'); $dbh->commit() unless $dbh->{AutoCommit}; } @@ -5538,23 +5538,23 @@ sub have_all_privs { my ( $self, $dbh, $db, $tbl ) = @_; my $db_tbl = $self->{Quoter}->quote($db, $tbl); my $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d('Permissions check:', $sql); + PTDEBUG && _d('Permissions check:', $sql); my $cols = $dbh->selectall_arrayref($sql, {Slice => {}}); my ($hdr_name) = grep { m/privileges/i } keys %{$cols->[0]}; my $privs = $cols->[0]->{$hdr_name}; $sql = "DELETE FROM $db_tbl LIMIT 0"; # FULL COLUMNS doesn't show all privs - MKDEBUG && _d('Permissions check:', $sql); + PTDEBUG && _d('Permissions check:', $sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( $privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete ) { - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } @@ -5586,7 +5586,7 @@ package TableNibbler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -5615,11 +5615,11 @@ sub generate_asc_stmt { my @asc_slice; @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; - MKDEBUG && _d('Will ascend index', $index); - MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); + PTDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); if ( $args{asc_first} ) { @asc_cols = $asc_cols[0]; - MKDEBUG && _d('Ascending only first column'); + PTDEBUG && _d('Ascending only first column'); } my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; @@ -5630,7 +5630,7 @@ sub generate_asc_stmt { } push @asc_slice, $col_posn{$col}; } - MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); + PTDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); my $asc_stmt = { cols => \@cols, @@ -5751,7 +5751,7 @@ sub generate_del_stmt { else { @del_cols = @{$tbl->{cols}}; } - MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); + PTDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; foreach my $col ( @del_cols ) { @@ -5761,7 +5761,7 @@ sub generate_del_stmt { } push @del_slice, $col_posn{$col}; } - MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); + PTDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); my $del_stmt = { cols => \@cols, @@ -5845,7 +5845,7 @@ package MasterSlave; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -5866,7 +5866,7 @@ sub recurse_to_slaves { eval { $dbh = $args->{dbh} || $dp->get_dbh( $dp->get_cxn_params($dsn), { AutoCommit => 1 }); - MKDEBUG && _d('Connected to', $dp->as_string($dsn)); + PTDEBUG && _d('Connected to', $dp->as_string($dsn)); }; if ( $EVAL_ERROR ) { print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n" @@ -5875,15 +5875,15 @@ sub recurse_to_slaves { } my $sql = 'SELECT @@SERVER_ID'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ($id) = $dbh->selectrow_array($sql); - MKDEBUG && _d('Working on server ID', $id); + PTDEBUG && _d('Working on server ID', $id); my $master_thinks_i_am = $dsn->{server_id}; if ( !defined $id || ( defined $master_thinks_i_am && $master_thinks_i_am != $id ) || $args->{server_ids_seen}->{$id}++ ) { - MKDEBUG && _d('Server ID seen, or not what master said'); + PTDEBUG && _d('Server ID seen, or not what master said'); if ( $args->{skip_callback} ) { $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent}); } @@ -5899,7 +5899,7 @@ sub recurse_to_slaves { $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method}); foreach my $slave ( @slaves ) { - MKDEBUG && _d('Recursing from', + PTDEBUG && _d('Recursing from', $dp->as_string($dsn), 'to', $dp->as_string($slave)); $self->recurse_to_slaves( { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 ); @@ -5917,23 +5917,23 @@ sub find_slave_hosts { } else { if ( ($dsn->{P} || 3306) != 3306 ) { - MKDEBUG && _d('Port number is non-standard; using only hosts method'); + PTDEBUG && _d('Port number is non-standard; using only hosts method'); @methods = qw(hosts); } } - MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), + PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn), 'using methods', @methods); my @slaves; METHOD: foreach my $method ( @methods ) { my $find_slaves = "_find_slaves_by_$method"; - MKDEBUG && _d('Finding slaves with', $find_slaves); + PTDEBUG && _d('Finding slaves with', $find_slaves); @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn); last METHOD if @slaves; } - MKDEBUG && _d('Found', scalar(@slaves), 'slaves'); + PTDEBUG && _d('Found', scalar(@slaves), 'slaves'); return @slaves; } @@ -5962,11 +5962,11 @@ sub _find_slaves_by_hosts { my @slaves; my $sql = 'SHOW SLAVE HOSTS'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })}; if ( @slaves ) { - MKDEBUG && _d('Found some SHOW SLAVE HOSTS info'); + PTDEBUG && _d('Found some SHOW SLAVE HOSTS info'); @slaves = map { my %hash; @hash{ map { lc $_ } keys %$_ } = values %$_; @@ -5995,7 +5995,7 @@ sub get_connected_slaves { $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; } my $sql = $show . $user; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $proc; eval { @@ -6006,11 +6006,11 @@ sub get_connected_slaves { if ( $EVAL_ERROR ) { if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) { - MKDEBUG && _d('Retrying SHOW GRANTS without host; error:', + PTDEBUG && _d('Retrying SHOW GRANTS without host; error:', $EVAL_ERROR); ($user) = split('@', $user); $sql = $show . $user; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $proc = grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ @@ -6025,7 +6025,7 @@ sub get_connected_slaves { } $sql = 'SHOW PROCESSLIST'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); grep { $_->{command} =~ m/Binlog Dump/i } map { # Lowercase the column names my %hash; @@ -6085,7 +6085,7 @@ sub get_slave_status { if ( !$self->{not_a_slave}->{$dbh} ) { my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS} ||= $dbh->prepare('SHOW SLAVE STATUS'); - MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); + PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS'); $sth->execute(); my ($ss) = @{$sth->fetchall_arrayref({})}; @@ -6094,7 +6094,7 @@ sub get_slave_status { return $ss; } - MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); + PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS'); $self->{not_a_slave}->{$dbh}++; } } @@ -6103,21 +6103,21 @@ sub get_master_status { my ( $self, $dbh ) = @_; if ( $self->{not_a_master}->{$dbh} ) { - MKDEBUG && _d('Server on dbh', $dbh, 'is not a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'is not a master'); return; } my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS} ||= $dbh->prepare('SHOW MASTER STATUS'); - MKDEBUG && _d($dbh, 'SHOW MASTER STATUS'); + PTDEBUG && _d($dbh, 'SHOW MASTER STATUS'); $sth->execute(); my ($ms) = @{$sth->fetchall_arrayref({})}; - MKDEBUG && _d( + PTDEBUG && _d( $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms : ''); if ( !$ms || scalar keys %$ms < 2 ) { - MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); + PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master'); $self->{not_a_master}->{$dbh}++; } @@ -6138,17 +6138,17 @@ sub wait_for_master { if ( $master_status ) { my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', " . "$master_status->{position}, $timeout)"; - MKDEBUG && _d($slave_dbh, $sql); + PTDEBUG && _d($slave_dbh, $sql); my $start = time; ($result) = $slave_dbh->selectrow_array($sql); $waited = time - $start; - MKDEBUG && _d('Result of waiting:', $result); - MKDEBUG && _d("Waited", $waited, "seconds"); + PTDEBUG && _d('Result of waiting:', $result); + PTDEBUG && _d("Waited", $waited, "seconds"); } else { - MKDEBUG && _d('Not waiting: this server is not a master'); + PTDEBUG && _d('Not waiting: this server is not a master'); } return { @@ -6161,7 +6161,7 @@ sub stop_slave { my ( $self, $dbh ) = @_; my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE} ||= $dbh->prepare('STOP SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } @@ -6170,13 +6170,13 @@ sub start_slave { if ( $pos ) { my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', " . "MASTER_LOG_POS=$pos->{position}"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } else { my $sth = $self->{sths}->{$dbh}->{START_SLAVE} ||= $dbh->prepare('START SLAVE'); - MKDEBUG && _d($dbh, $sth->{Statement}); + PTDEBUG && _d($dbh, $sth->{Statement}); $sth->execute(); } } @@ -6189,12 +6189,12 @@ sub catchup_to_master { my $slave_pos = $self->repl_posn($slave_status); my $master_status = $self->get_master_status($master); my $master_pos = $self->repl_posn($master_status); - MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos), + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); my $result; if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) { - MKDEBUG && _d('Waiting for slave to catch up to master'); + PTDEBUG && _d('Waiting for slave to catch up to master'); $self->start_slave($slave, $master_pos); $result = $self->wait_for_master( @@ -6206,7 +6206,7 @@ sub catchup_to_master { if ( !defined $result->{result} ) { $slave_status = $self->get_slave_status($slave); if ( !$self->slave_is_running($slave_status) ) { - MKDEBUG && _d('Master position:', + PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos), 'Slave position:', $self->pos_to_string($slave_pos)); $slave_pos = $self->repl_posn($slave_status); @@ -6214,7 +6214,7 @@ sub catchup_to_master { die "MASTER_POS_WAIT() returned NULL but slave has not " . "caught up to master"; } - MKDEBUG && _d('Slave is caught up to master and stopped'); + PTDEBUG && _d('Slave is caught up to master and stopped'); } else { die "Slave has not caught up to master and it is still running"; @@ -6222,7 +6222,7 @@ sub catchup_to_master { } } else { - MKDEBUG && _d("Slave is already caught up to master"); + PTDEBUG && _d("Slave is already caught up to master"); } return $result; @@ -6265,7 +6265,7 @@ sub slave_is_running { sub has_slave_updates { my ( $self, $dbh ) = @_; my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'}; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($name, $value) = $dbh->selectrow_array($sql); return $value && $value =~ m/^(1|ON)$/; } @@ -6327,12 +6327,12 @@ sub is_replication_thread { } if ( !$match ) { if ( ($query->{User} || $query->{user} || '') eq "system user" ) { - MKDEBUG && _d("Slave replication thread"); + PTDEBUG && _d("Slave replication thread"); if ( $type ne 'all' ) { my $state = $query->{State} || $query->{state} || ''; if ( $state =~ m/^init|end$/ ) { - MKDEBUG && _d("Special state:", $state); + PTDEBUG && _d("Special state:", $state); $match = 1; } else { @@ -6353,7 +6353,7 @@ sub is_replication_thread { } } else { - MKDEBUG && _d('Not system user'); + PTDEBUG && _d('Not system user'); } if ( !defined $args{check_known_ids} || $args{check_known_ids} ) { @@ -6363,14 +6363,14 @@ sub is_replication_thread { } else { if ( $self->{replication_thread}->{$id} ) { - MKDEBUG && _d("Thread ID is a known replication thread ID"); + PTDEBUG && _d("Thread ID is a known replication thread ID"); $match = 1; } } } } - MKDEBUG && _d('Matches', $type, 'replication thread:', + PTDEBUG && _d('Matches', $type, 'replication thread:', ($match ? 'yes' : 'no'), '; match:', $match); return $match; @@ -6411,7 +6411,7 @@ sub get_replication_filters { ); my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $row = $dbh->selectrow_arrayref($sql); $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF'; } @@ -6460,7 +6460,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -6478,17 +6478,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -6530,19 +6530,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -6560,7 +6560,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -6580,7 +6580,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -6593,7 +6593,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -6602,10 +6602,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -6647,7 +6647,7 @@ $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -6752,7 +6752,7 @@ sub make_filter { my ($db, undef) = split(/\./, $_); $dbs->{$db} = 1; } keys %permit_qtbls; - MKDEBUG && _d('Adding restriction "--databases', + PTDEBUG && _d('Adding restriction "--databases', (join(',', keys %$dbs) . '"')); if ( keys %$dbs ) { $o->set('databases', $dbs); @@ -6780,12 +6780,12 @@ sub make_filter { ' my $sql = "SHOW TABLE STATUS "', ' . ($db ? "FROM `$db`" : "")', ' . " LIKE \'$tbl\'";', - ' MKDEBUG && _d($sql);', + ' PTDEBUG && _d($sql);', ' eval {', ' $engine = $dbh->selectrow_hashref($sql)->{engine};', ' };', - ' MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);', - ' MKDEBUG && _d($tbl, "uses engine", $engine);', + ' PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);', + ' PTDEBUG && _d($tbl, "uses engine", $engine);', ' $engine = lc $engine if $engine;', @permit_engs = _make_filter('unless', '$engine', $o->get('engines'), 1); @@ -6811,11 +6811,11 @@ sub make_filter { } push @lines, - ' MKDEBUG && _d(\'Passes filters:\', $db, $tbl, $engine, $dbh);', + ' PTDEBUG && _d(\'Passes filters:\', $db, $tbl, $engine, $dbh);', ' return 1;', '}'; my $code = join("\n", @lines); - MKDEBUG && _d('filter sub:', $code); + PTDEBUG && _d('filter sub:', $code); my $filter_sub= eval $code or die "Error compiling subroutine code:\n$code\n$EVAL_ERROR"; @@ -6825,7 +6825,7 @@ sub make_filter { sub set_filter { my ( $self, $filter_sub ) = @_; $self->{filter} = $filter_sub; - MKDEBUG && _d('Set filter sub'); + PTDEBUG && _d('Set filter sub'); return; } @@ -6841,16 +6841,16 @@ sub get_db_itr { my @dbs; eval { my $sql = 'SHOW DATABASES'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); @dbs = grep { my $ok = $filter ? $filter->($dbh, $_, undef) : 1; $ok = 0 if $_ =~ m/information_schema|performance_schema|lost\+found/; $ok; } @{ $dbh->selectcol_arrayref($sql) }; - MKDEBUG && _d('Found', scalar @dbs, 'databases'); + PTDEBUG && _d('Found', scalar @dbs, 'databases'); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); my $iterator = sub { return shift @dbs; }; @@ -6877,7 +6877,7 @@ sub get_tbl_itr { eval { my $sql = 'SHOW /*!50002 FULL*/ TABLES FROM ' . $self->{Quoter}->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); @tbls = map { $_->[0] } @@ -6890,12 +6890,12 @@ sub get_tbl_itr { $ok; } @{ $dbh->selectall_arrayref($sql) }; - MKDEBUG && _d('Found', scalar @tbls, 'tables in', $db); + PTDEBUG && _d('Found', scalar @tbls, 'tables in', $db); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); } else { - MKDEBUG && _d('No db given so no tables'); + PTDEBUG && _d('No db given so no tables'); } my $iterator = sub { @@ -6949,7 +6949,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -7129,36 +7129,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -7205,7 +7205,7 @@ package Retry; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -7226,35 +7226,35 @@ sub retry { my $tryno = 0; while ( ++$tryno <= $tries ) { - MKDEBUG && _d("Retry", $tryno, "of", $tries); + PTDEBUG && _d("Retry", $tryno, "of", $tries); my $result; eval { $result = $try->(tryno=>$tryno); }; if ( defined $result ) { - MKDEBUG && _d("Try code succeeded"); + PTDEBUG && _d("Try code succeeded"); if ( my $on_success = $args{on_success} ) { - MKDEBUG && _d("Calling on_success code"); + PTDEBUG && _d("Calling on_success code"); $on_success->(tryno=>$tryno, result=>$result); } return $result; } if ( $EVAL_ERROR ) { - MKDEBUG && _d("Try code died:", $EVAL_ERROR); + PTDEBUG && _d("Try code died:", $EVAL_ERROR); die $EVAL_ERROR unless $args{retry_on_die}; } if ( $tryno < $tries ) { - MKDEBUG && _d("Try code failed, calling wait code"); + PTDEBUG && _d("Try code failed, calling wait code"); $wait->(tryno=>$tryno); } } - MKDEBUG && _d("Try code did not succeed"); + PTDEBUG && _d("Try code did not succeed"); if ( my $on_failure = $args{on_failure} ) { - MKDEBUG && _d("Calling on_failure code"); + PTDEBUG && _d("Calling on_failure code"); $on_failure->(); } @@ -7292,7 +7292,7 @@ use Data::Dumper; Transformers->import(qw(time_to_secs any_unix_timestamp)); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; $OUTPUT_AUTOFLUSH = 1; @@ -7456,7 +7456,7 @@ sub main { die "The $algo algorithm is not available. Available algorithms: " . join(", ", sort keys %have_plugin); } - MKDEBUG && _d('Loading', $plugin_name); + PTDEBUG && _d('Loading', $plugin_name); my $plugin; eval { $plugin = $plugin_name->new(%modules); @@ -7482,7 +7482,7 @@ sub main { # --sync-to-master, then dsn[0] is a slave. Find its master and # make the master dsn[0] and the slave dsn[1]. if ( $o->get('sync-to-master') ) { - MKDEBUG && _d('Getting master of', $dp->as_string($dsns[0])); + PTDEBUG && _d('Getting master of', $dp->as_string($dsns[0])); $dsns[0]->{dbh} = get_cxn($dsns[0], %modules); my $master = $ms->get_master_dsn($dsns[0]->{dbh}, $dsns[0], $dp) or die "Can't determine master of " . $dp->as_string($dsns[0]); @@ -7553,7 +7553,7 @@ sub lock_and_rename { my $dp = $args{DSNParser}; my $q = $args{Quoter}; - MKDEBUG && _d('Locking and syncing ONE TABLE with rename'); + PTDEBUG && _d('Locking and syncing ONE TABLE with rename'); my $src = { dsn => $dsns->[0], dbh => $dsns->[0]->{dbh} || get_cxn($dsns->[0], %args), @@ -7579,10 +7579,10 @@ sub lock_and_rename { my $dst_db_tbl = $q->quote($dst->{db}, $dst->{tbl}); my $tmp_db_tbl = $q->quote($src->{db}, $src->{tbl} . "_tmp_$PID"); my $sql = "LOCK TABLES $src_db_tbl WRITE"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $src->{dbh}->do($sql); $sql = "LOCK TABLES $dst_db_tbl WRITE"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dst->{dbh}->do($sql); my $exit_status = sync_a_table( @@ -7593,16 +7593,16 @@ sub lock_and_rename { # Now rename the tables to swap them. $sql = "ALTER TABLE $src_db_tbl RENAME $tmp_db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $src->{dbh}->do($sql); $sql = "ALTER TABLE $dst_db_tbl RENAME $src_db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dst->{dbh}->do($sql); $sql = "UNLOCK TABLES"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $src->{dbh}->do($sql); $sql = "ALTER TABLE $tmp_db_tbl RENAME $dst_db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $src->{dbh}->do($sql); unlock_server(src => $src, dst => $dst, %args); @@ -7643,7 +7643,7 @@ sub sync_one_table { my $o = $args{OptionParser}; my $dp = $args{DSNParser}; - MKDEBUG && _d('DSN has t part; syncing ONE TABLE between servers'); + PTDEBUG && _d('DSN has t part; syncing ONE TABLE between servers'); my $src = { dsn => $dsns[0], dbh => $dsns[0]->{dbh} || get_cxn($dsns[0], %args), @@ -7725,7 +7725,7 @@ sub sync_via_replication { my $checksum = $args{TableChecksum}; my $ms = $args{MasterSlave}; - MKDEBUG && _d('Syncing via replication'); + PTDEBUG && _d('Syncing via replication'); my $src = { dsn => $dsns->[0], dbh => $dsns->[0]->{dbh} || get_cxn($dsns->[0], %args), @@ -7793,7 +7793,7 @@ sub sync_via_replication { unlock_server(src => $src, dst => $dst, %args); } else { - MKDEBUG && _d('No checksum differences'); + PTDEBUG && _d('No checksum differences'); } disconnect($dst); @@ -7863,7 +7863,7 @@ sub sync_via_replication { disconnect($dst); } else { - MKDEBUG && _d('No checksum differences'); + PTDEBUG && _d('No checksum differences'); } } # this is a slave @@ -7910,7 +7910,7 @@ sub sync_all { my $o = $args{OptionParser}; my $dp = $args{DSNParser}; - MKDEBUG && _d('Syncing all dbs and tbls'); + PTDEBUG && _d('Syncing all dbs and tbls'); my $src = { dsn => $dsns[0], dbh => $dsns[0]->{dbh} || get_cxn($dsns[0], %args), @@ -7930,14 +7930,14 @@ sub sync_all { my @dbs_tbls; my $next_db = $si->get_db_itr(dbh => $src->{dbh}); while ( my $db = $next_db->() ) { - MKDEBUG && _d('Getting tables from', $db); + PTDEBUG && _d('Getting tables from', $db); my $next_tbl = $si->get_tbl_itr( dbh => $src->{dbh}, db => $db, views => 0, ); while ( my $tbl = $next_tbl->() ) { - MKDEBUG && _d('Got table', $tbl); + PTDEBUG && _d('Got table', $tbl); push @dbs_tbls, { db => $db, tbl => $tbl }; } } @@ -8110,7 +8110,7 @@ sub sync_a_table { my $tbl_struct = ok_to_sync($src, $dst, %args); if ( my $diff = $args{diff} ) { - MKDEBUG && _d('Converting checksum diff to WHERE:', Dumper($diff)); + PTDEBUG && _d('Converting checksum diff to WHERE:', Dumper($diff)); $args{where} = diff_where( %args, tbl_struct => $tbl_struct, @@ -8265,11 +8265,11 @@ sub get_change_dbh { # Is it possible to make changes on the master (i.e. the source)? # Only if REPLACE will work. my $can_replace = grep { $_->{is_unique} } values %{$tbl_struct->{keys}}; - MKDEBUG && _d("This table's replace-ability:", $can_replace); + PTDEBUG && _d("This table's replace-ability:", $can_replace); die "Can't make changes on the master because no unique index exists" unless $can_replace; $change_dbh = $src->{dbh}; # The alternate case. - MKDEBUG && _d('Will make changes on source', $change_dbh); + PTDEBUG && _d('Will make changes on source', $change_dbh); } elsif ( $o->get('check-slave') ) { # Is it safe to change data on the destination? Only if it's *not* @@ -8283,7 +8283,7 @@ sub get_change_dbh { 'SHOW VARIABLES LIKE "log_bin"'); my ($sql_log_bin) = $dst->{dbh}->selectrow_array( 'SELECT @@SQL_LOG_BIN'); - MKDEBUG && _d('Variables on destination:', + PTDEBUG && _d('Variables on destination:', 'log_bin=', (defined $log_bin ? $log_bin : 'NULL'), ' @@SQL_LOG_BIN=', (defined $sql_log_bin ? $sql_log_bin : 'NULL')); if ( $slave_status && $sql_log_bin && ($log_bin || 'OFF') eq 'ON' ) { @@ -8291,7 +8291,7 @@ sub get_change_dbh { " because it's a slave. See the documentation section", " 'REPLICATION SAFETY' for solutions to this problem."; } - MKDEBUG && _d('Will make changes on destination', $change_dbh); + PTDEBUG && _d('Will make changes on destination', $change_dbh); } return $change_dbh; @@ -8324,7 +8324,7 @@ sub make_action_subs { my ( $sql, $dbh ) = @_; # Use $dbh if given. It's from a bidirectional callback. $dbh ||= $change_dbh; - MKDEBUG && _d('Execute on dbh', $dbh, $sql); + PTDEBUG && _d('Execute on dbh', $dbh, $sql); $dbh->do($sql); }; } @@ -8408,36 +8408,36 @@ sub get_cxn { my $sql; if ( !$o->get('bin-log') ) { $sql = "/*!32316 SET SQL_LOG_BIN=0 */"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } if ( !$o->get('unique-checks') ) { $sql = "/*!40014 SET UNIQUE_CHECKS=0 */"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } if ( !$o->get('foreign-key-checks') ) { $sql = "/*!40014 SET FOREIGN_KEY_CHECKS=0 */"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } # Disable auto-increment on zero (bug #1919897). $sql = '/*!40101 SET @@SQL_MODE := CONCAT(@@SQL_MODE, ' . '",NO_AUTO_VALUE_ON_ZERO")*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); # Ensure statement-based replication. # http://code.google.com/p/maatkit/issues/detail?id=95 $sql = '/*!50105 SET @@binlog_format="STATEMENT"*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( $o->get('transaction') ) { my $sql = "SET SESSION TRANSACTION ISOLATION LEVEL REPEATABLE READ"; eval { - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); }; die "Failed to $sql: $EVAL_ERROR" if $EVAL_ERROR; @@ -8445,7 +8445,7 @@ sub get_cxn { $dsn_for{$dbh} = $dsn; - MKDEBUG && _d('Opened dbh', $dbh); + PTDEBUG && _d('Opened dbh', $dbh); return $dbh; } @@ -8513,7 +8513,7 @@ sub ok_to_sync { # Check that the user has all the necessary privs on the tbls. if ( $o->get('check-privileges') ) { - MKDEBUG && _d('Checking privileges'); + PTDEBUG && _d('Checking privileges'); if ( !$syncer->have_all_privs($src->{dbh}, $src->{db}, $src->{tbl}) ) { my $user = get_current_user($src->{dbh}) || ""; die "User $user does not have all necessary privileges on ", @@ -8528,7 +8528,7 @@ sub ok_to_sync { # Check that no triggers are defined on the dst tbl. if ( $o->get('check-triggers') ) { - MKDEBUG && _d('Checking for triggers'); + PTDEBUG && _d('Checking for triggers'); if ( !defined $dst->{supports_triggers} ) { $dst->{supports_triggers} = $vp->version_ge($dst->{dbh}, '5.0.2'); } @@ -8537,7 +8537,7 @@ sub ok_to_sync { die "Triggers are defined on the table"; } else { - MKDEBUG && _d('Destination does not support triggers', + PTDEBUG && _d('Destination does not support triggers', $dp->as_string($dst->{dsn})); } } @@ -8584,7 +8584,7 @@ sub disconnect { delete $dsn_for{$dbh}; $dbh->commit() unless $dbh->{AutoCommit}; $dbh->disconnect(); - MKDEBUG && _d('Disconnected dbh', $dbh); + PTDEBUG && _d('Disconnected dbh', $dbh); } } return; @@ -8626,7 +8626,7 @@ use constant FAILED_THRESHOLD => 2; # failed to exceed threshold # One of the constants above, UPDATE_* or FAILED_THRESHOLD sub cmp_conflict_col { my ( $left_val, $right_val, $cmp, $val, $thr ) = @_; - MKDEBUG && _d('Compare', @_); + PTDEBUG && _d('Compare', @_); my $res; if ( $cmp eq 'newest' || $cmp eq 'oldest' ) { $res = $cmp eq 'newest' ? ($left_val || '') cmp ($right_val || '') @@ -8637,10 +8637,10 @@ sub cmp_conflict_col { my $lts = any_unix_timestamp($left_val); my $rts = any_unix_timestamp($right_val); my $diff = abs($lts - $rts); - MKDEBUG && _d('Check threshold, lts rts thr abs-diff:', + PTDEBUG && _d('Check threshold, lts rts thr abs-diff:', $lts, $rts, $thr, $diff); if ( $diff < $thr ) { - MKDEBUG && _d("Failed threshold"); + PTDEBUG && _d("Failed threshold"); return FAILED_THRESHOLD; } } @@ -8651,9 +8651,9 @@ sub cmp_conflict_col { $res = 0 if ($left_val || 0) == ($right_val || 0); if ( $thr ) { my $diff = abs($left_val - $right_val); - MKDEBUG && _d('Check threshold, abs-diff:', $diff); + PTDEBUG && _d('Check threshold, abs-diff:', $diff); if ( $diff < $thr ) { - MKDEBUG && _d("Failed threshold"); + PTDEBUG && _d("Failed threshold"); return FAILED_THRESHOLD; } } @@ -8712,19 +8712,19 @@ sub set_bidirectional_callbacks { my $left_val = $lr->{$col} || ''; my $right_val = $rr->{$col} || ''; - MKDEBUG && _d('left', $col, 'value:', $left_val); - MKDEBUG && _d('right', $col, 'value:', $right_val); + PTDEBUG && _d('left', $col, 'value:', $left_val); + PTDEBUG && _d('right', $col, 'value:', $right_val); my $res = cmp_conflict_col($left_val, $right_val, $cmp, $val, $thr); if ( $res == UPDATE_LEFT ) { - MKDEBUG && _d("right dbh $args{right_dbh} $cmp; " + PTDEBUG && _d("right dbh $args{right_dbh} $cmp; " . "update left dbh $args{left_dbh}"); $ch->set_src('right', $args{right_dbh}); $auth_row = $args{rr}; $change_dbh = $args{left_dbh}; } elsif ( $res == UPDATE_RIGHT ) { - MKDEBUG && _d("left dbh $args{left_dbh} $cmp; " + PTDEBUG && _d("left dbh $args{left_dbh} $cmp; " . "update right dbh $args{right_dbh}"); $ch->set_src('left', $args{left_dbh}); $auth_row = $args{lr}; @@ -8827,13 +8827,13 @@ sub get_server_time { my $now; eval { my $sql = "SELECT NOW()"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); ($now) = $dbh->selectrow_array($sql); - MKDEBUG && _d("Server time:", $now); + PTDEBUG && _d("Server time:", $now); $now =~ s/^\S+\s+//; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Failed to get server time:", $EVAL_ERROR); + PTDEBUG && _d("Failed to get server time:", $EVAL_ERROR); } return $now } @@ -8845,11 +8845,11 @@ sub get_current_user { my $user; eval { my $sql = "SELECT CURRENT_USER()"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); ($user) = $dbh->selectrow_array($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Error getting current user:", $EVAL_ERROR); + PTDEBUG && _d("Error getting current user:", $EVAL_ERROR); } return $user; @@ -8868,7 +8868,7 @@ sub diff_where { my $key = $diff->{chunk_index}; if ( !$key ) { - MKDEBUG && _d('One nibble checksum'); + PTDEBUG && _d('One nibble checksum'); return; } my $cols = $tbl_struct->{keys}->{$key}->{cols}; @@ -8886,7 +8886,7 @@ sub diff_where { ); $asc_for_table{$diff->{table}} = $asc; - MKDEBUG && _d('Ascend params:', Dumper($asc)); + PTDEBUG && _d('Ascend params:', Dumper($asc)); } my $lb_sql = $asc->{boundaries}->{'>='}; diff --git a/bin/pt-tcp-model b/bin/pt-tcp-model index a604f35e..55b0034f 100755 --- a/bin/pt-tcp-model +++ b/bin/pt-tcp-model @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1227,36 +1227,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1303,7 +1303,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1444,7 +1444,7 @@ package FileIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1475,14 +1475,14 @@ sub get_file_itr { if ( !@filenames ) { push @final_filenames, '-'; - MKDEBUG && _d('Auto-adding "-" to the list of filenames'); + PTDEBUG && _d('Auto-adding "-" to the list of filenames'); } - MKDEBUG && _d('Final filenames:', @final_filenames); + PTDEBUG && _d('Final filenames:', @final_filenames); return sub { while ( @final_filenames ) { my $fn = shift @final_filenames; - MKDEBUG && _d('Filename:', $fn); + PTDEBUG && _d('Filename:', $fn); if ( $fn eq '-' ) { # Magical STDIN filename. return (*STDIN, undef, undef); } @@ -1523,7 +1523,7 @@ package SimpleTCPDumpParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timelocal); use Data::Dumper; @@ -1608,7 +1608,7 @@ sub make_event { $event->{port} = $src_port; $event->{arg} = undef; delete $event->{status}; - MKDEBUG && _d('Properties of event:', Dumper($event)); + PTDEBUG && _d('Properties of event:', Dumper($event)); return $event; } return undef; @@ -1655,7 +1655,7 @@ package TCPRequestAggregator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(sum); use Data::Dumper; @@ -1691,20 +1691,20 @@ sub parse_event { EVENT: while ( 1 ) { - MKDEBUG && _d("Beginning a loop at pos", $pos_in_log); + PTDEBUG && _d("Beginning a loop at pos", $pos_in_log); my ( $id, $start, $elapsed ); my ($timestamp, $direction); if ( $self->{pending} ) { ( $id, $start, $elapsed ) = @{$self->{pending}}; - MKDEBUG && _d("Pulled from pending", @{$self->{pending}}); + PTDEBUG && _d("Pulled from pending", @{$self->{pending}}); } elsif ( defined(my $line = $next_event->()) ) { my ($end, $host_port); ( $id, $start, $end, $elapsed, $host_port ) = $line =~ m/(\S+)/g; @$buffer = sort { $a <=> $b } ( @$buffer, $end ); - MKDEBUG && _d("Read from the file", $id, $start, $end, $elapsed, $host_port); - MKDEBUG && _d("Buffer is now", @$buffer); + PTDEBUG && _d("Read from the file", $id, $start, $end, $elapsed, $host_port); + PTDEBUG && _d("Buffer is now", @$buffer); } if ( $start ) { # Test that we got a line; $id can be 0. if ( @$buffer && $buffer->[0] < $start ) { @@ -1712,45 +1712,45 @@ sub parse_event { $timestamp = shift @$buffer; $self->{pending} = [ $id, $start, $elapsed ]; $id = $start = $elapsed = undef; - MKDEBUG && _d("Completion: using buffered end value", $timestamp); - MKDEBUG && _d("Saving line to pending", @{$self->{pending}}); + PTDEBUG && _d("Completion: using buffered end value", $timestamp); + PTDEBUG && _d("Saving line to pending", @{$self->{pending}}); } else { $direction = 'A'; # Arrival $timestamp = $start; $self->{pending} = undef; - MKDEBUG && _d("Deleting pending line"); - MKDEBUG && _d("Arrival: using the line"); + PTDEBUG && _d("Deleting pending line"); + PTDEBUG && _d("Arrival: using the line"); } } elsif ( @$buffer ) { $direction = 'C'; $timestamp = shift @$buffer; - MKDEBUG && _d("No more lines, reading from buffer", $timestamp); + PTDEBUG && _d("No more lines, reading from buffer", $timestamp); } else { # We hit EOF. - MKDEBUG && _d("No more lines, no more buffered end times"); + PTDEBUG && _d("No more lines, no more buffered end times"); if ( $self->{in_prg} ) { die "Error: no more lines, but in_prg = $self->{in_prg}"; } if ( $self->{t_start} < $self->{current_ts} ) { - MKDEBUG && _d("Returning event based on what's been seen"); + PTDEBUG && _d("Returning event based on what's been seen"); return $self->make_event($self->{t_start}, $self->{current_ts}); } else { - MKDEBUG && _d("No further events to make"); + PTDEBUG && _d("No further events to make"); return; } } my $t_start = int($timestamp / $self->{interval}) * $self->{interval}; $self->{t_start} ||= $timestamp; # Not $t_start; that'd skew 1st interval. - MKDEBUG && _d("Timestamp", $timestamp, "interval start time", $t_start); + PTDEBUG && _d("Timestamp", $timestamp, "interval start time", $t_start); if ( $t_start > $self->{t_start} ) { - MKDEBUG && _d("Timestamp doesn't belong to this interval"); + PTDEBUG && _d("Timestamp doesn't belong to this interval"); if ( $self->{in_prg} ) { - MKDEBUG && _d("Computing from", $self->{current_ts}, "to", $t_start); + PTDEBUG && _d("Computing from", $self->{current_ts}, "to", $t_start); $self->{busy_time} += $t_start - $self->{current_ts}; $self->{weighted_time} += ($t_start - $self->{current_ts}) * $self->{in_prg}; } @@ -1772,20 +1772,20 @@ sub parse_event { else { if ( $self->{in_prg} ) { - MKDEBUG && _d("Computing from", $self->{current_ts}, "to", $timestamp); + PTDEBUG && _d("Computing from", $self->{current_ts}, "to", $timestamp); $self->{busy_time} += $timestamp - $self->{current_ts}; $self->{weighted_time} += ($timestamp - $self->{current_ts}) * $self->{in_prg}; } $self->{current_ts} = $timestamp; if ( $direction eq 'A' ) { - MKDEBUG && _d("Direction A", $timestamp); + PTDEBUG && _d("Direction A", $timestamp); ++$self->{in_prg}; if ( defined $elapsed ) { push @{$self->{response_times}}, $elapsed; } } else { - MKDEBUG && _d("Direction C", $timestamp); + PTDEBUG && _d("Direction C", $timestamp); --$self->{in_prg}; ++$self->{completions}; } @@ -1851,7 +1851,7 @@ sub make_event { $self->{last_completions} = $self->{completions}; $self->{response_times} = []; - MKDEBUG && _d("Event is", Dumper($event)); + PTDEBUG && _d("Event is", Dumper($event)); return $event; } @@ -1888,7 +1888,7 @@ use Data::Dumper; $Data::Dumper::Indent = 1; $OUTPUT_AUTOFLUSH = 1; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use sigtrap 'handler', \&sig_int, 'normal-signals'; diff --git a/bin/pt-trend b/bin/pt-trend index 15de89c9..d98b2136 100755 --- a/bin/pt-trend +++ b/bin/pt-trend @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1065,17 +1065,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1117,19 +1117,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1147,7 +1147,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1167,7 +1167,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1180,7 +1180,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1189,10 +1189,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1233,7 +1233,7 @@ package Progress; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1374,7 +1374,7 @@ package FileIterator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1405,14 +1405,14 @@ sub get_file_itr { if ( !@filenames ) { push @final_filenames, '-'; - MKDEBUG && _d('Auto-adding "-" to the list of filenames'); + PTDEBUG && _d('Auto-adding "-" to the list of filenames'); } - MKDEBUG && _d('Final filenames:', @final_filenames); + PTDEBUG && _d('Final filenames:', @final_filenames); return sub { while ( @final_filenames ) { my $fn = shift @final_filenames; - MKDEBUG && _d('Filename:', $fn); + PTDEBUG && _d('Filename:', $fn); if ( $fn eq '-' ) { # Magical STDIN filename. return (*STDIN, undef, undef); } @@ -1453,7 +1453,7 @@ package TimeSeriesTrender; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1544,7 +1544,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -1724,36 +1724,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -1797,7 +1797,7 @@ sub _d { package pt_trend; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(any_unix_timestamp)); sub main { diff --git a/bin/pt-upgrade b/bin/pt-upgrade index 246d9245..a79fdf9c 100755 --- a/bin/pt-upgrade +++ b/bin/pt-upgrade @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # DSNParser package @@ -22,7 +22,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -45,7 +45,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -63,7 +63,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -72,10 +72,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -87,23 +87,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -134,7 +134,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -184,7 +184,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -229,7 +229,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -239,21 +239,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -265,15 +265,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -291,7 +291,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -317,7 +317,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -378,7 +378,7 @@ package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; @@ -472,11 +472,11 @@ sub dump { sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { - MKDEBUG && _d('No new DB to use'); + PTDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } @@ -488,12 +488,12 @@ sub get_create_table { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { @@ -503,15 +503,15 @@ sub get_create_table { $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { - MKDEBUG && _d('This table is a base table'); + PTDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { - MKDEBUG && _d('This table is a view'); + PTDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } @@ -521,11 +521,11 @@ sub get_create_table { sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; - MKDEBUG && _d('Get columns for', $db, $tbl); + PTDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ @@ -546,7 +546,7 @@ sub get_tmp_table { map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; - MKDEBUG && _d($result); + PTDEBUG && _d($result); return $result; } @@ -558,11 +558,11 @@ sub get_triggers { . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { @@ -575,7 +575,7 @@ sub get_triggers { } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { @@ -594,7 +594,7 @@ sub get_databases { push @params, $like; } my $sth = $dbh->prepare($sql); - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; @@ -612,7 +612,7 @@ sub get_table_status { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @@ -638,7 +638,7 @@ sub get_table_list { $sql .= ' LIKE ?'; push @params, $like; } - MKDEBUG && _d($sql, @params); + PTDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @@ -683,7 +683,7 @@ package TableParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -728,7 +728,7 @@ sub parse { my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); my %def_for; @def_for{@cols} = @defs; @@ -789,7 +789,7 @@ sub sort_indexes { } sort keys %{$tbl->{keys}}; - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); + PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); return @indexes; } @@ -807,7 +807,7 @@ sub find_best_index { ($best) = $self->sort_indexes($tbl); } } - MKDEBUG && _d('Best index found is', $best); + PTDEBUG && _d('Best index found is', $best); return $best; } @@ -816,25 +816,25 @@ sub find_possible_keys { return () unless $where; my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) . ' WHERE ' . $where; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; if ( $expl->{possible_keys} ) { - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); + PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); my @candidates = split(',', $expl->{possible_keys}); my %possible = map { $_ => 1 } @candidates; if ( $expl->{key} ) { - MKDEBUG && _d('MySQL chose', $expl->{key}); + PTDEBUG && _d('MySQL chose', $expl->{key}); unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); + PTDEBUG && _d('Before deduping:', join(', ', @candidates)); my %seen; @candidates = grep { !$seen{$_}++ } @candidates; } - MKDEBUG && _d('Final list:', join(', ', @candidates)); + PTDEBUG && _d('Final list:', join(', ', @candidates)); return @candidates; } else { - MKDEBUG && _d('No keys in possible_keys'); + PTDEBUG && _d('No keys in possible_keys'); return (); } } @@ -848,66 +848,66 @@ sub check_table { my ($dbh, $db, $tbl) = @args{@required_args}; my $q = $self->{Quoter}; my $db_tbl = $q->quote($db, $tbl); - MKDEBUG && _d('Checking', $db_tbl); + PTDEBUG && _d('Checking', $db_tbl); my $sql = "SHOW TABLES FROM " . $q->quote($db) . ' LIKE ' . $q->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $row; eval { $row = $dbh->selectrow_arrayref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !$row->[0] || $row->[0] ne $tbl ) { - MKDEBUG && _d('Table does not exist'); + PTDEBUG && _d('Table does not exist'); return 0; } - MKDEBUG && _d('Table exists; no privs to check'); + PTDEBUG && _d('Table exists; no privs to check'); return 1 unless $args{all_privs}; $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $row = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return 0; } if ( !scalar keys %$row ) { - MKDEBUG && _d('Table has no columns:', Dumper($row)); + PTDEBUG && _d('Table has no columns:', Dumper($row)); return 0; } my $privs = $row->{privileges} || $row->{Privileges}; $sql = "DELETE FROM $db_tbl LIMIT 0"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete) ) { - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } sub get_engine { my ( $self, $ddl, $opts ) = @_; my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - MKDEBUG && _d('Storage engine:', $engine); + PTDEBUG && _d('Storage engine:', $engine); return $engine || undef; } @@ -923,7 +923,7 @@ sub get_keys { next KEY if $key =~ m/FOREIGN/; my $key_ddl = $key; - MKDEBUG && _d('Parsed key:', $key_ddl); + PTDEBUG && _d('Parsed key:', $key_ddl); if ( $engine !~ m/MEMORY|HEAP/ ) { $key =~ s/USING HASH/USING BTREE/; @@ -949,7 +949,7 @@ sub get_keys { } $name =~ s/`//g; - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); + PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); $keys->{$name} = { name => $name, @@ -971,7 +971,7 @@ sub get_keys { elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { $clustered_key = $this_key->{name}; } - MKDEBUG && $clustered_key && _d('This key is the clustered key'); + PTDEBUG && $clustered_key && _d('This key is the clustered key'); } } @@ -1039,7 +1039,7 @@ sub remove_secondary_indexes { } grep { $_->{name} ne $clustered_key } values %{$tbl_struct->{keys}}; - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); + PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); if ( @sec_indexes ) { $sec_indexes_ddl = join(' ', @sec_indexes); @@ -1049,7 +1049,7 @@ sub remove_secondary_indexes { $ddl =~ s/,(\n\) )/$1/s; } else { - MKDEBUG && _d('Not removing secondary indexes from', + PTDEBUG && _d('Not removing secondary indexes from', $tbl_struct->{engine}, 'table'); } @@ -1084,7 +1084,7 @@ package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1161,7 +1161,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -1245,7 +1245,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -1289,7 +1289,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -1326,7 +1326,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -1335,7 +1335,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -1354,7 +1354,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -1362,7 +1362,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -1400,7 +1400,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -1413,7 +1413,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -1439,14 +1439,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -1455,13 +1455,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -1469,17 +1469,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -1493,7 +1493,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -1503,7 +1503,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -1517,7 +1517,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -1540,7 +1540,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -1569,7 +1569,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -1600,7 +1600,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -1667,7 +1667,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1716,7 +1716,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1740,12 +1740,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1754,23 +1754,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1779,7 +1779,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1789,7 +1789,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1863,11 +1863,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -2082,7 +2082,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -2092,7 +2092,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -2116,7 +2116,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -2129,7 +2129,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -2156,7 +2156,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -2186,7 +2186,7 @@ package Transformers; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); @@ -2366,36 +2366,36 @@ sub any_unix_timestamp { : $suffix eq 'h' ? $n * 3600 # Hours : $suffix eq 'd' ? $n * 86400 # Days : $n; # default: Seconds - MKDEBUG && _d('ts is now - N[shmd]:', $n); + PTDEBUG && _d('ts is now - N[shmd]:', $n); return time - $n; } elsif ( $val =~ m/^\d{9,}/ ) { - MKDEBUG && _d('ts is already a unix timestamp'); + PTDEBUG && _d('ts is already a unix timestamp'); return $val; } elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - MKDEBUG && _d('ts is MySQL slow log timestamp'); + PTDEBUG && _d('ts is MySQL slow log timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp(parse_timestamp($val)); } elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - MKDEBUG && _d('ts is properly formatted timestamp'); + PTDEBUG && _d('ts is properly formatted timestamp'); $val .= ' 00:00:00' unless $hms; return unix_timestamp($val); } else { - MKDEBUG && _d('ts is MySQL expression'); + PTDEBUG && _d('ts is MySQL expression'); return $callback->($val) if $callback && ref $callback eq 'CODE'; } - MKDEBUG && _d('Unknown ts type:', $val); + PTDEBUG && _d('Unknown ts type:', $val); return; } sub make_checksum { my ( $val ) = @_; my $checksum = uc substr(md5_hex($val), -16); - MKDEBUG && _d($checksum, 'checksum for', $val); + PTDEBUG && _d($checksum, 'checksum for', $val); return $checksum; } @@ -2442,7 +2442,7 @@ package SlowLogParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -2494,7 +2494,7 @@ sub parse_event { if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); if ( @chunks > 1 ) { - MKDEBUG && _d("Found multiple chunks"); + PTDEBUG && _d("Found multiple chunks"); $stmt = shift @chunks; unshift @$pending, @chunks; } @@ -2512,18 +2512,18 @@ sub parse_event { while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. $pos = pos($stmt); # Be careful not to mess this up! my $line = $1; # Necessary for /g and pos() to work. - MKDEBUG && _d($line); + PTDEBUG && _d($line); if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - MKDEBUG && _d("Got ts", $time); + PTDEBUG && _d("Got ts", $time); push @properties, 'ts', $time; ++$got_ts; if ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } @@ -2532,13 +2532,13 @@ sub parse_event { elsif ( !$got_uh && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) ) { - MKDEBUG && _d("Got user, host, ip", $user, $host, $ip); + PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); push @properties, 'user', $user, 'host', $host, 'ip', $ip; ++$got_uh; } elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - MKDEBUG && _d("Got admin command"); + PTDEBUG && _d("Got admin command"); $line =~ s/^#\s+//; # string leading "# ". push @properties, 'cmd', 'Admin', 'arg', $line; push @properties, 'bytes', length($properties[-1]); @@ -2547,12 +2547,12 @@ sub parse_event { } elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - MKDEBUG && _d("Got some line with properties"); + PTDEBUG && _d("Got some line with properties"); if ( $line =~ m/Schema:\s+\w+: / ) { - MKDEBUG && _d('Removing empty Schema attrib'); + PTDEBUG && _d('Removing empty Schema attrib'); $line =~ s/Schema:\s+//; - MKDEBUG && _d($line); + PTDEBUG && _d($line); } my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; @@ -2560,36 +2560,36 @@ sub parse_event { } elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - MKDEBUG && _d("Got a default database:", $db); + PTDEBUG && _d("Got a default database:", $db); push @properties, 'db', $db; ++$got_db; } elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - MKDEBUG && _d("Got some setting:", $setting); + PTDEBUG && _d("Got some setting:", $setting); push @properties, split(/,|\s*=\s*/, $setting); ++$got_set; } if ( !$found_arg && $pos == $len ) { - MKDEBUG && _d("Did not find arg, looking for special cases"); + PTDEBUG && _d("Did not find arg, looking for special cases"); local $INPUT_RECORD_SEPARATOR = ";\n"; if ( defined(my $l = $next_event->()) ) { chomp $l; $l =~ s/^\s+//; - MKDEBUG && _d("Found admin statement", $l); + PTDEBUG && _d("Found admin statement", $l); push @properties, 'cmd', 'Admin', 'arg', $l; push @properties, 'bytes', length($properties[-1]); $found_arg++; } else { - MKDEBUG && _d("I can't figure out what to do with this line"); + PTDEBUG && _d("I can't figure out what to do with this line"); next EVENT; } } } else { - MKDEBUG && _d("Got the query/arg line"); + PTDEBUG && _d("Got the query/arg line"); my $arg = substr($stmt, $pos - length($line)); push @properties, 'arg', $arg, 'bytes', length($arg); if ( $args{misc} && $args{misc}->{embed} @@ -2601,7 +2601,7 @@ sub parse_event { } } - MKDEBUG && _d('Properties of event:', Dumper(\@properties)); + PTDEBUG && _d('Properties of event:', Dumper(\@properties)); my $event = { @properties }; if ( $args{stats} ) { $args{stats}->{events_read}++; @@ -2643,7 +2643,7 @@ package EventAggregator; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use Data::Dumper; @@ -2720,7 +2720,7 @@ sub aggregate { return unless defined $group_by; $self->{n_events}++; - MKDEBUG && _d('Event', $self->{n_events}); + PTDEBUG && _d('Event', $self->{n_events}); return $self->{unrolled_loops}->($self, $event, $group_by) if $self->{unrolled_loops}; @@ -2733,9 +2733,9 @@ sub aggregate { foreach my $attrib ( keys %{$self->{attributes}} ) { if ( !exists $event->{$attrib} ) { - MKDEBUG && _d("attrib doesn't exist in event:", $attrib); + PTDEBUG && _d("attrib doesn't exist in event:", $attrib); my $alt_attrib = $self->{alt_attribs}->{$attrib}->($event); - MKDEBUG && _d('alt attrib:', $alt_attrib); + PTDEBUG && _d('alt attrib:', $alt_attrib); next ATTRIB unless $alt_attrib; } @@ -2800,7 +2800,7 @@ sub _make_unrolled_loops { push @lines, '}'; my $code = join("\n", @lines); - MKDEBUG && _d('Unrolled subroutine:', @lines); + PTDEBUG && _d('Unrolled subroutine:', @lines); my $sub = eval $code; die $EVAL_ERROR if $EVAL_ERROR; $self->{unrolled_loops} = $sub; @@ -2860,7 +2860,7 @@ sub make_handler { my $val; eval { $val= $self->_get_value(%args); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d("Cannot make", $attrib, "handler:", $EVAL_ERROR); + PTDEBUG && _d("Cannot make", $attrib, "handler:", $EVAL_ERROR); return; } return unless defined $val; # can't determine type if it's undef @@ -2871,7 +2871,7 @@ sub make_handler { : $val =~ m/^(?:\d+|$float_re)$/o ? 'num' : $val =~ m/^(?:Yes|No)$/ ? 'bool' : 'string'; - MKDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); + PTDEBUG && _d('Type for', $attrib, 'is', $type, '(sample:', $val, ')'); $self->{type_for}->{$attrib} = $type; my @lines; @@ -2974,7 +2974,7 @@ sub make_handler { '}', ); $self->{code_for}->{$attrib} = join("\n", @code); - MKDEBUG && _d($attrib, 'handler code:', $self->{code_for}->{$attrib}); + PTDEBUG && _d($attrib, 'handler code:', $self->{code_for}->{$attrib}); my $sub = eval $self->{code_for}->{$attrib}; if ( $EVAL_ERROR ) { die "Failed to compile $attrib handler code: $EVAL_ERROR"; @@ -3008,7 +3008,7 @@ sub bucket_value { for my $base10_bucket ( 0..($#base10_starts-1) ) { my $next_bucket = bucket_idx( $base10_starts[$base10_bucket+1] ); - MKDEBUG && _d('Base 10 bucket', $base10_bucket, 'maps to', + PTDEBUG && _d('Base 10 bucket', $base10_bucket, 'maps to', 'base 1.05 buckets', $start_bucket, '..', $next_bucket-1); for my $base1_05_bucket ($start_bucket..($next_bucket-1)) { $buck_tens[$base1_05_bucket] = $base10_bucket; @@ -3028,7 +3028,7 @@ sub calculate_statistical_metrics { my $globals = $self->{result_globals}; my $class_metrics = $self->{class_metrics}; my $global_metrics = $self->{global_metrics}; - MKDEBUG && _d('Calculating statistical_metrics'); + PTDEBUG && _d('Calculating statistical_metrics'); foreach my $attrib ( keys %$globals ) { if ( exists $globals->{$attrib}->{all} ) { $global_metrics->{$attrib} @@ -3113,7 +3113,7 @@ sub _calc_metrics { my $prev = NUM_BUCK-1; # Used for getting median when $cutoff is odd my $bucket_95 = 0; # top bucket in 95th - MKDEBUG && _d('total vals:', $total_left, 'top vals:', $top_vals, 'mid:', $mid); + PTDEBUG && _d('total vals:', $total_left, 'top vals:', $top_vals, 'mid:', $mid); my @buckets = map { 0 } (0..NUM_BUCK-1); map { $buckets[$_] = $vals->{$_} } keys %$vals; @@ -3143,7 +3143,7 @@ sub _calc_metrics { my $maxstdev = (($args->{max} || 0) - ($args->{min} || 0)) / 2; $stddev = $stddev > $maxstdev ? $maxstdev : $stddev; - MKDEBUG && _d('sum:', $sum, 'sumsq:', $sumsq, 'stddev:', $stddev, + PTDEBUG && _d('sum:', $sum, 'sumsq:', $sumsq, 'stddev:', $stddev, 'median:', $median, 'prev bucket:', $prev, 'total left:', $total_left, 'sum excl', $sum_excl, 'bucket 95:', $bucket_95, $buck_vals[$bucket_95]); @@ -3235,7 +3235,7 @@ sub add_new_attributes { $self->{attributes}->{$attrib} = [$attrib]; $self->{alt_attribs}->{$attrib} = make_alt_attrib($attrib); push @{$self->{all_attribs}}, $attrib; - MKDEBUG && _d('Added new attribute:', $attrib); + PTDEBUG && _d('Added new attribute:', $attrib); } grep { $_ ne $self->{groupby} @@ -3270,7 +3270,7 @@ sub make_alt_attrib { . "&& exists \$event->{'$_'};" } @attribs; push @lines, 'return $alt_attrib; }'; - MKDEBUG && _d('alt attrib sub for', $attrib, ':', @lines); + PTDEBUG && _d('alt attrib sub for', $attrib, ':', @lines); my $sub = eval join("\n", @lines); die if $EVAL_ERROR; return $sub; @@ -3278,7 +3278,7 @@ sub make_alt_attrib { sub merge { my ( @ea_objs ) = @_; - MKDEBUG && _d('Merging', scalar @ea_objs, 'ea'); + PTDEBUG && _d('Merging', scalar @ea_objs, 'ea'); return unless scalar @ea_objs; my $ea1 = shift @ea_objs; @@ -3316,7 +3316,7 @@ sub merge { } keys %{$r1->{classes}}; for my $i ( 0..$#ea_objs ) { - MKDEBUG && _d('Merging ea obj', ($i + 1)); + PTDEBUG && _d('Merging ea obj', ($i + 1)); my $r2 = $ea_objs[$i]->results; eval { @@ -3328,19 +3328,19 @@ sub merge { if ( $r1_class && $r2_class ) { CLASS_ATTRIB: foreach my $attrib ( keys %$r2_class ) { - MKDEBUG && _d('merge', $attrib); + PTDEBUG && _d('merge', $attrib); if ( $r1_class->{$attrib} && $r2_class->{$attrib} ) { _add_attrib_vals($r1_class->{$attrib}, $r2_class->{$attrib}); } elsif ( !$r1_class->{$attrib} ) { - MKDEBUG && _d('copy', $attrib); + PTDEBUG && _d('copy', $attrib); $r1_class->{$attrib} = _deep_copy_attrib_vals($r2_class->{$attrib}) } } } elsif ( !$r1_class ) { - MKDEBUG && _d('copy class'); + PTDEBUG && _d('copy class'); $r_merged->{classes}->{$class} = _deep_copy_attribs($r2_class); } @@ -3355,7 +3355,7 @@ sub merge { $new_worst_sample = $r2->{samples}->{$class}; } if ( $new_worst_sample ) { - MKDEBUG && _d('New worst sample:', $worst, '=', + PTDEBUG && _d('New worst sample:', $worst, '=', $new_worst_sample->{$worst}, 'item:', substr($class, 0, 100)); my %new_sample; @new_sample{keys %$new_worst_sample} @@ -3370,17 +3370,17 @@ sub merge { eval { GLOBAL_ATTRIB: - MKDEBUG && _d('Merging global attributes'); + PTDEBUG && _d('Merging global attributes'); foreach my $attrib ( keys %{$r2->{globals}} ) { my $r1_global = $r_merged->{globals}->{$attrib}; my $r2_global = $r2->{globals}->{$attrib}; if ( $r1_global && $r2_global ) { - MKDEBUG && _d('merge', $attrib); + PTDEBUG && _d('merge', $attrib); _add_attrib_vals($r1_global, $r2_global); } elsif ( !$r1_global ) { - MKDEBUG && _d('copy', $attrib); + PTDEBUG && _d('copy', $attrib); $r_merged->{globals}->{$attrib} = _deep_copy_attrib_vals($r2_global); } @@ -3444,8 +3444,8 @@ sub _add_attrib_vals { map { $vals1->{$val}->{$_} += $val2->{$_} } keys %$val2; } else { - MKDEBUG && _d('vals1:', Dumper($vals1)); - MKDEBUG && _d('vals2:', Dumper($vals2)); + PTDEBUG && _d('vals1:', Dumper($vals1)); + PTDEBUG && _d('vals2:', Dumper($vals2)); die "$val type mismatch"; } } @@ -3509,7 +3509,7 @@ sub calculate_apdex { } my $f = 4 * $t; - MKDEBUG && _d("Apdex T =", $t, "F =", $f); + PTDEBUG && _d("Apdex T =", $t, "F =", $f); my $satisfied = 0; my $tolerating = 0; @@ -3534,7 +3534,7 @@ sub calculate_apdex { } my $apdex = sprintf('%.2f', ($satisfied + ($tolerating / 2)) / $n_samples); - MKDEBUG && _d($n_samples, "samples,", $satisfied, "satisfied,", + PTDEBUG && _d($n_samples, "samples,", $satisfied, "satisfied,", $tolerating, "tolerating,", $frustrated, "frustrated, Apdex score:", $apdex); @@ -3597,7 +3597,7 @@ package QueryParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $tbl_ident = qr/(?:`[^`]+`|\w+)(?:\.(?:`[^`]+`|\w+))?/; our $tbl_regex = qr{ @@ -3625,33 +3625,33 @@ sub new { sub get_tables { my ( $self, $query ) = @_; return unless $query; - MKDEBUG && _d('Getting tables for', $query); + PTDEBUG && _d('Getting tables for', $query); my ( $ddl_stmt ) = $query =~ m/^\s*($data_def_stmts)\b/i; if ( $ddl_stmt ) { - MKDEBUG && _d('Special table type:', $ddl_stmt); + PTDEBUG && _d('Special table type:', $ddl_stmt); $query =~ s/IF\s+(?:NOT\s+)?EXISTS//i; if ( $query =~ m/$ddl_stmt DATABASE\b/i ) { - MKDEBUG && _d('Query alters a database, not a table'); + PTDEBUG && _d('Query alters a database, not a table'); return (); } if ( $ddl_stmt =~ m/CREATE/i && $query =~ m/$ddl_stmt\b.+?\bSELECT\b/i ) { my ($select) = $query =~ m/\b(SELECT\b.+)/is; - MKDEBUG && _d('CREATE TABLE ... SELECT:', $select); + PTDEBUG && _d('CREATE TABLE ... SELECT:', $select); return $self->get_tables($select); } my ($tbl) = $query =~ m/TABLE\s+($tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches table:', $tbl); + PTDEBUG && _d('Matches table:', $tbl); return ($tbl); } $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; if ( $query =~ /^\s*LOCK TABLES/i ) { - MKDEBUG && _d('Special table type: LOCK TABLES'); + PTDEBUG && _d('Special table type: LOCK TABLES'); $query =~ s/^(\s*LOCK TABLES\s+)//; $query =~ s/\s+(?:READ|WRITE|LOCAL)+\s*//g; - MKDEBUG && _d('Locked tables:', $query); + PTDEBUG && _d('Locked tables:', $query); $query = "FROM $query"; } @@ -3661,7 +3661,7 @@ sub get_tables { my @tables; foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { - MKDEBUG && _d('Match tables:', $tbls); + PTDEBUG && _d('Match tables:', $tbls); next if $tbls =~ m/\ASELECT\b/i; @@ -3669,7 +3669,7 @@ sub get_tables { $tbl =~ s/\s*($tbl_ident)(\s+.*)?/$1/gio; if ( $tbl !~ m/[a-zA-Z]/ ) { - MKDEBUG && _d('Skipping suspicious table name:', $tbl); + PTDEBUG && _d('Skipping suspicious table name:', $tbl); next; } @@ -3682,7 +3682,7 @@ sub get_tables { sub has_derived_table { my ( $self, $query ) = @_; my $match = $query =~ m/$has_derived/; - MKDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); + PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); return $match; } @@ -3715,7 +3715,7 @@ sub get_aliases { $tbl_refs =~ s/\([^\)]+\)\s*//; } - MKDEBUG && _d('tbl refs:', $tbl_refs); + PTDEBUG && _d('tbl refs:', $tbl_refs); my $before_tbl = qr/(?:,|JOIN|\s|$from)+/i; @@ -3731,12 +3731,12 @@ sub get_aliases { }xgio ) { my ( $tbl_ref, $db_tbl, $alias ) = ($1, $2, $3); - MKDEBUG && _d('Match table:', $tbl_ref); + PTDEBUG && _d('Match table:', $tbl_ref); push @tbl_refs, $tbl_ref; $alias = $self->trim_identifier($alias); if ( $tbl_ref =~ m/^AS\s+\w+/i ) { - MKDEBUG && _d('Subquery', $tbl_ref); + PTDEBUG && _d('Subquery', $tbl_ref); $result->{TABLE}->{$alias} = undef; next; } @@ -3749,7 +3749,7 @@ sub get_aliases { } } else { - MKDEBUG && _d("No tables ref in", $query); + PTDEBUG && _d("No tables ref in", $query); } if ( $list ) { @@ -3764,7 +3764,7 @@ sub split { my ( $self, $query ) = @_; return unless $query; $query = $self->clean_query($query); - MKDEBUG && _d('Splitting', $query); + PTDEBUG && _d('Splitting', $query); my $verbs = qr{SELECT|INSERT|UPDATE|DELETE|REPLACE|UNION|CREATE}i; @@ -3784,7 +3784,7 @@ sub split { } } - MKDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); + PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); return @statements; } @@ -3810,12 +3810,12 @@ sub split_subquery { while ( $query =~ m/(\S+)(?:\s+|\Z)/g ) { $pos = pos($query); my $word = $1; - MKDEBUG && _d($word, $sqno); + PTDEBUG && _d($word, $sqno); if ( $word =~ m/^\(?SELECT\b/i ) { my $start_pos = $pos - length($word) - 1; if ( $start_pos ) { $sqno++; - MKDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); + PTDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); $subqueries[$sqno] = { start_pos => $start_pos, end_pos => 0, @@ -3827,25 +3827,25 @@ sub split_subquery { }; } else { - MKDEBUG && _d('Main SELECT at pos 0'); + PTDEBUG && _d('Main SELECT at pos 0'); } } else { next unless $sqno; # next unless we're in a subquery - MKDEBUG && _d('In subquery', $sqno); + PTDEBUG && _d('In subquery', $sqno); my $sq = $subqueries[$sqno]; if ( $sq->{done} ) { - MKDEBUG && _d('This subquery is done; SQL is for', + PTDEBUG && _d('This subquery is done; SQL is for', ($sqno - 1 ? "subquery $sqno" : "the main SELECT")); next; } push @{$sq->{words}}, $word; my $lp = ($word =~ tr/\(//) || 0; my $rp = ($word =~ tr/\)//) || 0; - MKDEBUG && _d('parentheses left', $lp, 'right', $rp); + PTDEBUG && _d('parentheses left', $lp, 'right', $rp); if ( ($sq->{lp} + $lp) - ($sq->{rp} + $rp) == 0 ) { my $end_pos = $pos - 1; - MKDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); + PTDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); $sq->{end_pos} = $end_pos; $sq->{len} = $end_pos - $sq->{start_pos}; } @@ -3911,7 +3911,7 @@ sub get_columns { ($cols_def) = $query =~ m/\(([^\)]+)\)\s*VALUE/i; } - MKDEBUG && _d('Columns:', $cols_def); + PTDEBUG && _d('Columns:', $cols_def); if ( $cols_def ) { @$cols = split(',', $cols_def); map { @@ -3952,7 +3952,7 @@ sub extract_tables { my $default_db = $args{default_db}; my $q = $self->{Quoter} || $args{Quoter}; return unless $query; - MKDEBUG && _d('Extracting tables'); + PTDEBUG && _d('Extracting tables'); my @tables; my %seen; foreach my $db_tbl ( $self->get_tables($query) ) { @@ -4001,7 +4001,7 @@ package QueryRewriter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; @@ -4150,7 +4150,7 @@ sub distill_verbs { $query = $self->strip_comments($query); if ( $query =~ m/\A\s*SHOW\s+/i ) { - MKDEBUG && _d($query); + PTDEBUG && _d($query); $query = uc $query; $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; @@ -4160,7 +4160,7 @@ sub distill_verbs { $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; $query =~ s/\s+/ /g; - MKDEBUG && _d($query); + PTDEBUG && _d($query); return $query; } @@ -4170,10 +4170,10 @@ sub distill_verbs { if ( $dds) { my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; $obj = uc $obj if $obj; - MKDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); + PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); my ($db_or_tbl) = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - MKDEBUG && _d('Matches db or table:', $db_or_tbl); + PTDEBUG && _d('Matches db or table:', $db_or_tbl); return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; } @@ -4184,7 +4184,7 @@ sub distill_verbs { }; if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - MKDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); + PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); my $union = grep { $_ eq 'UNION' } @verbs; @verbs = $union ? qw(SELECT UNION) : qw(SELECT); } @@ -4311,12 +4311,12 @@ sub __delete_to_select { sub __insert_to_select { my ( $tbl, $cols, $vals ) = @_; - MKDEBUG && _d('Args:', @_); + PTDEBUG && _d('Args:', @_); my @cols = split(/,/, $cols); - MKDEBUG && _d('Cols:', @cols); + PTDEBUG && _d('Cols:', @cols); $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - MKDEBUG && _d('Vals:', @vals); + PTDEBUG && _d('Vals:', @vals); if ( @cols == @vals ) { return "select * from $tbl where " . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); @@ -4375,7 +4375,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -4393,17 +4393,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -4445,19 +4445,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -4475,7 +4475,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -4495,7 +4495,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -4508,7 +4508,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -4517,10 +4517,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -4561,7 +4561,7 @@ package ChangeHandler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $DUPE_KEY = qr/Duplicate entry/; our @ACTIONS = qw(DELETE REPLACE INSERT UPDATE); @@ -4593,7 +4593,7 @@ sub new { sub fetch_back { my ( $self, $dbh ) = @_; $self->{fetch_back} = $dbh; - MKDEBUG && _d('Set fetch back dbh', $dbh); + PTDEBUG && _d('Set fetch back dbh', $dbh); return; } @@ -4611,7 +4611,7 @@ sub set_src { else { die "src argument must be either 'left' or 'right'" } - MKDEBUG && _d('Set src to', $src); + PTDEBUG && _d('Set src to', $src); $self->fetch_back($dbh) if $dbh; return; } @@ -4628,7 +4628,7 @@ sub dst { sub _take_action { my ( $self, $sql, $dbh ) = @_; - MKDEBUG && _d('Calling subroutines on', $dbh, $sql); + PTDEBUG && _d('Calling subroutines on', $dbh, $sql); foreach my $action ( @{$self->{actions}} ) { $action->($sql, $dbh); } @@ -4637,7 +4637,7 @@ sub _take_action { sub change { my ( $self, $action, $row, $cols, $dbh ) = @_; - MKDEBUG && _d($dbh, $action, 'where', $self->make_where_clause($row, $cols)); + PTDEBUG && _d($dbh, $action, 'where', $self->make_where_clause($row, $cols)); return unless $action; @@ -4653,7 +4653,7 @@ sub change { $self->_take_action($self->$func($row, $cols), $dbh); }; if ( $EVAL_ERROR =~ m/$DUPE_KEY/ ) { - MKDEBUG && _d('Duplicate key violation; will queue and rewrite'); + PTDEBUG && _d('Duplicate key violation; will queue and rewrite'); $self->{queue}++; $self->{replace} = 1; $self->__queue($action, $row, $cols, $dbh); @@ -4667,7 +4667,7 @@ sub change { sub __queue { my ( $self, $action, $row, $cols, $dbh ) = @_; - MKDEBUG && _d('Queueing change for later'); + PTDEBUG && _d('Queueing change for later'); if ( $self->{replace} ) { $action = $action eq 'DELETE' ? $action : 'REPLACE'; } @@ -4679,16 +4679,16 @@ sub process_rows { my $error_count = 0; TRY: { if ( $queue_level && $queue_level < $self->{queue} ) { # see redo below! - MKDEBUG && _d('Not processing now', $queue_level, '<', $self->{queue}); + PTDEBUG && _d('Not processing now', $queue_level, '<', $self->{queue}); return; } - MKDEBUG && _d('Processing rows:'); + PTDEBUG && _d('Processing rows:'); my ($row, $cur_act); eval { foreach my $action ( @ACTIONS ) { my $func = "make_$action"; my $rows = $self->{$action}; - MKDEBUG && _d(scalar(@$rows), 'to', $action); + PTDEBUG && _d(scalar(@$rows), 'to', $action); $cur_act = $action; while ( @$rows ) { $row = shift @$rows; @@ -4700,7 +4700,7 @@ sub process_rows { $error_count = 0; }; if ( !$error_count++ && $EVAL_ERROR =~ m/$DUPE_KEY/ ) { - MKDEBUG && _d('Duplicate key violation; re-queueing and rewriting'); + PTDEBUG && _d('Duplicate key violation; re-queueing and rewriting'); $self->{queue}++; # Defer rows to the very end $self->{replace} = 1; $self->__queue($cur_act, @$row); @@ -4714,7 +4714,7 @@ sub process_rows { sub make_DELETE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make DELETE'); + PTDEBUG && _d('Make DELETE'); return "DELETE FROM $self->{dst_db_tbl} WHERE " . $self->make_where_clause($row, $cols) . ' LIMIT 1'; @@ -4722,7 +4722,7 @@ sub make_DELETE { sub make_UPDATE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make UPDATE'); + PTDEBUG && _d('Make UPDATE'); if ( $self->{replace} ) { return $self->make_row('REPLACE', $row, $cols); } @@ -4731,7 +4731,7 @@ sub make_UPDATE { my @cols; if ( my $dbh = $self->{fetch_back} ) { my $sql = $self->make_fetch_back_query($where); - MKDEBUG && _d('Fetching data on dbh', $dbh, 'for UPDATE:', $sql); + PTDEBUG && _d('Fetching data on dbh', $dbh, 'for UPDATE:', $sql); my $res = $dbh->selectrow_hashref($sql); @{$row}{keys %$res} = values %$res; @cols = $self->sort_cols($res); @@ -4749,7 +4749,7 @@ sub make_UPDATE { sub make_INSERT { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make INSERT'); + PTDEBUG && _d('Make INSERT'); if ( $self->{replace} ) { return $self->make_row('REPLACE', $row, $cols); } @@ -4758,7 +4758,7 @@ sub make_INSERT { sub make_REPLACE { my ( $self, $row, $cols ) = @_; - MKDEBUG && _d('Make REPLACE'); + PTDEBUG && _d('Make REPLACE'); return $self->make_row('REPLACE', $row, $cols); } @@ -4768,7 +4768,7 @@ sub make_row { if ( my $dbh = $self->{fetch_back} ) { my $where = $self->make_where_clause($row, $cols); my $sql = $self->make_fetch_back_query($where); - MKDEBUG && _d('Fetching data on dbh', $dbh, 'for', $verb, ':', $sql); + PTDEBUG && _d('Fetching data on dbh', $dbh, 'for', $verb, ':', $sql); my $res = $dbh->selectrow_hashref($sql); @{$row}{keys %$res} = values %$res; @cols = $self->sort_cols($res); @@ -4849,7 +4849,7 @@ sub make_fetch_back_query { ); if ( !$cols ) { - MKDEBUG && _d('Failed to make explicit columns list from tbl struct'); + PTDEBUG && _d('Failed to make explicit columns list from tbl struct'); $cols = '*'; } } @@ -4884,7 +4884,7 @@ package RowDiff; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -4913,47 +4913,47 @@ sub compare_sets { do { if ( !$lr && !$left_done ) { - MKDEBUG && _d('Fetching row from left'); + PTDEBUG && _d('Fetching row from left'); eval { $lr = $left_sth->fetchrow_hashref(); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $left_done = !$lr || $EVAL_ERROR ? 1 : 0; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d('Left still has rows'); } if ( !$rr && !$right_done ) { - MKDEBUG && _d('Fetching row from right'); + PTDEBUG && _d('Fetching row from right'); eval { $rr = $right_sth->fetchrow_hashref(); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $right_done = !$rr || $EVAL_ERROR ? 1 : 0; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d('Right still has rows'); } my $cmp; if ( $lr && $rr ) { $cmp = $self->key_cmp(%args, lr => $lr, rr => $rr); - MKDEBUG && _d('Key comparison on left and right:', $cmp); + PTDEBUG && _d('Key comparison on left and right:', $cmp); } if ( $lr || $rr ) { if ( $lr && $rr && defined $cmp && $cmp == 0 ) { - MKDEBUG && _d('Left and right have the same key'); + PTDEBUG && _d('Left and right have the same key'); $syncer->same_row(%args, lr => $lr, rr => $rr); $self->{same_row}->(%args, lr => $lr, rr => $rr) if $self->{same_row}; $lr = $rr = undef; # Fetch another row from each side. } elsif ( !$rr || ( defined $cmp && $cmp < 0 ) ) { - MKDEBUG && _d('Left is not in right'); + PTDEBUG && _d('Left is not in right'); $syncer->not_in_right(%args, lr => $lr, rr => $rr); $self->{not_in_right}->(%args, lr => $lr, rr => $rr) if $self->{not_in_right}; $lr = undef; } else { - MKDEBUG && _d('Right is not in left'); + PTDEBUG && _d('Right is not in left'); $syncer->not_in_left(%args, lr => $lr, rr => $rr); $self->{not_in_left}->(%args, lr => $lr, rr => $rr) if $self->{not_in_left}; @@ -4962,7 +4962,7 @@ sub compare_sets { } $left_done = $right_done = 1 if $done && $done->(%args); } while ( !($left_done && $right_done) ); - MKDEBUG && _d('No more rows'); + PTDEBUG && _d('No more rows'); $syncer->done_with_rows(); } @@ -4973,7 +4973,7 @@ sub key_cmp { die "I need a $arg argument" unless exists $args{$arg}; } my ($lr, $rr, $key_cols, $tbl_struct) = @args{@required_args}; - MKDEBUG && _d('Comparing keys using columns:', join(',', @$key_cols)); + PTDEBUG && _d('Comparing keys using columns:', join(',', @$key_cols)); my $callback = $self->{key_cmp}; my $trf = $self->{trf}; @@ -4982,16 +4982,16 @@ sub key_cmp { my $l = $lr->{$col}; my $r = $rr->{$col}; if ( !defined $l || !defined $r ) { - MKDEBUG && _d($col, 'is not defined in both rows'); + PTDEBUG && _d($col, 'is not defined in both rows'); return defined $l ? 1 : defined $r ? -1 : 0; } else { if ( $tbl_struct->{is_numeric}->{$col} ) { # Numeric column - MKDEBUG && _d($col, 'is numeric'); + PTDEBUG && _d($col, 'is numeric'); ($l, $r) = $trf->($l, $r, $tbl_struct, $col) if $trf; my $cmp = $l <=> $r; if ( $cmp ) { - MKDEBUG && _d('Column', $col, 'differs:', $l, '!=', $r); + PTDEBUG && _d('Column', $col, 'differs:', $l, '!=', $r); $callback->($col, $l, $r) if $callback; return $cmp; } @@ -5002,15 +5002,15 @@ sub key_cmp { if ( $coll && ( $coll ne 'latin1_swedish_ci' || $l =~ m/[^\040-\177]/ || $r =~ m/[^\040-\177]/) ) { - MKDEBUG && _d('Comparing', $col, 'via MySQL'); + PTDEBUG && _d('Comparing', $col, 'via MySQL'); $cmp = $self->db_cmp($coll, $l, $r); } else { - MKDEBUG && _d('Comparing', $col, 'in lowercase'); + PTDEBUG && _d('Comparing', $col, 'in lowercase'); $cmp = lc $l cmp lc $r; } if ( $cmp ) { - MKDEBUG && _d('Column', $col, 'differs:', $l, 'ne', $r); + PTDEBUG && _d('Column', $col, 'differs:', $l, 'ne', $r); $callback->($col, $l, $r) if $callback; return $cmp; } @@ -5024,7 +5024,7 @@ sub db_cmp { my ( $self, $collation, $l, $r ) = @_; if ( !$self->{sth}->{$collation} ) { if ( !$self->{charset_for} ) { - MKDEBUG && _d('Fetching collations from MySQL'); + PTDEBUG && _d('Fetching collations from MySQL'); my @collations = @{$self->{dbh}->selectall_arrayref( 'SHOW COLLATION', {Slice => { collation => 1, charset => 1 }})}; foreach my $collation ( @collations ) { @@ -5034,7 +5034,7 @@ sub db_cmp { } my $sql = "SELECT STRCMP(_$self->{charset_for}->{$collation}? COLLATE $collation, " . "_$self->{charset_for}->{$collation}? COLLATE $collation) AS res"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $self->{sth}->{$collation} = $self->{dbh}->prepare($sql); } my $sth = $self->{sth}->{$collation}; @@ -5070,7 +5070,7 @@ package TableChunker; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(floor ceil); use List::Util qw(min max); @@ -5118,7 +5118,7 @@ sub find_chunk_columns { push @possible_indexes, $index; } - MKDEBUG && _d('Possible chunk indexes in order:', + PTDEBUG && _d('Possible chunk indexes in order:', join(', ', map { $_->{name} } @possible_indexes)); my $can_chunk_exact = 0; @@ -5136,14 +5136,14 @@ sub find_chunk_columns { $can_chunk_exact = 1 if $args{exact} && scalar @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { my $chunk_type = $args{exact} ? 'Exact' : 'Inexact'; _d($chunk_type, 'chunkable:', join(', ', map { "$_->{column} on $_->{index}" } @candidate_cols)); } my @result; - MKDEBUG && _d('Ordering columns by order in tbl, PK first'); + PTDEBUG && _d('Ordering columns by order in tbl, PK first'); if ( $tbl_struct->{keys}->{PRIMARY} ) { my $pk_first_col = $tbl_struct->{keys}->{PRIMARY}->{cols}->[0]; @result = grep { $_->{column} eq $pk_first_col } @candidate_cols; @@ -5154,7 +5154,7 @@ sub find_chunk_columns { push @result, sort { $col_pos{$a->{column}} <=> $col_pos{$b->{column}} } @candidate_cols; - if ( MKDEBUG ) { + if ( PTDEBUG ) { _d('Chunkable columns:', join(', ', map { "$_->{column} on $_->{index}" } @result)); _d('Can chunk exactly:', $can_chunk_exact); @@ -5169,18 +5169,18 @@ sub calculate_chunks { foreach my $arg ( @required_args ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Calculate chunks for', + PTDEBUG && _d('Calculate chunks for', join(", ", map {"$_=".(defined $args{$_} ? $args{$_} : "undef")} qw(db tbl chunk_col min max rows_in_range chunk_size zero_chunk exact) )); if ( !$args{rows_in_range} ) { - MKDEBUG && _d("Empty table"); + PTDEBUG && _d("Empty table"); return '1=1'; } if ( $args{rows_in_range} < $args{chunk_size} ) { - MKDEBUG && _d("Chunk size larger than rows in range"); + PTDEBUG && _d("Chunk size larger than rows in range"); return '1=1'; } @@ -5189,7 +5189,7 @@ sub calculate_chunks { my $chunk_col = $args{chunk_col}; my $tbl_struct = $args{tbl_struct}; my $col_type = $tbl_struct->{type_for}->{$chunk_col}; - MKDEBUG && _d('chunk col type:', $col_type); + PTDEBUG && _d('chunk col type:', $col_type); my %chunker; if ( $tbl_struct->{is_numeric}->{$chunk_col} || $col_type =~ /date|time/ ) { @@ -5201,7 +5201,7 @@ sub calculate_chunks { else { die "Cannot chunk $col_type columns"; } - MKDEBUG && _d("Chunker:", Dumper(\%chunker)); + PTDEBUG && _d("Chunker:", Dumper(\%chunker)); my ($col, $start_point, $end_point, $interval, $range_func) = @chunker{qw(col start_point end_point interval range_func)}; @@ -5241,7 +5241,7 @@ sub calculate_chunks { } } else { - MKDEBUG && _d('No chunks; using single chunk 1=1'); + PTDEBUG && _d('No chunks; using single chunk 1=1'); push @chunks, '1=1'; } @@ -5301,19 +5301,19 @@ sub _chunk_numeric { } if ( !defined $start_point ) { - MKDEBUG && _d('Start point is undefined'); + PTDEBUG && _d('Start point is undefined'); $start_point = 0; } if ( !defined $end_point || $end_point < $start_point ) { - MKDEBUG && _d('End point is undefined or before start point'); + PTDEBUG && _d('End point is undefined or before start point'); $end_point = 0; } - MKDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); my $have_zero_chunk = 0; if ( $args{zero_chunk} ) { if ( $start_point != $end_point && $start_point >= 0 ) { - MKDEBUG && _d('Zero chunking'); + PTDEBUG && _d('Zero chunking'); my $nonzero_val = $self->get_nonzero_value( %args, db_tbl => $db_tbl, @@ -5329,10 +5329,10 @@ sub _chunk_numeric { $have_zero_chunk = 1; } else { - MKDEBUG && _d("Cannot zero chunk"); + PTDEBUG && _d("Cannot zero chunk"); } } - MKDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); + PTDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); my $interval = $args{chunk_size} * ($end_point - $start_point) @@ -5344,7 +5344,7 @@ sub _chunk_numeric { if ( $args{exact} ) { $interval = $args{chunk_size}; } - MKDEBUG && _d('Chunk interval:', $interval, 'units'); + PTDEBUG && _d('Chunk interval:', $interval, 'units'); return ( col => $q->quote($args{chunk_col}), @@ -5371,21 +5371,21 @@ sub _chunk_char { $sql = "SELECT MIN($chunk_col), MAX($chunk_col) FROM $db_tbl " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my ($min_col, $max_col) = ($row->[0], $row->[1]); $sql = "SELECT ORD(?) AS min_col_ord, ORD(?) AS max_col_ord"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ord_sth = $dbh->prepare($sql); # avoid quoting issues $ord_sth->execute($min_col, $max_col); $row = $ord_sth->fetchrow_arrayref(); my ($min_col_ord, $max_col_ord) = ($row->[0], $row->[1]); - MKDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); + PTDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); my $base; my @chars; - MKDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); + PTDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); if ( ($args{tbl_struct}->{charset} || "") eq "latin1" ) { my @sorted_latin1_chars = ( 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, @@ -5413,16 +5413,16 @@ sub _chunk_char { my $tmp_tbl = '__maatkit_char_chunking_map'; my $tmp_db_tbl = $q->quote($args{db}, $tmp_tbl); $sql = "DROP TABLE IF EXISTS $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); my $col_def = $args{tbl_struct}->{defs}->{$chunk_col}; $sql = "CREATE TEMPORARY TABLE $tmp_db_tbl ($col_def) " . "ENGINE=MEMORY"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); $sql = "INSERT INTO $tmp_db_tbl VALUE (CHAR(?))"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $ins_char_sth = $dbh->prepare($sql); # avoid quoting issues for my $char_code ( $min_col_ord..$max_col_ord ) { $ins_char_sth->execute($char_code); @@ -5431,7 +5431,7 @@ sub _chunk_char { $sql = "SELECT `$chunk_col` FROM $tmp_db_tbl " . "WHERE `$chunk_col` BETWEEN ? AND ? " . "ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sel_char_sth = $dbh->prepare($sql); $sel_char_sth->execute($min_col, $max_col); @@ -5439,22 +5439,22 @@ sub _chunk_char { $base = scalar @chars; $sql = "DROP TABLE $tmp_db_tbl"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } - MKDEBUG && _d("Base", $base, "chars:", @chars); + PTDEBUG && _d("Base", $base, "chars:", @chars); $sql = "SELECT MAX(LENGTH($chunk_col)) FROM $db_tbl ORDER BY `$chunk_col`"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $row = $dbh->selectrow_arrayref($sql); my $max_col_len = $row->[0]; - MKDEBUG && _d("Max column value:", $max_col, $max_col_len); + PTDEBUG && _d("Max column value:", $max_col, $max_col_len); my $n_values; for my $n_chars ( 1..$max_col_len ) { $n_values = $base**$n_chars; if ( $n_values >= $args{chunk_size} ) { - MKDEBUG && _d($n_chars, "chars in base", $base, "expresses", + PTDEBUG && _d($n_chars, "chars in base", $base, "expresses", $n_values, "values"); last; } @@ -5499,7 +5499,7 @@ sub get_first_chunkable_column { my $wanted_col = $args{chunk_column}; my $wanted_idx = $args{chunk_index}; - MKDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); + PTDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); if ( $wanted_col && $wanted_idx ) { foreach my $chunkable_col ( @cols ) { @@ -5530,7 +5530,7 @@ sub get_first_chunkable_column { } } - MKDEBUG && _d('First chunkable col/index:', $col, $idx); + PTDEBUG && _d('First chunkable col/index:', $col, $idx); return $col, $idx; } @@ -5592,9 +5592,9 @@ sub get_range_statistics { my $sql = "SELECT MIN($col), MAX($col) FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE ($where)" : ''); - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); ($min, $max) = $dbh->selectrow_array($sql); - MKDEBUG && _d("Actual end points:", $min, $max); + PTDEBUG && _d("Actual end points:", $min, $max); ($min, $max) = $self->get_valid_end_points( %args, @@ -5605,7 +5605,7 @@ sub get_range_statistics { min => $min, max => $max, ); - MKDEBUG && _d("Valid end points:", $min, $max); + PTDEBUG && _d("Valid end points:", $min, $max); }; if ( $EVAL_ERROR ) { die "Error getting min and max values for table $db_tbl " @@ -5615,7 +5615,7 @@ sub get_range_statistics { my $sql = "EXPLAIN SELECT * FROM $db_tbl" . ($args{index_hint} ? " $args{index_hint}" : "") . ($where ? " WHERE $where" : ''); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $expl = $dbh->selectrow_hashref($sql); return ( @@ -5630,7 +5630,7 @@ sub inject_chunks { foreach my $arg ( qw(database table chunks chunk_num query) ) { die "I need a $arg argument" unless defined $args{$arg}; } - MKDEBUG && _d('Injecting chunk', $args{chunk_num}); + PTDEBUG && _d('Injecting chunk', $args{chunk_num}); my $query = $args{query}; my $comment = sprintf("/*%s.%s:%d/%d*/", $args{database}, $args{table}, @@ -5645,7 +5645,7 @@ sub inject_chunks { my $db_tbl = $self->{Quoter}->quote(@args{qw(database table)}); my $index_hint = $args{index_hint} || ''; - MKDEBUG && _d('Parameters:', + PTDEBUG && _d('Parameters:', Dumper({WHERE => $where, DB_TBL => $db_tbl, INDEX_HINT => $index_hint})); $query =~ s!/\*WHERE\*/! $where!; $query =~ s!/\*DB_TBL\*/!$db_tbl!; @@ -5664,7 +5664,7 @@ sub value_to_number { } my $val = $args{value}; my ($col_type, $dbh) = @args{@required_args}; - MKDEBUG && _d('Converting MySQL', $col_type, $val); + PTDEBUG && _d('Converting MySQL', $col_type, $val); return unless defined $val; # value is NULL @@ -5682,7 +5682,7 @@ sub value_to_number { elsif ( $col_type =~ m/^(?:timestamp|date|time)$/ ) { my $func = $mysql_conv_func_for{$col_type}; my $sql = "SELECT $func(?)"; - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val); ($num) = $sth->fetchrow_array(); @@ -5693,7 +5693,7 @@ sub value_to_number { else { die "I don't know how to chunk $col_type\n"; } - MKDEBUG && _d('Converts to', $num); + PTDEBUG && _d('Converts to', $num); return $num; } @@ -5719,14 +5719,14 @@ sub range_num { sub range_time { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT SEC_TO_TIME($start), SEC_TO_TIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_date { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_DAYS($start), FROM_DAYS(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -5734,14 +5734,14 @@ sub range_datetime { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $start SECOND), " . "DATE_ADD('$self->{EPOCH}', INTERVAL LEAST($max, $start + $interval) SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } sub range_timestamp { my ( $self, $dbh, $start, $interval, $max ) = @_; my $sql = "SELECT FROM_UNIXTIME($start), FROM_UNIXTIME(LEAST($max, $start + $interval))"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); return $dbh->selectrow_array($sql); } @@ -5749,10 +5749,10 @@ sub timestampdiff { my ( $self, $dbh, $time ) = @_; my $sql = "SELECT (COALESCE(TO_DAYS('$time'), 0) * 86400 + TIME_TO_SEC('$time')) " . "- TO_DAYS('$self->{EPOCH} 00:00:00') * 86400"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $diff ) = $dbh->selectrow_array($sql); $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $diff SECOND)"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my ( $check ) = $dbh->selectrow_array($sql); die <<" EOF" Incorrect datetime math: given $time, calculated $diff but checked to $check. @@ -5784,7 +5784,7 @@ sub get_valid_end_points { my $valid_min = $real_min; if ( defined $valid_min ) { - MKDEBUG && _d("Validating min end point:", $real_min); + PTDEBUG && _d("Validating min end point:", $real_min); $valid_min = $self->_get_valid_end_point( %args, val => $real_min, @@ -5797,7 +5797,7 @@ sub get_valid_end_points { my $valid_max = $real_max; if ( defined $valid_max ) { - MKDEBUG && _d("Validating max end point:", $real_min); + PTDEBUG && _d("Validating max end point:", $real_min); $valid_max = $self->_get_valid_end_point( %args, val => $real_max, @@ -5826,13 +5826,13 @@ sub _get_valid_end_point { : undef; if ( !$validate ) { - MKDEBUG && _d("No validator for", $col_type, "values"); + PTDEBUG && _d("No validator for", $col_type, "values"); return $val; } return $val if defined $validate->($dbh, $val); - MKDEBUG && _d("Value is invalid, getting first valid value"); + PTDEBUG && _d("Value is invalid, getting first valid value"); $val = $self->get_first_valid_value( %args, val => $val, @@ -5862,20 +5862,20 @@ sub get_first_valid_value { . "WHERE $col $cmp ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : "") . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my $sth = $dbh->prepare($sql); my $last_val = $val; while ( $tries-- ) { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); - MKDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); + PTDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); if ( !defined $next_val ) { - MKDEBUG && _d('No more rows in table'); + PTDEBUG && _d('No more rows in table'); last; } if ( defined $validate->($dbh, $next_val) ) { - MKDEBUG && _d('First valid value:', $next_val); + PTDEBUG && _d('First valid value:', $next_val); $sth->finish(); return $next_val; } @@ -5892,14 +5892,14 @@ sub _validate_temporal_value { my $sql = "SELECT IF(TIME_FORMAT(?,'%H:%i:%s')=?, TIME_TO_SEC(?), TO_DAYS(?))"; my $res; eval { - MKDEBUG && _d($dbh, $sql, $val); + PTDEBUG && _d($dbh, $sql, $val); my $sth = $dbh->prepare($sql); $sth->execute($val, $val, $val, $val); ($res) = $sth->fetchrow_array(); $sth->finish(); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } return $res; } @@ -5918,13 +5918,13 @@ sub get_nonzero_value { : sub { return $_[1]; }; if ( !$is_nonzero->($dbh, $val) ) { # quasi-double-negative, sorry - MKDEBUG && _d('Discarding zero value:', $val); + PTDEBUG && _d('Discarding zero value:', $val); my $sql = "SELECT $col FROM $db_tbl " . ($args{index_hint} ? "$args{index_hint} " : "") . "WHERE $col > ? AND $col IS NOT NULL " . ($args{where} ? "AND ($args{where}) " : '') . "ORDER BY $col LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $sth = $dbh->prepare($sql); my $last_val = $val; @@ -5932,7 +5932,7 @@ sub get_nonzero_value { $sth->execute($last_val); my ($next_val) = $sth->fetchrow_array(); if ( $is_nonzero->($dbh, $next_val) ) { - MKDEBUG && _d('First non-zero value:', $next_val); + PTDEBUG && _d('First non-zero value:', $next_val); $sth->finish(); return $next_val; } @@ -6003,7 +6003,7 @@ package TableNibbler; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -6032,11 +6032,11 @@ sub generate_asc_stmt { my @asc_slice; @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; - MKDEBUG && _d('Will ascend index', $index); - MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); + PTDEBUG && _d('Will ascend index', $index); + PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); if ( $args{asc_first} ) { @asc_cols = $asc_cols[0]; - MKDEBUG && _d('Ascending only first column'); + PTDEBUG && _d('Ascending only first column'); } my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; @@ -6047,7 +6047,7 @@ sub generate_asc_stmt { } push @asc_slice, $col_posn{$col}; } - MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); + PTDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); my $asc_stmt = { cols => \@cols, @@ -6168,7 +6168,7 @@ sub generate_del_stmt { else { @del_cols = @{$tbl->{cols}}; } - MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); + PTDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; foreach my $col ( @del_cols ) { @@ -6178,7 +6178,7 @@ sub generate_del_stmt { } push @del_slice, $col_posn{$col}; } - MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); + PTDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); my $del_stmt = { cols => \@cols, @@ -6262,7 +6262,7 @@ package TableChecksum; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); @@ -6317,13 +6317,13 @@ sub get_crc_type { $sth->execute(); $type = $sth->{mysql_type_name}->[0]; $length = $sth->{mysql_length}->[0]; - MKDEBUG && _d($sql, $type, $length); + PTDEBUG && _d($sql, $type, $length); if ( $type eq 'bigint' && $length < 20 ) { $type = 'int'; } }; $sth->finish; - MKDEBUG && _d('crc_type:', $type, 'length:', $length); + PTDEBUG && _d('crc_type:', $type, 'length:', $length); return ($type, $length); } @@ -6340,26 +6340,26 @@ sub best_algorithm { || $args{replicate} # CHECKSUM can't do INSERT.. SELECT || !$vp->version_ge($dbh, '4.1.1')) # CHECKSUM doesn't exist { - MKDEBUG && _d('Cannot use CHECKSUM algorithm'); + PTDEBUG && _d('Cannot use CHECKSUM algorithm'); @choices = grep { $_ ne 'CHECKSUM' } @choices; } if ( !$vp->version_ge($dbh, '4.1.1') ) { - MKDEBUG && _d('Cannot use BIT_XOR algorithm because MySQL < 4.1.1'); + PTDEBUG && _d('Cannot use BIT_XOR algorithm because MySQL < 4.1.1'); @choices = grep { $_ ne 'BIT_XOR' } @choices; } if ( $alg && grep { $_ eq $alg } @choices ) { - MKDEBUG && _d('User requested', $alg, 'algorithm'); + PTDEBUG && _d('User requested', $alg, 'algorithm'); return $alg; } if ( $args{count} && grep { $_ ne 'CHECKSUM' } @choices ) { - MKDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired'); + PTDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired'); @choices = grep { $_ ne 'CHECKSUM' } @choices; } - MKDEBUG && _d('Algorithms, in order:', @choices); + PTDEBUG && _d('Algorithms, in order:', @choices); return $choices[0]; } @@ -6380,18 +6380,18 @@ sub choose_hash_func { eval { $func = shift(@funcs); my $sql = "SELECT $func('test-string')"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $args{dbh}->do($sql); $result = $func; }; if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) { $error .= qq{$func cannot be used because "$1"\n}; - MKDEBUG && _d($func, 'cannot be used because', $1); + PTDEBUG && _d($func, 'cannot be used because', $1); } } while ( @funcs && !$result ); die $error unless $result; - MKDEBUG && _d('Chosen hash func:', $result); + PTDEBUG && _d('Chosen hash func:', $result); return $result; } @@ -6409,7 +6409,7 @@ sub optimize_xor { my $crc_wid = length($unsliced) < 16 ? 16 : length($unsliced); do { # Try different positions till sliced result equals non-sliced. - MKDEBUG && _d('Trying slice', $opt_slice); + PTDEBUG && _d('Trying slice', $opt_slice); $dbh->do('SET @crc := "", @cnt := 0'); my $slices = $self->make_xor_slices( query => "\@crc := $func('a')", @@ -6420,18 +6420,18 @@ sub optimize_xor { my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x"; $sliced = ($dbh->selectrow_array($sql))[0]; if ( $sliced ne $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'does not work'); + PTDEBUG && _d('Slice', $opt_slice, 'does not work'); $start += 16; ++$opt_slice; } } while ( $start < $crc_wid && $sliced ne $unsliced ); if ( $sliced eq $unsliced ) { - MKDEBUG && _d('Slice', $opt_slice, 'works'); + PTDEBUG && _d('Slice', $opt_slice, 'works'); return $opt_slice; } else { - MKDEBUG && _d('No slice works'); + PTDEBUG && _d('No slice works'); return undef; } } @@ -6612,7 +6612,7 @@ sub find_replication_differences { OR ISNULL(master_crc) <> ISNULL(this_crc) EOF - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} }); return @$diffs; } @@ -6645,7 +6645,7 @@ package TableSyncer; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -6667,16 +6667,16 @@ sub get_best_plugin { foreach my $arg ( qw(plugins tbl_struct) ) { die "I need a $arg argument" unless $args{$arg}; } - MKDEBUG && _d('Getting best plugin'); + PTDEBUG && _d('Getting best plugin'); foreach my $plugin ( @{$args{plugins}} ) { - MKDEBUG && _d('Trying plugin', $plugin->name); + PTDEBUG && _d('Trying plugin', $plugin->name); my ($can_sync, %plugin_args) = $plugin->can_sync(%args); if ( $can_sync ) { - MKDEBUG && _d('Can sync with', $plugin->name, Dumper(\%plugin_args)); + PTDEBUG && _d('Can sync with', $plugin->name, Dumper(\%plugin_args)); return $plugin, %plugin_args; } } - MKDEBUG && _d('No plugin can sync the table'); + PTDEBUG && _d('No plugin can sync the table'); return; } @@ -6687,7 +6687,7 @@ sub sync_table { foreach my $arg ( @required_args ) { die "I need a $arg argument" unless $args{$arg}; } - MKDEBUG && _d('Syncing table with args:', + PTDEBUG && _d('Syncing table with args:', map { "$_: " . Dumper($args{$_}) } qw(plugins src dst tbl_struct cols chunk_size)); @@ -6716,21 +6716,21 @@ sub sync_table { while ( $tbl_struct->{is_col}->{$crc_col} ) { $crc_col = "_$crc_col"; # Prepend more _ until not a column. } - MKDEBUG && _d('CRC column:', $crc_col); + PTDEBUG && _d('CRC column:', $crc_col); my $index_hint; my $hint = ($vp->version_ge($src->{dbh}, '4.0.9') && $vp->version_ge($dst->{dbh}, '4.0.9') ? 'FORCE' : 'USE') . ' INDEX'; if ( $args{chunk_index} ) { - MKDEBUG && _d('Using given chunk index for index hint'); + PTDEBUG && _d('Using given chunk index for index hint'); $index_hint = "$hint (" . $q->quote($args{chunk_index}) . ")"; } elsif ( $plugin_args{chunk_index} && $args{index_hint} ) { - MKDEBUG && _d('Using chunk index chosen by plugin for index hint'); + PTDEBUG && _d('Using chunk index chosen by plugin for index hint'); $index_hint = "$hint (" . $q->quote($plugin_args{chunk_index}) . ")"; } - MKDEBUG && _d('Index hint:', $index_hint); + PTDEBUG && _d('Index hint:', $index_hint); eval { $plugin->prepare_to_sync( @@ -6771,8 +6771,8 @@ sub sync_table { die "Failed to USE database on source or destination: $EVAL_ERROR"; } - MKDEBUG && _d('left dbh', $src->{dbh}); - MKDEBUG && _d('right dbh', $dst->{dbh}); + PTDEBUG && _d('left dbh', $src->{dbh}); + PTDEBUG && _d('right dbh', $dst->{dbh}); chomp(my $hostname = `hostname`); my $trace_msg @@ -6786,7 +6786,7 @@ sub sync_table { . ($ENV{USER} ? "user:$ENV{USER} " : "") . ($hostname ? "host:$hostname" : "") : ""; - MKDEBUG && _d("Binlog trace message:", $trace_msg); + PTDEBUG && _d("Binlog trace message:", $trace_msg); $self->lock_and_wait(%args, lock_level => 2); # per-table lock @@ -6794,7 +6794,7 @@ sub sync_table { my $cycle = 0; while ( !$plugin->done() ) { - MKDEBUG && _d('Beginning sync cycle', $cycle); + PTDEBUG && _d('Beginning sync cycle', $cycle); my $src_sql = $plugin->get_sql( database => $src->{db}, table => $src->{tbl}, @@ -6820,8 +6820,8 @@ sub sync_table { $dst_sql .= ' FOR UPDATE'; } } - MKDEBUG && _d('src:', $src_sql); - MKDEBUG && _d('dst:', $dst_sql); + PTDEBUG && _d('src:', $src_sql); + PTDEBUG && _d('dst:', $dst_sql); $callback->($src_sql, $dst_sql) if $callback; @@ -6854,7 +6854,7 @@ sub sync_table { ); $ch->process_rows(1, $trace_msg); - MKDEBUG && _d('Finished sync cycle', $cycle); + PTDEBUG && _d('Finished sync cycle', $cycle); $cycle++; } @@ -6892,7 +6892,7 @@ sub make_checksum_queries { die "Source and destination checksum algorithms are different: ", "$src_algo on source, $dst_algo on destination" } - MKDEBUG && _d('Chosen algo:', $src_algo); + PTDEBUG && _d('Chosen algo:', $src_algo); my $src_func = $checksum->choose_hash_func(dbh => $src->{dbh}, %args); my $dst_func = $checksum->choose_hash_func(dbh => $dst->{dbh}, %args); @@ -6900,7 +6900,7 @@ sub make_checksum_queries { die "Source and destination hash functions are different: ", "$src_func on source, $dst_func on destination"; } - MKDEBUG && _d('Chosen hash func:', $src_func); + PTDEBUG && _d('Chosen hash func:', $src_func); my $crc_wid = $checksum->get_crc_wid($src->{dbh}, $src_func); @@ -6924,21 +6924,21 @@ sub make_checksum_queries { opt_slice => $opt_slice, replicate => undef, # replicate means something different to this sub ); # than what we use it for; do not pass it! - MKDEBUG && _d('Chunk sql:', $chunk_sql); + PTDEBUG && _d('Chunk sql:', $chunk_sql); my $row_sql = $checksum->make_row_checksum( %args, function => $src_func, ); - MKDEBUG && _d('Row sql:', $row_sql); + PTDEBUG && _d('Row sql:', $row_sql); return $chunk_sql, $row_sql; } sub lock_table { my ( $self, $dbh, $where, $db_tbl, $mode ) = @_; my $query = "LOCK TABLES $db_tbl $mode"; - MKDEBUG && _d($query); + PTDEBUG && _d($query); $dbh->do($query); - MKDEBUG && _d('Acquired table lock on', $where, 'in', $mode, 'mode'); + PTDEBUG && _d('Acquired table lock on', $where, 'in', $mode, 'mode'); } sub unlock { @@ -6954,12 +6954,12 @@ sub unlock { foreach my $dbh ( $src->{dbh}, $dst->{dbh} ) { if ( $args{transaction} ) { - MKDEBUG && _d('Committing', $dbh); + PTDEBUG && _d('Committing', $dbh); $dbh->commit(); } else { my $sql = 'UNLOCK TABLES'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } } @@ -6978,32 +6978,32 @@ sub lock_and_wait { my $dst = $args{dst}; return unless $args{lock} && $args{lock} == $args{lock_level}; - MKDEBUG && _d('lock and wait, lock level', $args{lock}); + PTDEBUG && _d('lock and wait, lock level', $args{lock}); foreach my $dbh ( $src->{dbh}, $dst->{dbh} ) { if ( $args{transaction} ) { - MKDEBUG && _d('Committing', $dbh); + PTDEBUG && _d('Committing', $dbh); $dbh->commit(); } else { my $sql = 'UNLOCK TABLES'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); } } if ( $args{lock} == 3 ) { my $sql = 'FLUSH TABLES WITH READ LOCK'; - MKDEBUG && _d($src->{dbh}, $sql); + PTDEBUG && _d($src->{dbh}, $sql); $src->{dbh}->do($sql); } else { if ( $args{transaction} ) { if ( $args{src_sth} ) { - MKDEBUG && _d('Executing statement on source to lock rows'); + PTDEBUG && _d('Executing statement on source to lock rows'); my $sql = "START TRANSACTION /*!40108 WITH CONSISTENT SNAPSHOT */"; - MKDEBUG && _d($src->{dbh}, $sql); + PTDEBUG && _d($src->{dbh}, $sql); $src->{dbh}->do($sql); $args{src_sth}->execute(); @@ -7074,13 +7074,13 @@ sub lock_and_wait { } if ( $args{changing_src} ) { - MKDEBUG && _d('Not locking destination because changing source ', + PTDEBUG && _d('Not locking destination because changing source ', '(syncing via replication or sync-to-master)'); } else { if ( $args{lock} == 3 ) { my $sql = 'FLUSH TABLES WITH READ LOCK'; - MKDEBUG && _d($dst->{dbh}, ',', $sql); + PTDEBUG && _d($dst->{dbh}, ',', $sql); $dst->{dbh}->do($sql); } elsif ( !$args{transaction} ) { @@ -7096,7 +7096,7 @@ sub lock_and_wait { } foreach my $dbh ( $src->{dbh}, $dst->{dbh}, $src->{misc_dbh} ) { next unless $dbh; - MKDEBUG && _d('Caught error, unlocking/committing on', $dbh); + PTDEBUG && _d('Caught error, unlocking/committing on', $dbh); $dbh->do('UNLOCK TABLES'); $dbh->commit() unless $dbh->{AutoCommit}; } @@ -7110,23 +7110,23 @@ sub have_all_privs { my ( $self, $dbh, $db, $tbl ) = @_; my $db_tbl = $self->{Quoter}->quote($db, $tbl); my $sql = "SHOW FULL COLUMNS FROM $db_tbl"; - MKDEBUG && _d('Permissions check:', $sql); + PTDEBUG && _d('Permissions check:', $sql); my $cols = $dbh->selectall_arrayref($sql, {Slice => {}}); my ($hdr_name) = grep { m/privileges/i } keys %{$cols->[0]}; my $privs = $cols->[0]->{$hdr_name}; $sql = "DELETE FROM $db_tbl LIMIT 0"; # FULL COLUMNS doesn't show all privs - MKDEBUG && _d('Permissions check:', $sql); + PTDEBUG && _d('Permissions check:', $sql); eval { $dbh->do($sql); }; my $can_delete = $EVAL_ERROR ? 0 : 1; - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, + PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, ($can_delete ? 'delete' : '')); if ( $privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ && $can_delete ) { - MKDEBUG && _d('User has all privs'); + PTDEBUG && _d('User has all privs'); return 1; } - MKDEBUG && _d('User does not have all privs'); + PTDEBUG && _d('User does not have all privs'); return 0; } @@ -7158,7 +7158,7 @@ package TableSyncChunk; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -7198,7 +7198,7 @@ sub can_sync { my $colno; if ( $args{chunk_col} || $args{chunk_index} ) { - MKDEBUG && _d('Checking requested col', $args{chunk_col}, + PTDEBUG && _d('Checking requested col', $args{chunk_col}, 'and/or index', $args{chunk_index}); for my $i ( 0..$#chunkable_cols ) { if ( $args{chunk_col} ) { @@ -7212,7 +7212,7 @@ sub can_sync { } if ( !$colno ) { - MKDEBUG && _d('Cannot chunk on column', $args{chunk_col}, + PTDEBUG && _d('Cannot chunk on column', $args{chunk_col}, 'and/or using index', $args{chunk_index}); return; } @@ -7221,7 +7221,7 @@ sub can_sync { $colno = 0; # First, best chunkable column/index. } - MKDEBUG && _d('Can chunk on column', $chunkable_cols[$colno]->{column}, + PTDEBUG && _d('Can chunk on column', $chunkable_cols[$colno]->{column}, 'using index', $chunkable_cols[$colno]->{index}); return ( 1, @@ -7256,7 +7256,7 @@ sub prepare_to_sync { @chunks = $chunker->calculate_chunks(%args, %range_params); } else { - MKDEBUG && _d('No range statistics; using single chunk 1=1'); + PTDEBUG && _d('No range statistics; using single chunk 1=1'); @chunks = '1=1'; } @@ -7283,7 +7283,7 @@ sub set_checksum_queries { sub prepare_sync_cycle { my ( $self, $host ) = @_; my $sql = 'SET @crc := "", @cnt := 0'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $host->{dbh}->do($sql); return; } @@ -7337,8 +7337,8 @@ sub same_row { } } elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) { - MKDEBUG && _d('Rows:', Dumper($lr, $rr)); - MKDEBUG && _d('Will examine this chunk before moving to next'); + PTDEBUG && _d('Rows:', Dumper($lr, $rr)); + PTDEBUG && _d('Will examine this chunk before moving to next'); $self->{state} = 1; # Must examine this chunk row-by-row } } @@ -7389,12 +7389,12 @@ sub done_with_rows { my ( $self ) = @_; if ( $self->{state} == 1 ) { $self->{state} = 2; - MKDEBUG && _d('Setting state =', $self->{state}); + PTDEBUG && _d('Setting state =', $self->{state}); } else { $self->{state} = 0; $self->{chunk_num}++; - MKDEBUG && _d('Setting state =', $self->{state}, + PTDEBUG && _d('Setting state =', $self->{state}, 'chunk_num =', $self->{chunk_num}); } return; @@ -7402,9 +7402,9 @@ sub done_with_rows { sub done { my ( $self ) = @_; - MKDEBUG && _d('Done with', $self->{chunk_num}, 'of', + PTDEBUG && _d('Done with', $self->{chunk_num}, 'of', scalar(@{$self->{chunks}}), 'chunks'); - MKDEBUG && $self->{state} && _d('Chunk differs; must examine rows'); + PTDEBUG && $self->{state} && _d('Chunk differs; must examine rows'); return $self->{state} == 0 && $self->{chunk_num} >= scalar(@{$self->{chunks}}) } @@ -7412,11 +7412,11 @@ sub done { sub pending_changes { my ( $self ) = @_; if ( $self->{state} ) { - MKDEBUG && _d('There are pending changes'); + PTDEBUG && _d('There are pending changes'); return 1; } else { - MKDEBUG && _d('No pending changes'); + PTDEBUG && _d('No pending changes'); return 0; } } @@ -7430,7 +7430,7 @@ sub key_cols { else { @cols = $self->{chunk_col}; } - MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); + PTDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); return \@cols; } @@ -7462,7 +7462,7 @@ package TableSyncNibble; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -7490,19 +7490,19 @@ sub can_sync { my $nibble_index = $self->{TableParser}->find_best_index($args{tbl_struct}); if ( $nibble_index ) { - MKDEBUG && _d('Best nibble index:', Dumper($nibble_index)); + PTDEBUG && _d('Best nibble index:', Dumper($nibble_index)); if ( !$args{tbl_struct}->{keys}->{$nibble_index}->{is_unique} ) { - MKDEBUG && _d('Best nibble index is not unique'); + PTDEBUG && _d('Best nibble index is not unique'); return; } if ( $args{chunk_index} && $args{chunk_index} ne $nibble_index ) { - MKDEBUG && _d('Best nibble index is not requested index', + PTDEBUG && _d('Best nibble index is not requested index', $args{chunk_index}); return; } } else { - MKDEBUG && _d('No best nibble index returned'); + PTDEBUG && _d('No best nibble index returned'); return; } @@ -7515,10 +7515,10 @@ sub can_sync { eval { my $sql = "SHOW TABLE STATUS FROM `$db` LIKE " . $self->{Quoter}->literal_like($tbl); - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $table_status = $dbh->selectrow_hashref($sql); }; - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); if ( $table_status ) { my $n_rows = defined $table_status->{Rows} ? $table_status->{Rows} : defined $table_status->{rows} ? $table_status->{rows} @@ -7526,9 +7526,9 @@ sub can_sync { $small_table = 1 if defined $n_rows && $n_rows <= 100; } } - MKDEBUG && _d('Small table:', $small_table); + PTDEBUG && _d('Small table:', $small_table); - MKDEBUG && _d('Can nibble using index', $nibble_index); + PTDEBUG && _d('Can nibble using index', $nibble_index); return ( 1, chunk_index => $nibble_index, @@ -7592,7 +7592,7 @@ sub set_checksum_queries { sub prepare_sync_cycle { my ( $self, $host ) = @_; my $sql = 'SET @crc := "", @cnt := 0'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $host->{dbh}->do($sql); return; } @@ -7634,16 +7634,16 @@ sub __get_boundaries { my $row; # Next upper boundary row or cached_row if ( $self->{cached_boundaries} ) { - MKDEBUG && _d('Using cached boundaries'); + PTDEBUG && _d('Using cached boundaries'); return $self->{cached_boundaries}; } if ( $self->{cached_row} && $self->{cached_nibble} == $self->{nibble} ) { - MKDEBUG && _d('Using cached row for boundaries'); + PTDEBUG && _d('Using cached row for boundaries'); $row = $self->{cached_row}; } else { - MKDEBUG && _d('Getting next upper boundary row'); + PTDEBUG && _d('Getting next upper boundary row'); my $sql; ($sql, $lb) = $self->__make_boundary_sql(%args); # $lb from outer scope! @@ -7658,7 +7658,7 @@ sub __get_boundaries { } $row = $self->{dbh}->selectrow_hashref($sql); - MKDEBUG && _d($row ? 'Got a row' : "Didn't get a row"); + PTDEBUG && _d($row ? 'Got a row' : "Didn't get a row"); } if ( $row ) { @@ -7667,7 +7667,7 @@ sub __get_boundaries { $ub =~ s/\?/$q->quote_val($row->{$s->{scols}->[$i]}, $self->{tbl_struct}->{is_numeric}->{$s->{scols}->[$i++]} || 0)/eg; } else { - MKDEBUG && _d('No upper boundary'); + PTDEBUG && _d('No upper boundary'); $ub = '1=1'; } @@ -7677,7 +7677,7 @@ sub __get_boundaries { $self->{cached_nibble} = $self->{nibble}; $self->{cached_boundaries} = $where; - MKDEBUG && _d('WHERE clause:', $where); + PTDEBUG && _d('WHERE clause:', $where); return $where; } @@ -7701,8 +7701,8 @@ sub __make_boundary_sql { } $sql .= " ORDER BY " . join(',', map { $q->quote($_) } @{$self->{key_cols}}) . ' LIMIT ' . ($self->{chunk_size} - 1) . ', 1'; - MKDEBUG && _d('Lower boundary:', $lb); - MKDEBUG && _d('Next boundary sql:', $sql); + PTDEBUG && _d('Lower boundary:', $lb); + PTDEBUG && _d('Next boundary sql:', $sql); return $sql, $lb; } @@ -7714,10 +7714,10 @@ sub __get_explain_index { $explain = $self->{dbh}->selectall_arrayref("EXPLAIN $sql",{Slice => {}}); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); return; } - MKDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); + PTDEBUG && _d('EXPLAIN key:', $explain->[0]->{key}); return $explain->[0]->{key}; } @@ -7730,8 +7730,8 @@ sub same_row { } } elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) { - MKDEBUG && _d('Rows:', Dumper($lr, $rr)); - MKDEBUG && _d('Will examine this nibble before moving to next'); + PTDEBUG && _d('Rows:', Dumper($lr, $rr)); + PTDEBUG && _d('Will examine this nibble before moving to next'); $self->{state} = 1; # Must examine this nibble row-by-row } } @@ -7752,32 +7752,32 @@ sub done_with_rows { my ( $self ) = @_; if ( $self->{state} == 1 ) { $self->{state} = 2; - MKDEBUG && _d('Setting state =', $self->{state}); + PTDEBUG && _d('Setting state =', $self->{state}); } else { $self->{state} = 0; $self->{nibble}++; delete $self->{cached_boundaries}; - MKDEBUG && _d('Setting state =', $self->{state}, + PTDEBUG && _d('Setting state =', $self->{state}, ', nibble =', $self->{nibble}); } } sub done { my ( $self ) = @_; - MKDEBUG && _d('Done with nibble', $self->{nibble}); - MKDEBUG && $self->{state} && _d('Nibble differs; must examine rows'); + PTDEBUG && _d('Done with nibble', $self->{nibble}); + PTDEBUG && $self->{state} && _d('Nibble differs; must examine rows'); return $self->{state} == 0 && $self->{nibble} && !$self->{cached_row}; } sub pending_changes { my ( $self ) = @_; if ( $self->{state} ) { - MKDEBUG && _d('There are pending changes'); + PTDEBUG && _d('There are pending changes'); return 1; } else { - MKDEBUG && _d('No pending changes'); + PTDEBUG && _d('No pending changes'); return 0; } } @@ -7791,7 +7791,7 @@ sub key_cols { else { @cols = @{$self->{key_cols}}; } - MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); + PTDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols)); return \@cols; } @@ -7823,7 +7823,7 @@ package TableSyncGroupBy; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -7857,7 +7857,7 @@ sub prepare_to_sync { while ( $args{tbl_struct}->{is_col}->{$self->{count_col}} ) { $self->{count_col} = "_$self->{count_col}"; } - MKDEBUG && _d('COUNT column will be named', $self->{count_col}); + PTDEBUG && _d('COUNT column will be named', $self->{count_col}); $self->{done} = 0; @@ -7978,7 +7978,7 @@ package Outfile; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -8031,7 +8031,7 @@ package MockSyncStream; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -8152,7 +8152,7 @@ package MockSth; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, @rows ) = @_; @@ -8226,7 +8226,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -8236,7 +8236,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -8247,7 +8247,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -8265,7 +8265,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -8277,7 +8277,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -8309,7 +8309,7 @@ package ReportFormatter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(min max); use POSIX qw(ceil); @@ -8342,7 +8342,7 @@ sub new { . "is not installed" unless $have_term; ($self->{line_width}) = GetTerminalSize(); } - MKDEBUG && _d('Line width:', $self->{line_width}); + PTDEBUG && _d('Line width:', $self->{line_width}); return bless $self, $class; } @@ -8367,7 +8367,7 @@ sub set_columns { if ( $col->{width} ) { $col->{width_pct} = ceil(($col->{width} * 100) / $self->{line_width}); - MKDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', + PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', $col->{width_pct}, '%'); } @@ -8375,7 +8375,7 @@ sub set_columns { $used_width += $col->{width_pct}; } else { - MKDEBUG && _d('Auto width col:', $col_name); + PTDEBUG && _d('Auto width col:', $col_name); $col->{auto_width} = 1; push @auto_width_cols, $i; } @@ -8404,15 +8404,15 @@ sub set_columns { if ( @auto_width_cols ) { my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols); - MKDEBUG && _d('Line width left:', (100-$used_width), '%;', + PTDEBUG && _d('Line width left:', (100-$used_width), '%;', 'each auto width col:', $wid_per_col, '%'); map { $self->{cols}->[$_]->{width_pct} = $wid_per_col } @auto_width_cols; } $min_hdr_wid += ($self->{n_cols} - 1) * length $self->{column_spacing}; - MKDEBUG && _d('min header width:', $min_hdr_wid); + PTDEBUG && _d('min header width:', $min_hdr_wid); if ( $min_hdr_wid > $self->{line_width} ) { - MKDEBUG && _d('Will truncate headers because min header width', + PTDEBUG && _d('Will truncate headers because min header width', $min_hdr_wid, '> line width', $self->{line_width}); $self->{truncate_headers} = 1; } @@ -8453,7 +8453,7 @@ sub get_report { my @col_fmts = $self->_make_column_formats(); my $fmt = ($self->{line_prefix} || '') . join($self->{column_spacing}, @col_fmts); - MKDEBUG && _d('Format:', $fmt); + PTDEBUG && _d('Format:', $fmt); (my $hdr_fmt = $fmt) =~ s/%([^-])/%-$1/g; @@ -8505,7 +8505,7 @@ sub truncate_value { $val = $mark . substr($val, -1 * $width + length $mark); } else { - MKDEBUG && _d("I don't know how to", $side, "truncate values"); + PTDEBUG && _d("I don't know how to", $side, "truncate values"); } return $val; } @@ -8517,27 +8517,27 @@ sub _calculate_column_widths { foreach my $col ( @{$self->{cols}} ) { my $print_width = int($self->{line_width} * ($col->{width_pct} / 100)); - MKDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, + PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, 'char width:', $print_width, 'min val:', $col->{min_val}, 'max val:', $col->{max_val}); if ( $col->{auto_width} ) { if ( $col->{min_val} && $print_width < $col->{min_val} ) { - MKDEBUG && _d('Increased to min val width:', $col->{min_val}); + PTDEBUG && _d('Increased to min val width:', $col->{min_val}); $print_width = $col->{min_val}; } elsif ( $col->{max_val} && $print_width > $col->{max_val} ) { - MKDEBUG && _d('Reduced to max val width:', $col->{max_val}); + PTDEBUG && _d('Reduced to max val width:', $col->{max_val}); $extra_space += $print_width - $col->{max_val}; $print_width = $col->{max_val}; } } $col->{print_width} = $print_width; - MKDEBUG && _d('print width:', $col->{print_width}); + PTDEBUG && _d('print width:', $col->{print_width}); } - MKDEBUG && _d('Extra space:', $extra_space); + PTDEBUG && _d('Extra space:', $extra_space); while ( $extra_space-- ) { foreach my $col ( @{$self->{cols}} ) { if ( $col->{auto_width} @@ -8560,7 +8560,7 @@ sub _truncate_headers { my $print_width = $col->{print_width}; next if length $col_name <= $print_width; $col->{name} = $self->truncate_value($col, $col_name, $print_width, $side); - MKDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, + PTDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, 'max width:', $print_width); } return; @@ -8585,7 +8585,7 @@ sub _truncate_line_values { my $print_width = $col->{print_width}; $val = $callback ? $callback->($col, $val, $print_width) : $self->truncate_value($col, $val, $print_width); - MKDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, + PTDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, '; max width:', $print_width); $vals->[$i] = $val; } @@ -8659,7 +8659,7 @@ package UpgradeReportFormatter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG}; +use constant PTDEBUG => $ENV{PTDEBUG}; Transformers->import(qw(make_checksum percentage_of shorten micro_t)); @@ -8849,7 +8849,7 @@ package CompareResults; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Time::HiRes qw(time); use Data::Dumper; @@ -8890,11 +8890,11 @@ sub before_execute { $tmp_tbl = $self->{Quoter}->quote($db, $tmp_tbl); eval { $sql = "DROP TABLE IF EXISTS $tmp_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); $sql = "SET storage_engine=MyISAM"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); }; die "Failed to drop temporary table $tmp_tbl: $EVAL_ERROR" @@ -8904,7 +8904,7 @@ sub before_execute { $event->{wrapped_query} = "CREATE TEMPORARY TABLE $tmp_tbl AS $event->{arg}"; - MKDEBUG && _d('Wrapped query:', $event->{wrapped_query}); + PTDEBUG && _d('Wrapped query:', $event->{wrapped_query}); } return $event; @@ -8920,7 +8920,7 @@ sub execute { my ( $start, $end, $query_time ); - MKDEBUG && _d('Executing query'); + PTDEBUG && _d('Executing query'); $event->{Query_time} = 0; if ( $self->{method} eq 'rows' ) { my $query = $event->{arg}; @@ -9051,30 +9051,30 @@ sub _checksum_results { my $tmp_tbl = $event->{tmp_tbl}; eval { $sql = "SELECT COUNT(*) FROM $tmp_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); ($n_rows) = @{ $dbh->selectcol_arrayref($sql) }; $sql = "CHECKSUM TABLE $tmp_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $tbl_checksum = $dbh->selectrow_arrayref($sql)->[1]; }; die "Failed to checksum table: $EVAL_ERROR" if $EVAL_ERROR; $sql = "DROP TABLE IF EXISTS $tmp_tbl"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; - MKDEBUG && $EVAL_ERROR && _d('Error:', $EVAL_ERROR); + PTDEBUG && $EVAL_ERROR && _d('Error:', $EVAL_ERROR); } else { - MKDEBUG && _d("Event doesn't have wrapped query or tmp tbl"); + PTDEBUG && _d("Event doesn't have wrapped query or tmp tbl"); } $event->{row_count} = $n_rows; $event->{checksum} = $tbl_checksum; - MKDEBUG && _d('row count:', $n_rows, 'checksum:', $tbl_checksum); + PTDEBUG && _d('row count:', $n_rows, 'checksum:', $tbl_checksum); return $event; } @@ -9099,7 +9099,7 @@ sub _compare_rows { my $dbh = $hosts->[0]->{dbh}; # doesn't matter which one if ( !$event0->{results_sth} ) { - MKDEBUG && _d("Event 0 doesn't have a results sth"); + PTDEBUG && _d("Event 0 doesn't have a results sth"); return ( different_row_counts => $different_row_counts, different_column_values => $different_column_values, @@ -9110,7 +9110,7 @@ sub _compare_rows { my $res_struct = MockSyncStream::get_result_set_struct($dbh, $event0->{results_sth}); - MKDEBUG && _d('Result set struct:', Dumper($res_struct)); + PTDEBUG && _d('Result set struct:', Dumper($res_struct)); my @event0_rows = @{ $event0->{results_sth}->fetchall_arrayref({}) }; $event0->{row_count} = scalar @event0_rows; @@ -9163,7 +9163,7 @@ sub _compare_rows { not_in_right => $not_in_right, ); - MKDEBUG && _d('Comparing result sets with MockSyncStream'); + PTDEBUG && _d('Comparing result sets with MockSyncStream'); $rd->compare_sets( left_sth => $left, right_sth => $right, @@ -9173,7 +9173,7 @@ sub _compare_rows { $event->{row_count} += $n_rows || 0; - MKDEBUG && _d('Left has', $event0->{row_count}, 'rows, right has', + PTDEBUG && _d('Left has', $event0->{row_count}, 'rows, right has', $event->{row_count}); $different_row_counts++ if $event0->{row_count} != $event->{row_count}; @@ -9189,15 +9189,15 @@ sub _compare_rows { next EVENT; } - MKDEBUG && _d('Result sets are different'); + PTDEBUG && _d('Result sets are different'); if ( !$left_outfile ) { - MKDEBUG && _d('Right has extra rows not in left'); + PTDEBUG && _d('Right has extra rows not in left'); (undef, $left_outfile) = $self->open_outfile(side => 'left'); } if ( !$right_outfile ) { - MKDEBUG && _d('Left has extra rows not in right'); + PTDEBUG && _d('Left has extra rows not in right'); (undef, $right_outfile) = $self->open_outfile(side => 'right'); } @@ -9258,7 +9258,7 @@ sub diff_rows { $right_dbh->do("LOAD DATA LOCAL INFILE '$right_outfile' " . "INTO TABLE $right_tbl"); - MKDEBUG && _d('Loaded', $left_outfile, 'into table', $left_tbl, 'and', + PTDEBUG && _d('Loaded', $left_outfile, 'into table', $left_tbl, 'and', $right_outfile, 'into table', $right_tbl); if ( $args{'add-indexes'} ) { @@ -9289,20 +9289,20 @@ sub diff_rows { my ( %args ) = @_; my ($lr, $rr) = @args{qw(lr rr)}; if ( $l_r[LEFT] && $l_r[RIGHT] ) { - MKDEBUG && _d('Saving different row'); + PTDEBUG && _d('Saving different row'); push @different_rows, $last_diff_col[$last_diff]; $n_diff++; } elsif ( $l_r[LEFT] ) { - MKDEBUG && _d('Saving not in right row'); + PTDEBUG && _d('Saving not in right row'); $n_diff++; } elsif ( $l_r[RIGHT] ) { - MKDEBUG && _d('Saving not in left row'); + PTDEBUG && _d('Saving not in left row'); $n_diff++; } else { - MKDEBUG && _d('No missing or different rows in queue'); + PTDEBUG && _d('No missing or different rows in queue'); } @l_r = (undef, undef); @last_diff_col = (); @@ -9328,9 +9328,9 @@ sub diff_rows { my $done = sub { my ( %args ) = @_; my ($left, $right) = @args{qw(left_sth right_sth)}; - MKDEBUG && _d('Found', $n_diff, 'of', $max_diff, 'max differences'); + PTDEBUG && _d('Found', $n_diff, 'of', $max_diff, 'max differences'); if ( $n_diff >= $max_diff ) { - MKDEBUG && _d('Done comparing rows, got --max-differences', $max_diff); + PTDEBUG && _d('Done comparing rows, got --max-differences', $max_diff); $left->finish(); $right->finish(); return 1; @@ -9345,7 +9345,7 @@ sub diff_rows { unless $tbl->{type_for}->{$col} =~ m/(?:float|double|decimal)/; my $l_rounded = sprintf "%.${n}f", $l; my $r_rounded = sprintf "%.${n}f", $r; - MKDEBUG && _d('Rounded', $l, 'to', $l_rounded, + PTDEBUG && _d('Rounded', $l, 'to', $l_rounded, 'and', $r, 'to', $r_rounded); return $l_rounded, $r_rounded; }; @@ -9416,7 +9416,7 @@ sub write_to_outfile { $outfile->write($fh, $remaining_rows); my $n_rows = 1 + @$remaining_rows; - MKDEBUG && _d('Wrote', $n_rows, 'rows'); + PTDEBUG && _d('Wrote', $n_rows, 'rows'); close $fh or warn "Cannot close $file: $OS_ERROR"; return $file, $n_rows; @@ -9426,7 +9426,7 @@ sub open_outfile { my ( $self, %args ) = @_; my $outfile = $self->{'base-dir'} . "/$args{side}-outfile.txt"; open my $fh, '>', $outfile or die "Cannot open $outfile: $OS_ERROR"; - MKDEBUG && _d('Opened outfile', $outfile); + PTDEBUG && _d('Opened outfile', $outfile); return $fh, $outfile; } @@ -9442,7 +9442,7 @@ sub make_table_ddl { } @{$struct->{cols}})) . ')'; $sql =~ s/,\)$/\n)/; - MKDEBUG && _d('Table ddl:', $sql); + PTDEBUG && _d('Table ddl:', $sql); return $sql; } @@ -9471,7 +9471,7 @@ sub add_indexes { ); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Error parsing', $db, '.', $tbl, ':', $EVAL_ERROR); + PTDEBUG && _d('Error parsing', $db, '.', $tbl, ':', $EVAL_ERROR); next; } push @keys, map { @@ -9481,23 +9481,23 @@ sub add_indexes { } grep { $_->{type} eq 'BTREE' } values %{$tbl_struct->{keys}}; } else { - MKDEBUG && _d('Cannot get indexes from', $db_tbl, 'because its ' + PTDEBUG && _d('Cannot get indexes from', $db_tbl, 'because its ' . 'database is unknown'); } } - MKDEBUG && _d('Source keys:', Dumper(\@keys)); + PTDEBUG && _d('Source keys:', Dumper(\@keys)); return unless @keys; for my $dst ( @$dsts ) { foreach my $key ( @keys ) { my $def = $key->[0]; my $sql = "ALTER TABLE $dst->{tbl} ADD $key->[0]"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dst->{dbh}->do($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); } else { } @@ -9659,14 +9659,14 @@ sub _use_db { my ( $self, $dbh, $new_db ) = @_; return unless $new_db; my $sql = 'SELECT DATABASE()'; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); my $curr = $dbh->selectrow_array($sql); if ( $curr && $new_db && $curr eq $new_db ) { - MKDEBUG && _d('Current and new DB are the same'); + PTDEBUG && _d('Current and new DB are the same'); return $curr; } $sql = "USE `$new_db`"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); $dbh->do($sql); return $curr; } @@ -9699,7 +9699,7 @@ package CompareQueryTimes; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; Transformers->import(qw(micro_t)); use POSIX qw(floor); @@ -9742,11 +9742,11 @@ sub execute { my ($event, $dbh) = @args{@required_args}; if ( exists $event->{Query_time} ) { - MKDEBUG && _d('Query already executed'); + PTDEBUG && _d('Query already executed'); return $event; } - MKDEBUG && _d('Executing query'); + PTDEBUG && _d('Executing query'); my $query = $event->{arg}; my ( $start, $end, $query_time ); @@ -9993,7 +9993,7 @@ package CompareWarnings; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; @@ -10027,7 +10027,7 @@ sub before_execute { if ( my $tbl = $self->{'clear-warnings-table'} ) { $sql = "SELECT * FROM $tbl LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; @@ -10042,15 +10042,15 @@ sub before_execute { TABLE: foreach my $tbl ( @tbls ) { $sql = "SELECT * FROM $tbl LIMIT 1"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { $dbh->do($sql); }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Failed to clear warnings'); + PTDEBUG && _d('Failed to clear warnings'); } else { - MKDEBUG && _d('Cleared warnings'); + PTDEBUG && _d('Cleared warnings'); $ok = 1; last TABLE; } @@ -10071,11 +10071,11 @@ sub execute { my ($event, $dbh) = @args{@required_args}; if ( exists $event->{Query_time} ) { - MKDEBUG && _d('Query already executed'); + PTDEBUG && _d('Query already executed'); return $event; } - MKDEBUG && _d('Executing query'); + PTDEBUG && _d('Executing query'); my $query = $event->{arg}; my ( $start, $end, $query_time ); @@ -10141,7 +10141,7 @@ sub compare { my $event = $events->[$i]; if ( ($event0->{warning_count} || 0) != ($event->{warning_count} || 0) ) { - MKDEBUG && _d('Warning counts differ:', + PTDEBUG && _d('Warning counts differ:', $event0->{warning_count}, $event->{warning_count}); $different_warning_counts++; $self->{diffs}->{warning_counts}->{$item}->{$sampleno} @@ -10157,7 +10157,7 @@ sub compare { foreach my $code ( keys %$w0 ) { if ( exists $w->{$code} ) { if ( $w->{$code}->{Level} ne $w0->{$code}->{Level} ) { - MKDEBUG && _d('Warning levels differ:', + PTDEBUG && _d('Warning levels differ:', $w0->{$code}->{Level}, $w->{$code}->{Level}); $different_warning_levels++; $self->{diffs}->{levels}->{$item}->{$sampleno} @@ -10168,7 +10168,7 @@ sub compare { delete $w->{$code}; } else { - MKDEBUG && _d('Warning gone:', $w0->{$code}->{Message}); + PTDEBUG && _d('Warning gone:', $w0->{$code}->{Message}); $different_warnings++; $self->{diffs}->{warnings}->{$item}->{$sampleno} = [ 0, $code, $w0->{$code}->{Message} ]; @@ -10177,7 +10177,7 @@ sub compare { } foreach my $code ( keys %$w ) { - MKDEBUG && _d('Warning new:', $w->{$code}->{Message}); + PTDEBUG && _d('Warning new:', $w->{$code}->{Message}); $different_warnings++; $self->{diffs}->{warnings}->{$item}->{$sampleno} = [ $i, $code, $w->{$code}->{Message} ]; @@ -10375,7 +10375,7 @@ package Retry; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -10396,35 +10396,35 @@ sub retry { my $tryno = 0; while ( ++$tryno <= $tries ) { - MKDEBUG && _d("Retry", $tryno, "of", $tries); + PTDEBUG && _d("Retry", $tryno, "of", $tries); my $result; eval { $result = $try->(tryno=>$tryno); }; if ( defined $result ) { - MKDEBUG && _d("Try code succeeded"); + PTDEBUG && _d("Try code succeeded"); if ( my $on_success = $args{on_success} ) { - MKDEBUG && _d("Calling on_success code"); + PTDEBUG && _d("Calling on_success code"); $on_success->(tryno=>$tryno, result=>$result); } return $result; } if ( $EVAL_ERROR ) { - MKDEBUG && _d("Try code died:", $EVAL_ERROR); + PTDEBUG && _d("Try code died:", $EVAL_ERROR); die $EVAL_ERROR unless $args{retry_on_die}; } if ( $tryno < $tries ) { - MKDEBUG && _d("Try code failed, calling wait code"); + PTDEBUG && _d("Try code failed, calling wait code"); $wait->(tryno=>$tryno); } } - MKDEBUG && _d("Try code did not succeed"); + PTDEBUG && _d("Try code did not succeed"); if ( my $on_failure = $args{on_failure} ) { - MKDEBUG && _d("Calling on_failure code"); + PTDEBUG && _d("Calling on_failure code"); $on_failure->(); } @@ -10466,7 +10466,7 @@ $Data::Dumper::Quotekeys = 0; Transformers->import(qw(make_checksum)); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use sigtrap 'handler', \&sig_int, 'normal-signals'; @@ -10502,7 +10502,7 @@ sub main { my $dsn_defaults = $dp->parse_options($o); while ( my $arg = shift @ARGV ) { if ( !-f $arg ) { - MKDEBUG && _d($arg, 'is a DSN'); + PTDEBUG && _d($arg, 'is a DSN'); my $dsn = $dp->parse( $arg, ($hosts->[-1] ? $hosts->[-1]->{dsn} : undef), @@ -10511,7 +10511,7 @@ sub main { push @$hosts, { dsn => $dsn, }; } else { - MKDEBUG && _d($arg, 'is a file'); + PTDEBUG && _d($arg, 'is a file'); push @files, $arg; } } @@ -10585,7 +10585,7 @@ sub main { my @compare_modules; if ( $compare->{results} ) { my $method = lc $o->get('compare-results-method'); - MKDEBUG && _d('Compare results method:', $method); + PTDEBUG && _d('Compare results method:', $method); my $plugins = []; if ( $method eq 'rows' ) { @@ -10661,7 +10661,7 @@ sub main { if ( my $query = $o->get('query') ) { push @callbacks, sub { my ( $event, %args ) = @_; - MKDEBUG && _d('callback: query:', $query); + PTDEBUG && _d('callback: query:', $query); $args{oktorun}->(0) if $args{oktorun}; return { cmd => 'Query', @@ -10680,15 +10680,15 @@ sub main { push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: check cmd and arg'); + PTDEBUG && _d('callback: check cmd and arg'); $stats->{events}++; if ( ($event->{cmd} || '') ne 'Query' ) { - MKDEBUG && _d('Skipping non-Query cmd'); + PTDEBUG && _d('Skipping non-Query cmd'); $stats->{not_query}++; return; } if ( !$event->{arg} ) { - MKDEBUG && _d('Skipping empty arg'); + PTDEBUG && _d('Skipping empty arg'); $stats->{empty_query}++; return; } @@ -10699,7 +10699,7 @@ sub main { if ( $o->get('filter') ) { my $filter = $o->get('filter'); if ( -f $filter && -r $filter ) { - MKDEBUG && _d('Reading file', $filter, 'for --filter code'); + PTDEBUG && _d('Reading file', $filter, 'for --filter code'); open my $fh, "<", $filter or die "Cannot open $filter: $OS_ERROR"; $filter = do { local $/ = undef; <$fh> }; close $fh; @@ -10707,8 +10707,8 @@ sub main { else { $filter = "( $filter )"; # issue 565 } - my $code = "sub { MKDEBUG && _d('callback: filter'); my(\$event) = shift; $filter && return \$event; };"; - MKDEBUG && _d('--filter code:', $code); + my $code = "sub { PTDEBUG && _d('callback: filter'); my(\$event) = shift; $filter && return \$event; };"; + PTDEBUG && _d('--filter code:', $code); my $sub = eval $code or die "Error compiling --filter code: $code\n$EVAL_ERROR"; push @callbacks, $sub; @@ -10717,7 +10717,7 @@ sub main { if ( $o->get('convert-to-select') ) { push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: convert to select'); + PTDEBUG && _d('callback: convert to select'); return $event if $event->{arg} =~ m/(?:^SELECT|(?:\*\/\s*SELECT))/i; my $new_arg = $qr->convert_to_select($event->{arg}); if ( $new_arg =~ m/^SELECT/i ) { @@ -10726,7 +10726,7 @@ sub main { $event->{arg} = $new_arg; return $event; } - MKDEBUG && _d('Convert to SELECT failed:', $event->{arg}); + PTDEBUG && _d('Convert to SELECT failed:', $event->{arg}); $stats->{convert_to_select_failed}++; return; }; @@ -10734,9 +10734,9 @@ sub main { else { push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: filter non-select'); + PTDEBUG && _d('callback: filter non-select'); if ( $event->{arg} !~ m/(?:^SELECT|(?:\*\/\s*SELECT))/i ) { - MKDEBUG && _d('Skipping non-SELECT query'); + PTDEBUG && _d('Skipping non-SELECT query'); $stats->{not_select}++; return; } @@ -10748,7 +10748,7 @@ sub main { my %allowed_attribs = qw(arg 1 db 1 sampleno 1 pos_in_log 1 original_arg 1); push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: remove not-allowed attributes'); + PTDEBUG && _d('callback: remove not-allowed attributes'); # Events will have a lot of attribs from the log that we want # to remove because 1) we don't need them and 2) we want to avoid # attrib conflicts (e.g. there's probably a Query_time from the @@ -10759,7 +10759,7 @@ sub main { push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: fingerprint'); + PTDEBUG && _d('callback: fingerprint'); $event->{fingerprint} = $qr->fingerprint($event->{arg}); return $event; }; @@ -10768,9 +10768,9 @@ sub main { my %samplenos; push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: sampleno'); + PTDEBUG && _d('callback: sampleno'); $event->{sampleno} = ++$samplenos{$event->{$groupby}}; - MKDEBUG && _d('Event sampleno', $event->{sampleno}); + PTDEBUG && _d('Event sampleno', $event->{sampleno}); return $event; }; @@ -10778,16 +10778,16 @@ sub main { # don't use db-qualified tables. push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: current db'); + PTDEBUG && _d('callback: current db'); my $db = $event->{db} || $event->{Schema} || $hosts->[0]->{dsn}->{D}; if ( $db && (!$current_db || $db ne $current_db) ) { my $sql = "USE `$db`"; - MKDEBUG && _d($sql); + PTDEBUG && _d($sql); eval { map { $_->{dbh}->do($sql); } @$hosts; }; if ( $EVAL_ERROR ) { - MKDEBUG && _d('Error:', $EVAL_ERROR); + PTDEBUG && _d('Error:', $EVAL_ERROR); $EVAL_ERROR =~ m/Unknown database/ ? $stats->{unknown_database}++ : $stats->{use_database_error}++; return; @@ -10817,7 +10817,7 @@ sub main { # ######################################################################## push @callbacks, sub { my ( $event ) = @_; - MKDEBUG && _d('callback: execute event on hosts'); + PTDEBUG && _d('callback: execute event on hosts'); my @host_events; HOST: @@ -10833,12 +10833,12 @@ sub main { foreach my $c ( @compare_modules ) { my $module = ref $c; if ( $bad_module{$module} ) { - MKDEBUG && _d('Skipping bad module', $module, $action, + PTDEBUG && _d('Skipping bad module', $module, $action, 'on', $host_name); $stats->{"${module}_${action}_skipped"}++; next MODULE; } - MKDEBUG && _d('Doing', $module, $action, 'on', $host_name); + PTDEBUG && _d('Doing', $module, $action, 'on', $host_name); eval { $host_event = $c->$action( event => $host_event, @@ -10850,7 +10850,7 @@ sub main { }; if ( $EVAL_ERROR ) { chomp $EVAL_ERROR; - MKDEBUG && _d('Error:', $EVAL_ERROR); + PTDEBUG && _d('Error:', $EVAL_ERROR); $errors->{$event->{fingerprint}}->{$event->{sampleno} || 0} = [$host->{name}, $EVAL_ERROR]; $samples{$event->{fingerprint}}->{$event->{sampleno} || 0} @@ -10873,7 +10873,7 @@ sub main { # Compare host events for differences, then aggregate those differences. my $n_diffs = 0; foreach my $c ( @compare_modules ) { - MKDEBUG && _d('Doing', ref $c, 'compare'); + PTDEBUG && _d('Doing', ref $c, 'compare'); my %diffs = $c->compare( events => \@host_events, hosts => $hosts, @@ -10916,7 +10916,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -10948,13 +10948,13 @@ sub main { if ( !$fh ) { my $file = shift @files; if ( !$file ) { - MKDEBUG && _d('No more files to parse'); + PTDEBUG && _d('No more files to parse'); last EVENT; } if ( $file eq '-' ) { $fh = *STDIN; - MKDEBUG && _d('Reading STDIN'); + PTDEBUG && _d('Reading STDIN'); } else { if ( !open $fh, "<", $file ) { @@ -10962,7 +10962,7 @@ sub main { warn "Cannot open $file: $OS_ERROR\n"; next EVENT; } - MKDEBUG && _d('Reading', $file); + PTDEBUG && _d('Reading', $file); } } @@ -10992,7 +10992,7 @@ sub main { last EVENT unless $o->get('continue-on-error'); } if ( !$more_events ) { - MKDEBUG && _d('No more events'); + PTDEBUG && _d('No more events'); close $fh if $fh; $fh = undef; last EVENT; diff --git a/bin/pt-variable-advisor b/bin/pt-variable-advisor index d294fc8c..a8c1c4fa 100755 --- a/bin/pt-variable-advisor +++ b/bin/pt-variable-advisor @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # OptionParser package @@ -22,7 +22,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -106,7 +106,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -150,7 +150,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -187,7 +187,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -196,7 +196,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -215,7 +215,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -223,7 +223,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -261,7 +261,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -274,7 +274,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -300,14 +300,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -316,13 +316,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -330,17 +330,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -354,7 +354,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -364,7 +364,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -378,7 +378,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -401,7 +401,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -430,7 +430,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -461,7 +461,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -528,7 +528,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -577,7 +577,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -601,12 +601,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -615,23 +615,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -640,7 +640,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -650,7 +650,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -724,11 +724,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -943,7 +943,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -953,7 +953,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -977,7 +977,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -990,7 +990,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1017,7 +1017,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1047,7 +1047,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1070,7 +1070,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1088,7 +1088,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1097,10 +1097,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1112,23 +1112,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1159,7 +1159,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1209,7 +1209,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1254,7 +1254,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1264,21 +1264,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1290,15 +1290,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1316,7 +1316,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -1342,7 +1342,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -1403,7 +1403,7 @@ package VersionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class ) = @_; @@ -1413,7 +1413,7 @@ sub new { sub parse { my ( $self, $str ) = @_; my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); - MKDEBUG && _d($str, 'parses to', $result); + PTDEBUG && _d($str, 'parses to', $result); return $result; } @@ -1424,7 +1424,7 @@ sub version_ge { $dbh->selectrow_array('SELECT VERSION()')); } my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; - MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); + PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); return $result; } @@ -1442,7 +1442,7 @@ sub innodb_version { } @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; if ( $innodb ) { - MKDEBUG && _d("InnoDB support:", $innodb->{support}); + PTDEBUG && _d("InnoDB support:", $innodb->{support}); if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { my $vars = $dbh->selectrow_hashref( "SHOW VARIABLES LIKE 'innodb_version'"); @@ -1454,7 +1454,7 @@ sub innodb_version { } } - MKDEBUG && _d("InnoDB version:", $innodb_version); + PTDEBUG && _d("InnoDB version:", $innodb_version); return $innodb_version; } @@ -1486,7 +1486,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -1504,17 +1504,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -1556,19 +1556,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -1586,7 +1586,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -1606,7 +1606,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -1619,7 +1619,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -1628,10 +1628,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -1672,7 +1672,7 @@ package PodParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my %parse_items_from = ( 'OPTIONS' => 1, @@ -1717,7 +1717,7 @@ sub get_magic { sub parse_from_file { my ( $self, $file ) = @_; return unless $file; - MKDEBUG && _d('Parsing POD in', $file); + PTDEBUG && _d('Parsing POD in', $file); open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs my $para; @@ -1729,7 +1729,7 @@ sub parse_from_file { if ( $para =~ m/^=(head|item|over|back)/ ) { my ($cmd, $name) = $para =~ m/^=(\w+)(?:\s+(.+))?/; $name ||= ''; - MKDEBUG && _d('cmd:', $cmd, 'name:', $name); + PTDEBUG && _d('cmd:', $cmd, 'name:', $name); $self->command($cmd, $name); } elsif ( $parse_items_from{$self->{current_section}} ) { @@ -1746,12 +1746,12 @@ sub command { $name =~ s/\s+\Z//m; # Remove \n and blank line after name. if ( $cmd eq 'head1' ) { - MKDEBUG && _d('In section', $name); + PTDEBUG && _d('In section', $name); $self->{current_section} = $name; } elsif ( $cmd eq 'over' ) { if ( $parse_items_from{$name} ) { - MKDEBUG && _d('Start items in', $self->{current_section}); + PTDEBUG && _d('Start items in', $self->{current_section}); $self->{items}->{$self->{current_section}} = {}; } } @@ -1759,7 +1759,7 @@ sub command { my $pat = $item_pattern_for{ $self->{current_section} }; my ($item) = $name =~ m/$pat/; if ( $item ) { - MKDEBUG && _d($self->{current_section}, 'item:', $item); + PTDEBUG && _d($self->{current_section}, 'item:', $item); $self->{items}->{ $self->{current_section} }->{$item} = { desc => '', # every item should have a desc }; @@ -1771,7 +1771,7 @@ sub command { } elsif ( $cmd eq 'back' ) { if ( $parse_items_from{$self->{current_section}} ) { - MKDEBUG && _d('End items in', $self->{current_section}); + PTDEBUG && _d('End items in', $self->{current_section}); } } else { @@ -1792,7 +1792,7 @@ sub textblock { $para =~ s/\s+\Z//; if ( $para =~ m/^[a-z]\w+[:;] / ) { - MKDEBUG && _d('Item attributes:', $para); + PTDEBUG && _d('Item attributes:', $para); map { my ($attrib, $val) = split(/: /, $_); $item->{$attrib} = defined $val ? $val : 1; @@ -1806,26 +1806,26 @@ sub textblock { if ( $indent ) { $para =~ s/^\s{$indent}//mg; $para =~ s/\s+$//; - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); $self->{magic}->{$self->{current_section}}->{$self->{magic_ident}} = $para; } else { - MKDEBUG && _d("MAGIC", $self->{magic_ident}, + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para is not indented; treating as normal para"); } $self->{magic_ident} = ''; # must unset this! } - MKDEBUG && _d('Item desc:', substr($para, 0, 40), + PTDEBUG && _d('Item desc:', substr($para, 0, 40), length($para) > 40 ? '...' : ''); $para =~ s/\n+/ /g; $item->{desc} .= $para; if ( $para =~ m/MAGIC_(\w+)/ ) { $self->{magic_ident} = $1; # XXX - MKDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); + PTDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); } } @@ -1865,7 +1865,7 @@ package TextResultSetParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -1918,19 +1918,19 @@ sub parse { my $result_set; if ( $text =~ m/^\+---/m ) { # standard "tabular" output - MKDEBUG && _d('Result set text is standard tabular'); + PTDEBUG && _d('Result set text is standard tabular'); my $line_pattern = qr/^(\| .*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tabular); } elsif ( $text =~ m/^\w+\t\w+/m ) { # tab-separated - MKDEBUG && _d('Result set text is tab-separated'); + PTDEBUG && _d('Result set text is tab-separated'); my $line_pattern = qr/^(.*?\t.*)[\r\n]+/m; $result_set = $self->parse_horizontal_row($text, $line_pattern, \&_parse_tab_sep); } elsif ( $text =~ m/\*\*\* \d+\. row/ ) { # "vertical" output - MKDEBUG && _d('Result set text is vertical (\G)'); + PTDEBUG && _d('Result set text is vertical (\G)'); foreach my $row ( split_vertical_rows($text) ) { push @$result_set, $self->parse_vertical_row($row); } @@ -2009,7 +2009,7 @@ package Advisor; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2030,7 +2030,7 @@ sub new { sub load_rules { my ( $self, $advisor ) = @_; return unless $advisor; - MKDEBUG && _d('Loading rules from', ref $advisor); + PTDEBUG && _d('Loading rules from', ref $advisor); my $i = scalar @{$self->{rules}}; @@ -2038,7 +2038,7 @@ sub load_rules { foreach my $rule ( $advisor->get_rules() ) { my $id = $rule->{id}; if ( $self->{ignore_rules}->{"$id"} ) { - MKDEBUG && _d("Ignoring rule", $id); + PTDEBUG && _d("Ignoring rule", $id); next RULE; } die "Rule $id already exists and cannot be redefined" @@ -2053,7 +2053,7 @@ sub load_rules { sub load_rule_info { my ( $self, $advisor ) = @_; return unless $advisor; - MKDEBUG && _d('Loading rule info from', ref $advisor); + PTDEBUG && _d('Loading rule info from', ref $advisor); my $rules = $self->{rules}; foreach my $rule ( @$rules ) { my $id = $rule->{id}; @@ -2081,14 +2081,14 @@ sub run_rules { my $match = $rule->{code}->(%args); if ( $match_type eq 'pos' ) { if ( defined $match ) { - MKDEBUG && _d('Matches rule', $rule->{id}, 'near pos', $match); + PTDEBUG && _d('Matches rule', $rule->{id}, 'near pos', $match); push @matched_rules, $rule->{id}; push @matched_pos, $match; } } elsif ( $match_type eq 'bool' ) { if ( $match ) { - MKDEBUG && _d("Matches rule", $rule->{id}); + PTDEBUG && _d("Matches rule", $rule->{id}); push @matched_rules, $rule->{id}; } } @@ -2135,7 +2135,7 @@ package AdvisorRules; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; @@ -2223,13 +2223,13 @@ use base 'AdvisorRules'; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub new { my ( $class, %args ) = @_; my $self = $class->SUPER::new(%args); @{$self->{rules}} = $self->get_rules(); - MKDEBUG && _d(scalar @{$self->{rules}}, "rules"); + PTDEBUG && _d(scalar @{$self->{rules}}, "rules"); return $self; } @@ -2823,7 +2823,7 @@ package pt_variable_advisor; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub main { @ARGV = @_; # set global ARGV for this package @@ -2905,7 +2905,7 @@ sub main { $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), {AutoCommit => 1}); $dbh->{FetchHashKeyName} = 'NAME_lc'; - MKDEBUG && _d('Connected dbh', $dbh); + PTDEBUG && _d('Connected dbh', $dbh); } # ######################################################################## @@ -2915,7 +2915,7 @@ sub main { if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); $daemon->daemonize(); - MKDEBUG && _d('I am a daemon now'); + PTDEBUG && _d('I am a daemon now'); } elsif ( $o->get('pid') ) { # We're not daemoninzing, it just handles PID stuff. @@ -2934,7 +2934,7 @@ sub main { my $mysql_version = $vp->parse($vars->{version}); my $innodb_version = $vp->innodb_version($dbh); - MKDEBUG && _d("MySQL version", $mysql_version, + PTDEBUG && _d("MySQL version", $mysql_version, "InnoDB version", $innodb_version); # ######################################################################### @@ -2987,16 +2987,16 @@ sub get_variables { if ( ($source || '') =~ m/^mysql$/i ) { my $dbh = $args{dbh}; die "I need a dbh argument" unless $dbh; - MKDEBUG && _d("Getting variables from dbh", $dbh); + PTDEBUG && _d("Getting variables from dbh", $dbh); my $sql = "SHOW /*40003 GLOBAL*/ VARIABLES"; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); map { $vars->{$_->{variable_name}} = $_->{value}; } @{ $dbh->selectall_arrayref($sql, {Slice=>{}}) }; } else { my $trp = $args{TextResultSetParser}; die "I need a TextResultSetParser arg" unless $trp; - MKDEBUG && _d("Getting variables from", $source); + PTDEBUG && _d("Getting variables from", $source); open my $fh, "<", $source or die "Cannot open $source: $OS_ERROR"; my $contents = do { local $/ = undef; <$fh> }; close $fh; diff --git a/bin/pt-visual-explain b/bin/pt-visual-explain index 6c985f71..e56c9c12 100755 --- a/bin/pt-visual-explain +++ b/bin/pt-visual-explain @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; # ########################################################################### # Converts text (e.g. saved output) to a "recordset" -- an array of hashrefs @@ -694,7 +694,7 @@ package OptionParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use List::Util qw(max); use Getopt::Long; @@ -778,7 +778,7 @@ sub get_specs { my $contents = do { local $/ = undef; <$fh> }; close $fh; if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - MKDEBUG && _d('Parsing DSN OPTIONS'); + PTDEBUG && _d('Parsing DSN OPTIONS'); my $dsn_attribs = { dsn => 1, copy => 1, @@ -822,7 +822,7 @@ sub get_specs { if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { $self->{version} = $1; - MKDEBUG && _d($self->{version}); + PTDEBUG && _d($self->{version}); } return; @@ -859,7 +859,7 @@ sub _pod_to_specs { chomp $para; $para =~ s/\s+/ /g; $para =~ s/$POD_link_re/$1/go; - MKDEBUG && _d('Option rule:', $para); + PTDEBUG && _d('Option rule:', $para); push @rules, $para; } @@ -868,7 +868,7 @@ sub _pod_to_specs { do { if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { chomp $para; - MKDEBUG && _d($para); + PTDEBUG && _d($para); my %attribs; $para = <$fh>; # read next paragraph, possibly attributes @@ -887,7 +887,7 @@ sub _pod_to_specs { $para = <$fh>; # read next paragraph, probably short help desc } else { - MKDEBUG && _d('Option has no attributes'); + PTDEBUG && _d('Option has no attributes'); } $para =~ s/\s+\Z//g; @@ -895,7 +895,7 @@ sub _pod_to_specs { $para =~ s/$POD_link_re/$1/go; $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - MKDEBUG && _d('Short help:', $para); + PTDEBUG && _d('Short help:', $para); die "No description after option spec $option" if $para =~ m/^=item/; @@ -933,7 +933,7 @@ sub _parse_specs { foreach my $opt ( @specs ) { if ( ref $opt ) { # It's an option spec, not a rule. - MKDEBUG && _d('Parsing opt spec:', + PTDEBUG && _d('Parsing opt spec:', map { ($_, '=>', $opt->{$_}) } keys %$opt); my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; @@ -946,7 +946,7 @@ sub _parse_specs { $self->{opts}->{$long} = $opt; if ( length $long == 1 ) { - MKDEBUG && _d('Long opt', $long, 'looks like short opt'); + PTDEBUG && _d('Long opt', $long, 'looks like short opt'); $self->{short_opts}->{$long} = $long; } @@ -972,14 +972,14 @@ sub _parse_specs { my ( $type ) = $opt->{spec} =~ m/=(.)/; $opt->{type} = $type; - MKDEBUG && _d($long, 'type:', $type); + PTDEBUG && _d($long, 'type:', $type); $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { $self->{defaults}->{$long} = defined $def ? $def : 1; - MKDEBUG && _d($long, 'default:', $def); + PTDEBUG && _d($long, 'default:', $def); } if ( $long eq 'config' ) { @@ -988,13 +988,13 @@ sub _parse_specs { if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { $disables{$long} = $dis; - MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis); + PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); } $self->{opts}->{$long} = $opt; } else { # It's an option rule, not a spec. - MKDEBUG && _d('Parsing rule:', $opt); + PTDEBUG && _d('Parsing rule:', $opt); push @{$self->{rules}}, $opt; my @participants = $self->_get_participants($opt); my $rule_ok = 0; @@ -1002,17 +1002,17 @@ sub _parse_specs { if ( $opt =~ m/mutually exclusive|one and only one/ ) { $rule_ok = 1; push @{$self->{mutex}}, \@participants; - MKDEBUG && _d(@participants, 'are mutually exclusive'); + PTDEBUG && _d(@participants, 'are mutually exclusive'); } if ( $opt =~ m/at least one|one and only one/ ) { $rule_ok = 1; push @{$self->{atleast1}}, \@participants; - MKDEBUG && _d(@participants, 'require at least one'); + PTDEBUG && _d(@participants, 'require at least one'); } if ( $opt =~ m/default to/ ) { $rule_ok = 1; $self->{defaults_to}->{$participants[0]} = $participants[1]; - MKDEBUG && _d($participants[0], 'defaults to', $participants[1]); + PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); } if ( $opt =~ m/restricted to option groups/ ) { $rule_ok = 1; @@ -1026,7 +1026,7 @@ sub _parse_specs { if( $opt =~ m/accepts additional command-line arguments/ ) { $rule_ok = 1; $self->{strict} = 0; - MKDEBUG && _d("Strict mode disabled by rule"); + PTDEBUG && _d("Strict mode disabled by rule"); } die "Unrecognized option rule: $opt" unless $rule_ok; @@ -1036,7 +1036,7 @@ sub _parse_specs { foreach my $long ( keys %disables ) { my @participants = $self->_get_participants($disables{$long}); $self->{disables}->{$long} = \@participants; - MKDEBUG && _d('Option', $long, 'disables', @participants); + PTDEBUG && _d('Option', $long, 'disables', @participants); } return; @@ -1050,7 +1050,7 @@ sub _get_participants { unless exists $self->{opts}->{$long}; push @participants, $long; } - MKDEBUG && _d('Participants for', $str, ':', @participants); + PTDEBUG && _d('Participants for', $str, ':', @participants); return @participants; } @@ -1073,7 +1073,7 @@ sub set_defaults { die "Cannot set default for nonexistent option $long" unless exists $self->{opts}->{$long}; $self->{defaults}->{$long} = $defaults{$long}; - MKDEBUG && _d('Default val for', $long, ':', $defaults{$long}); + PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); } return; } @@ -1102,7 +1102,7 @@ sub _set_option { $opt->{value} = $val; } $opt->{got} = 1; - MKDEBUG && _d('Got option', $long, '=', $val); + PTDEBUG && _d('Got option', $long, '=', $val); } sub get_opts { @@ -1133,7 +1133,7 @@ sub get_opts { if ( $self->got('config') ) { die $EVAL_ERROR; } - elsif ( MKDEBUG ) { + elsif ( PTDEBUG ) { _d($EVAL_ERROR); } } @@ -1200,7 +1200,7 @@ sub _check_opts { if ( exists $self->{disables}->{$long} ) { my @disable_opts = @{$self->{disables}->{$long}}; map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - MKDEBUG && _d('Unset options', @disable_opts, + PTDEBUG && _d('Unset options', @disable_opts, 'because', $long,'disables them'); } @@ -1249,7 +1249,7 @@ sub _check_opts { delete $long[$i]; } else { - MKDEBUG && _d('Temporarily failed to parse', $long); + PTDEBUG && _d('Temporarily failed to parse', $long); } } @@ -1273,12 +1273,12 @@ sub _validate_type { my $val = $opt->{value}; if ( $val && $opt->{type} eq 'm' ) { # type time - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; if ( !$suffix ) { my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; $suffix = $s || 's'; - MKDEBUG && _d('No suffix given; using', $suffix, 'for', + PTDEBUG && _d('No suffix given; using', $suffix, 'for', $opt->{long}, '(value:', $val, ')'); } if ( $suffix =~ m/[smhd]/ ) { @@ -1287,23 +1287,23 @@ sub _validate_type { : $suffix eq 'h' ? $num * 3600 # Hours : $num * 86400; # Days $opt->{value} = ($prefix || '') . $val; - MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val); + PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); } else { $self->save_error("Invalid time suffix for --$opt->{long}"); } } elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); my $prev = {}; my $from_key = $self->{defaults_to}->{ $opt->{long} }; if ( $from_key ) { - MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); + PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); if ( $self->{opts}->{$from_key}->{parsed} ) { $prev = $self->{opts}->{$from_key}->{value}; } else { - MKDEBUG && _d('Cannot parse', $opt->{long}, 'until', + PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', $from_key, 'parsed'); return; } @@ -1312,7 +1312,7 @@ sub _validate_type { $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); } elsif ( $val && $opt->{type} eq 'z' ) { # type size - MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); + PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); $self->_parse_size($opt, $val); } elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { @@ -1322,7 +1322,7 @@ sub _validate_type { $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); } @@ -1396,11 +1396,11 @@ sub usage_or_errors { $file ||= $self->{file} || __FILE__; if ( !$self->{description} || !$self->{usage} ) { - MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); + PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); my %synop = $self->_parse_synopsis($file); $self->{description} ||= $synop{description}; $self->{usage} ||= $synop{usage}; - MKDEBUG && _d("Description:", $self->{description}, + PTDEBUG && _d("Description:", $self->{description}, "\nUsage:", $self->{usage}); } @@ -1615,7 +1615,7 @@ sub _parse_size { my ( $self, $opt, $val ) = @_; if ( lc($val || '') eq 'null' ) { - MKDEBUG && _d('NULL size for', $opt->{long}); + PTDEBUG && _d('NULL size for', $opt->{long}); $opt->{value} = 'null'; return; } @@ -1625,7 +1625,7 @@ sub _parse_size { if ( defined $num ) { if ( $factor ) { $num *= $factor_for{$factor}; - MKDEBUG && _d('Setting option', $opt->{y}, + PTDEBUG && _d('Setting option', $opt->{y}, 'to num', $num, '* factor', $factor); } $opt->{value} = ($pre || '') . $num; @@ -1649,7 +1649,7 @@ sub _parse_attribs { sub _parse_synopsis { my ( $self, $file ) = @_; $file ||= $self->{file} || __FILE__; - MKDEBUG && _d("Parsing SYNOPSIS in", $file); + PTDEBUG && _d("Parsing SYNOPSIS in", $file); local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; @@ -1662,7 +1662,7 @@ sub _parse_synopsis { push @synop, $para; } close $fh; - MKDEBUG && _d("Raw SYNOPSIS text:", @synop); + PTDEBUG && _d("Raw SYNOPSIS text:", @synop); my ($usage, $desc) = @synop; die "The SYNOPSIS section in $file is not formatted properly" unless $usage && $desc; @@ -1689,7 +1689,7 @@ sub _d { print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } -if ( MKDEBUG ) { +if ( PTDEBUG ) { print '# ', $^X, ' ', $], "\n"; if ( my $uname = `uname -a` ) { $uname =~ s/\s+/ /g; @@ -1719,7 +1719,7 @@ package DSNParser; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 0; @@ -1742,7 +1742,7 @@ sub new { if ( !$opt->{key} || !$opt->{desc} ) { die "Invalid DSN option: ", Dumper($opt); } - MKDEBUG && _d('DSN option:', + PTDEBUG && _d('DSN option:', join(', ', map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } keys %$opt @@ -1760,7 +1760,7 @@ sub new { sub prop { my ( $self, $prop, $value ) = @_; if ( @_ > 2 ) { - MKDEBUG && _d('Setting', $prop, 'property'); + PTDEBUG && _d('Setting', $prop, 'property'); $self->{$prop} = $value; } return $self->{$prop}; @@ -1769,10 +1769,10 @@ sub prop { sub parse { my ( $self, $dsn, $prev, $defaults ) = @_; if ( !$dsn ) { - MKDEBUG && _d('No DSN to parse'); + PTDEBUG && _d('No DSN to parse'); return; } - MKDEBUG && _d('Parsing', $dsn); + PTDEBUG && _d('Parsing', $dsn); $prev ||= {}; $defaults ||= {}; my %given_props; @@ -1784,23 +1784,23 @@ sub parse { $given_props{$prop_key} = $prop_val; } else { - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); + PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); $given_props{h} = $dsn_part; } } foreach my $key ( keys %$opts ) { - MKDEBUG && _d('Finding value for', $key); + PTDEBUG && _d('Finding value for', $key); $final_props{$key} = $given_props{$key}; if ( !defined $final_props{$key} && defined $prev->{$key} && $opts->{$key}->{copy} ) { $final_props{$key} = $prev->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); + PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); } if ( !defined $final_props{$key} ) { $final_props{$key} = $defaults->{$key}; - MKDEBUG && _d('Copying value for', $key, 'from defaults'); + PTDEBUG && _d('Copying value for', $key, 'from defaults'); } } @@ -1831,7 +1831,7 @@ sub parse_options { grep { $o->has($_) && $o->get($_) } keys %{$self->{opts}} ); - MKDEBUG && _d('DSN string made from options:', $dsn_string); + PTDEBUG && _d('DSN string made from options:', $dsn_string); return $self->parse($dsn_string); } @@ -1881,7 +1881,7 @@ sub get_cxn_params { qw(F h P S A)) . ';mysql_read_default_group=client'; } - MKDEBUG && _d($dsn); + PTDEBUG && _d($dsn); return ($dsn, $info->{u}, $info->{p}); } @@ -1926,7 +1926,7 @@ sub get_dbh { my $dbh; my $tries = 2; while ( !$dbh && $tries-- ) { - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, + PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); eval { @@ -1936,21 +1936,21 @@ sub get_dbh { my $sql; $sql = 'SELECT @@SQL_MODE'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); my ($sql_mode) = $dbh->selectrow_array($sql); $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' . ($sql_mode ? ",$sql_mode" : '') . '\'*/'; - MKDEBUG && _d($dbh, $sql); + PTDEBUG && _d($dbh, $sql); $dbh->do($sql); if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { $sql = "/*!40101 SET NAMES $charset*/"; - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); - MKDEBUG && _d('Enabling charset for STDOUT'); + PTDEBUG && _d('Enabling charset for STDOUT'); if ( $charset eq 'utf8' ) { binmode(STDOUT, ':utf8') or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; @@ -1962,15 +1962,15 @@ sub get_dbh { if ( $self->prop('set-vars') ) { $sql = "SET " . $self->prop('set-vars'); - MKDEBUG && _d($dbh, ':', $sql); + PTDEBUG && _d($dbh, ':', $sql); $dbh->do($sql); } } }; if ( !$dbh && $EVAL_ERROR ) { - MKDEBUG && _d($EVAL_ERROR); + PTDEBUG && _d($EVAL_ERROR); if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { - MKDEBUG && _d('Going to try again without utf8 support'); + PTDEBUG && _d('Going to try again without utf8 support'); delete $defaults->{mysql_enable_utf8}; } elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { @@ -1988,7 +1988,7 @@ sub get_dbh { } } - MKDEBUG && _d('DBH info: ', + PTDEBUG && _d('DBH info: ', $dbh, Dumper($dbh->selectrow_hashref( 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), @@ -2014,7 +2014,7 @@ sub get_hostname { sub disconnect { my ( $self, $dbh ) = @_; - MKDEBUG && $self->print_active_handles($dbh); + PTDEBUG && $self->print_active_handles($dbh); $dbh->disconnect; } @@ -2075,7 +2075,7 @@ package Daemon; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use POSIX qw(setsid); @@ -2093,17 +2093,17 @@ sub new { check_PID_file(undef, $self->{PID_file}); - MKDEBUG && _d('Daemonized child will log to', $self->{log_file}); + PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); return bless $self, $class; } sub daemonize { my ( $self ) = @_; - MKDEBUG && _d('About to fork and daemonize'); + PTDEBUG && _d('About to fork and daemonize'); defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; if ( $pid ) { - MKDEBUG && _d('I am the parent and now I die'); + PTDEBUG && _d('I am the parent and now I die'); exit; } @@ -2145,19 +2145,19 @@ sub daemonize { } } - MKDEBUG && _d('I am the child and now I live daemonized'); + PTDEBUG && _d('I am the child and now I live daemonized'); return; } sub check_PID_file { my ( $self, $file ) = @_; my $PID_file = $self ? $self->{PID_file} : $file; - MKDEBUG && _d('Checking PID file', $PID_file); + PTDEBUG && _d('Checking PID file', $PID_file); if ( $PID_file && -f $PID_file ) { my $pid; eval { chomp($pid = `cat $PID_file`); }; die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR; - MKDEBUG && _d('PID file exists; it contains PID', $pid); + PTDEBUG && _d('PID file exists; it contains PID', $pid); if ( $pid ) { my $pid_is_alive = kill 0, $pid; if ( $pid_is_alive ) { @@ -2175,7 +2175,7 @@ sub check_PID_file { } } else { - MKDEBUG && _d('No PID file'); + PTDEBUG && _d('No PID file'); } return; } @@ -2195,7 +2195,7 @@ sub _make_PID_file { my $PID_file = $self->{PID_file}; if ( !$PID_file ) { - MKDEBUG && _d('No PID file to create'); + PTDEBUG && _d('No PID file to create'); return; } @@ -2208,7 +2208,7 @@ sub _make_PID_file { close $PID_FH or die "Cannot close PID file $PID_file: $OS_ERROR"; - MKDEBUG && _d('Created PID file:', $self->{PID_file}); + PTDEBUG && _d('Created PID file:', $self->{PID_file}); return; } @@ -2217,10 +2217,10 @@ sub _remove_PID_file { if ( $self->{PID_file} && -f $self->{PID_file} ) { unlink $self->{PID_file} or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - MKDEBUG && _d('Removed PID file'); + PTDEBUG && _d('Removed PID file'); } else { - MKDEBUG && _d('No PID to remove'); + PTDEBUG && _d('No PID to remove'); } return; } @@ -2263,7 +2263,7 @@ use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Quotekeys = 0; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; sub main { @ARGV = @_; # set global ARGV for this package diff --git a/docs/release_notes.rst b/docs/release_notes.rst index 7b54a555..5beed767 100644 --- a/docs/release_notes.rst +++ b/docs/release_notes.rst @@ -1,34 +1,6 @@ Release Notes ************* -v1.0.2 released 2011-12-22 -========================== - -Percona Toolkit 1.0.2 has been released. Ten little bugs and typos were -fixed in this release. The debug switch MKDEBUG was changed to PTDEBUG. -Otherwise, no features were added, removed, or changed. If you are using -Percona Toolkit 1.0.1, it is safe and beneficial to upgrade to 1.0.2. -Thank you to all those who submitted bug reports. - -Download the latest release of Percona Toolkit from -http://www.percona.com/software/percona-toolkit/ -or the Percona Software Repositories -(http://www.percona.com/docs/wiki/repositories:start). - -Changelog ---------- - -* Fixed bug 856065: pt-trend does not work -* Fixed bug 887688: Prepared statements crash pt-query-digest -* Fixed bug 903513: MKDEBUG should be PTDEBUG -* Fixed bug 857091: pt-sift downloads http://percona.com/get/pt-pmp, which does not work -* Fixed bug 857104: pt-sift tries to invoke mext, should be pt-mext -* Fixed bug 884504: pt-stalk doesn't check pt-collect -* Fixed bug 821717: pt-tcp-model --type=requests crashes -* Fixed bug 844038: pt-online-schema-change documentation example w/drop-tmp-table does not work -* Fixed bug 898663: Typo in pt-log-player documentation -* Fixed bug 903753: Typo in pt-table-checksum documentation - v1.0.1 released 2011-09-01 ========================== diff --git a/t/lib/DSNParser.t b/t/lib/DSNParser.t index 952ccd0c..650ccbf6 100644 --- a/t/lib/DSNParser.t +++ b/t/lib/DSNParser.t @@ -252,7 +252,7 @@ SKIP: { # mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/ ? 1 : 0), # in get_dbh(). That line is part of a hashref declaration so we # have no access to it here. I keep this this test because it allows - # me to look manually via MKDEBUG and see that mysql_enable_utf8=>1 + # me to look manually via PTDEBUG and see that mysql_enable_utf8=>1 # even if A=UTF8. $d = $dp->parse('h=127.0.0.1,P=12345,A=UTF8,u=msandbox,p=msandbox'); eval { diff --git a/t/lib/Daemon.t b/t/lib/Daemon.t index a2798681..611b5460 100644 --- a/t/lib/Daemon.t +++ b/t/lib/Daemon.t @@ -80,7 +80,7 @@ ok( 'PID file already exists' ); -$output = `MKDEBUG=1 $cmd 0 --daemonize --pid $pid_file 2>&1`; +$output = `PTDEBUG=1 $cmd 0 --daemonize --pid $pid_file 2>&1`; like( $output, qr{The PID file $pid_file already exists}, diff --git a/t/lib/ExecutionThrottler.t b/t/lib/ExecutionThrottler.t index 37d11244..9f8a11b7 100644 --- a/t/lib/ExecutionThrottler.t +++ b/t/lib/ExecutionThrottler.t @@ -14,7 +14,7 @@ use Test::More tests => 12; use ExecutionThrottler; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG}; +use constant PTDEBUG => $ENV{PTDEBUG}; my $rate = 100; my $oktorun = 1; diff --git a/t/lib/ExplainAnalyzer.t b/t/lib/ExplainAnalyzer.t index c2c37d58..03593624 100644 --- a/t/lib/ExplainAnalyzer.t +++ b/t/lib/ExplainAnalyzer.t @@ -6,7 +6,7 @@ BEGIN { unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; }; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); diff --git a/t/lib/FileIterator.t b/t/lib/FileIterator.t index 2c1e5e53..e7744ebb 100644 --- a/t/lib/FileIterator.t +++ b/t/lib/FileIterator.t @@ -14,7 +14,7 @@ use Test::More tests => 12; use FileIterator; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; diff --git a/t/lib/IndexUsage.t b/t/lib/IndexUsage.t index 52ff97ff..f05eb401 100644 --- a/t/lib/IndexUsage.t +++ b/t/lib/IndexUsage.t @@ -11,7 +11,7 @@ use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); use Test::More tests => 6; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use IndexUsage; use OptionParser; diff --git a/t/lib/NibbleIterator.t b/t/lib/NibbleIterator.t index 5ab973c6..0601ba0d 100644 --- a/t/lib/NibbleIterator.t +++ b/t/lib/NibbleIterator.t @@ -24,7 +24,7 @@ use NibbleIterator; use Cxn; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; diff --git a/t/lib/OobNibbleIterator.t b/t/lib/OobNibbleIterator.t index 504d97a1..8741b693 100644 --- a/t/lib/OobNibbleIterator.t +++ b/t/lib/OobNibbleIterator.t @@ -25,7 +25,7 @@ use OobNibbleIterator; use Cxn; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; diff --git a/t/lib/Progress.t b/t/lib/Progress.t index 881f44e1..08fad7cd 100644 --- a/t/lib/Progress.t +++ b/t/lib/Progress.t @@ -16,7 +16,7 @@ use Transformers; use Progress; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; diff --git a/t/lib/SchemaIterator.t b/t/lib/SchemaIterator.t index 0eb03c1f..74f134d3 100644 --- a/t/lib/SchemaIterator.t +++ b/t/lib/SchemaIterator.t @@ -20,7 +20,7 @@ use OptionParser; use TableParser; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; diff --git a/t/lib/TableSyncer.t b/t/lib/TableSyncer.t index 3ac42961..8df90bd2 100644 --- a/t/lib/TableSyncer.t +++ b/t/lib/TableSyncer.t @@ -35,7 +35,7 @@ use DSNParser; use Sandbox; use PerconaTest; -use constant MKDEBUG => $ENV{MKDEBUG} || 0; +use constant PTDEBUG => $ENV{PTDEBUG} || 0; my $dp = new DSNParser(opts=>$dsn_opts); my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); @@ -773,18 +773,18 @@ SKIP: { my $left_ts = $lr->{ts}; my $right_ts = $rr->{ts}; - MKDEBUG && TableSyncer::_d("left ts: $left_ts"); - MKDEBUG && TableSyncer::_d("right ts: $right_ts"); + PTDEBUG && TableSyncer::_d("left ts: $left_ts"); + PTDEBUG && TableSyncer::_d("right ts: $right_ts"); my $cmp = ($left_ts || '') cmp ($right_ts || ''); if ( $cmp == -1 ) { - MKDEBUG && TableSyncer::_d("right dbh $dbh3 is newer; update left dbh $src_dbh"); + PTDEBUG && TableSyncer::_d("right dbh $dbh3 is newer; update left dbh $src_dbh"); $ch->set_src('right', $dbh3); $auth_row = $args{rr}; $change_dbh = $src_dbh; } elsif ( $cmp == 1 ) { - MKDEBUG && TableSyncer::_d("left dbh $src_dbh is newer; update right dbh $dbh3"); + PTDEBUG && TableSyncer::_d("left dbh $src_dbh is newer; update right dbh $dbh3"); $ch->set_src('left', $src_dbh); $auth_row = $args{lr}; $change_dbh = $dbh3; diff --git a/t/lib/samples/daemonizes.pl b/t/lib/samples/daemonizes.pl index b801f48e..33053294 100755 --- a/t/lib/samples/daemonizes.pl +++ b/t/lib/samples/daemonizes.pl @@ -13,7 +13,7 @@ use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); -use constant MKDEBUG => $ENV{MKDEBUG}; +use constant PTDEBUG => $ENV{PTDEBUG}; use Daemon; use OptionParser; diff --git a/t/pt-deadlock-logger/clear_deadlocks.t b/t/pt-deadlock-logger/clear_deadlocks.t index 023f89ea..83f52db6 100644 --- a/t/pt-deadlock-logger/clear_deadlocks.t +++ b/t/pt-deadlock-logger/clear_deadlocks.t @@ -39,7 +39,7 @@ $sb->create_dbs($dbh1, ['test']); # The clear-deadlocks table comes and goes quickly so we can really # only search the debug output for evidence that it was created. -$output = `MKDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock 2>&1`; +$output = `PTDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock 2>&1`; like( $output, qr/INSERT INTO test.make_deadlock/, @@ -55,7 +55,7 @@ like( # ############################################################################# # Issue 942: mk-deadlock-logger --clear-deadlocks doesn't work with --interval # ############################################################################# -$output = `MKDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock2 --interval 1 --run-time 1 2>&1`; +$output = `PTDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock2 --interval 1 --run-time 1 2>&1`; like( $output, qr/CREATE TABLE test.make_deadlock2/, diff --git a/t/pt-query-digest/issue_1186.t b/t/pt-query-digest/issue_1186.t index 0316a6b7..05c0f48f 100644 --- a/t/pt-query-digest/issue_1186.t +++ b/t/pt-query-digest/issue_1186.t @@ -30,7 +30,7 @@ else { # Issue 1186: mk-query-digest --processlist --interval --filter ignores interval # ############################################################################# -my $output = `MKDEBUG=1 $trunk/bin/pt-query-digest --processlist h=127.1,P=12345,u=msandbox,p=msandbox --run-time 2 --port 12345 --interval .5 2>&1`; +my $output = `PTDEBUG=1 $trunk/bin/pt-query-digest --processlist h=127.1,P=12345,u=msandbox,p=msandbox --run-time 2 --port 12345 --interval .5 2>&1`; my @times = $output =~ m/Current time: \S+/g; ok( @@ -38,7 +38,7 @@ ok( "--interval limits number of processlist polls (issue 1186)" ); -$output = `MKDEBUG=1 $trunk/bin/pt-query-digest --processlist h=127.1,P=12345,u=msandbox,p=msandbox --run-time 2 --port 12345 --interval .5 --filter '(\$event->{arg} =~ /NEVER HAPPEN/)' 2>&1`; +$output = `PTDEBUG=1 $trunk/bin/pt-query-digest --processlist h=127.1,P=12345,u=msandbox,p=msandbox --run-time 2 --port 12345 --interval .5 --filter '(\$event->{arg} =~ /NEVER HAPPEN/)' 2>&1`; @times = $output =~ m/Current time: \S+/g; ok( diff --git a/t/pt-query-digest/issue_232.t b/t/pt-query-digest/issue_232.t index 90b417c9..9ce97a4e 100644 --- a/t/pt-query-digest/issue_232.t +++ b/t/pt-query-digest/issue_232.t @@ -20,7 +20,7 @@ my $run_with = "$trunk/bin/pt-query-digest --report-format=query_report --limit # ############################################################################# my $output = 'foo'; # clear previous test results my $cmd = "${run_with}slow026.txt"; -$output = `MKDEBUG=1 $cmd 2>&1`; +$output = `PTDEBUG=1 $cmd 2>&1`; # Changed qr// from matching db to Schema because attribs are auto-detected. like( $output, diff --git a/t/pt-query-digest/mirror.t b/t/pt-query-digest/mirror.t index b3ba8e9f..0db20e0e 100644 --- a/t/pt-query-digest/mirror.t +++ b/t/pt-query-digest/mirror.t @@ -48,9 +48,9 @@ $cmd = "$trunk/bin/pt-query-digest " # match this test script and any vi mk-query-digest[.t] that may happen # to be running. -$ENV{MKDEBUG}=1; +$ENV{PTDEBUG}=1; `$cmd > /tmp/read_only.txt 2>&1 &`; -$ENV{MKDEBUG}=0; +$ENV{PTDEBUG}=0; sleep 5; $dbh1->do('select sleep(1)'); sleep 1; diff --git a/t/pt-table-sync/basics.t b/t/pt-table-sync/basics.t index f4c74a19..bbbe512b 100644 --- a/t/pt-table-sync/basics.t +++ b/t/pt-table-sync/basics.t @@ -122,13 +122,13 @@ is_deeply( 'Synced OK with Nibble' ); -# Save original MKDEBUG env because we modify it below. -my $dbg = $ENV{MKDEBUG}; +# Save original PTDEBUG env because we modify it below. +my $dbg = $ENV{PTDEBUG}; $sb->load_file('master', 't/pt-table-sync/samples/before.sql'); -$ENV{MKDEBUG} = 1; +$ENV{PTDEBUG} = 1; $output = run_cmd('test1', 'test2', '--algorithms Nibble --no-bin-log --chunk-size 1 --transaction --lock 1'); -delete $ENV{MKDEBUG}; +delete $ENV{PTDEBUG}; like( $output, qr/Executing statement on source/, @@ -141,9 +141,9 @@ is_deeply( ); # Sync tables that have values with leading zeroes -$ENV{MKDEBUG} = 1; +$ENV{PTDEBUG} = 1; $output = run('test3', 'test4', '--print --no-bin-log --verbose --function MD5'); -delete $ENV{MKDEBUG}; +delete $ENV{PTDEBUG}; like( $output, qr/UPDATE `test`.`test4`.*51707/, @@ -165,8 +165,8 @@ $output = run('test3', 'test4', '--algorithms Nibble --chunk-size 1k --print --v # If it lived, it's OK. ok($output, 'Synced with Nibble and data-size chunksize'); -# Restore MKDEBUG env. -$ENV{MKDEBUG} = $dbg || 0; +# Restore PTDEBUG env. +$ENV{PTDEBUG} = $dbg || 0; # ############################################################################# diff --git a/t/pt-table-sync/force_index.t b/t/pt-table-sync/force_index.t index 3ec85eac..bb6e8562 100644 --- a/t/pt-table-sync/force_index.t +++ b/t/pt-table-sync/force_index.t @@ -43,10 +43,10 @@ $sb->create_dbs($master_dbh, [qw(test)]); $sb->load_file('master', 't/pt-table-sync/samples/issue_37.sql'); $sb->use('master', '-e \'INSERT INTO test.issue_37 VALUES (5), (6), (7), (8), (9);\''); -$output = `MKDEBUG=1 $trunk/bin/pt-table-sync h=127.0.0.1,P=12345,u=msandbox,p=msandbox P=12346 -d test -t issue_37 --algorithms Chunk --chunk-size 3 --no-check-slave --no-check-triggers --print 2>&1 | grep 'src: '`; +$output = `PTDEBUG=1 $trunk/bin/pt-table-sync h=127.0.0.1,P=12345,u=msandbox,p=msandbox P=12346 -d test -t issue_37 --algorithms Chunk --chunk-size 3 --no-check-slave --no-check-triggers --print 2>&1 | grep 'src: '`; like($output, qr/FROM `test`\.`issue_37` FORCE INDEX \(`idx_a`\) WHERE/, 'Injects USE INDEX hint by default'); -$output = `MKDEBUG=1 $trunk/bin/pt-table-sync h=127.0.0.1,P=12345,u=msandbox,p=msandbox P=12346 -d test -t issue_37 --algorithms Chunk --chunk-size 3 --no-check-slave --no-check-triggers --no-index-hint --print 2>&1 | grep 'src: '`; +$output = `PTDEBUG=1 $trunk/bin/pt-table-sync h=127.0.0.1,P=12345,u=msandbox,p=msandbox P=12346 -d test -t issue_37 --algorithms Chunk --chunk-size 3 --no-check-slave --no-check-triggers --no-index-hint --print 2>&1 | grep 'src: '`; like($output, qr/FROM `test`\.`issue_37` WHERE/, 'No USE INDEX hint with --no-index-hint'); # #############################################################################