Change MKDEBUG to PTDEBUG. Remove 1.0.2 from release notes.

This commit is contained in:
Daniel Nichter
2011-12-30 09:23:41 -07:00
parent 547cbfd348
commit d1bd7a9f3b
44 changed files with 5083 additions and 5111 deletions

View File

@@ -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(/(?<!\\),\s*/, ($val || '')) ];
}
else {
MKDEBUG && _d('Nothing to validate for option',
PTDEBUG && _d('Nothing to validate for option',
$opt->{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);