percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-24 21:35:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

Change MKDEBUG to PTDEBUG. Remove 1.0.2 from release notes.

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

210
bin/pt-slave-delay
View File

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