mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-11 13:40:07 +00:00
Change MKDEBUG to PTDEBUG. Remove 1.0.2 from release notes.
This commit is contained in:
@@ -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 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 ) {
|
||||
|
Reference in New Issue
Block a user