percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-11 13:40:07 +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

220
bin/pt-variable-advisor
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 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;