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

Replace the last instances of MKDEBUG

Browse Source
This commit is contained in:
Brian Fraser fraserb@gmail.com
2012-06-05 12:28:36 -03:00
parent 6b93d51e43
commit 345a21a82e
22 changed files with 278 additions and 278 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
bin/pt-diskstats
View File

@@ -6,7 +6,7 @@
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# %INC magic to allow us to require/use these even within the big file. # %INC magic to allow us to require/use these even within the big file.
BEGIN { BEGIN {
@@ -1319,7 +1319,7 @@ BEGIN { $INC{"ReadKeyMini.pm"} ||= 1 }
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw( :termios_h ); use POSIX qw( :termios_h );
use Fcntl qw( F_SETFL F_GETFL ); use Fcntl qw( F_SETFL F_GETFL );
@@ -2489,7 +2489,7 @@ package DiskstatsGroupByAll;
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats ); use base qw( Diskstats );
@@ -2562,7 +2562,7 @@ package DiskstatsGroupByDisk;
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats ); use base qw( Diskstats );

4
bin/pt-fingerprint
View File

@@ -6,7 +6,7 @@
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# ########################################################################### # ###########################################################################
# OptionParser package # OptionParser package
@@ -1843,7 +1843,7 @@ use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
$OUTPUT_AUTOFLUSH = 1; $OUTPUT_AUTOFLUSH = 1;
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
sub main { sub main {
@ARGV = @_; # set global ARGV for this package @ARGV = @_; # set global ARGV for this package

262
bin/pt-table-usage
View File

@@ -2736,7 +2736,7 @@ package SQLParser;
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
@@ -2807,7 +2807,7 @@ sub parse {
my $type; my $type;
if ( $query =~ s/^(\w+)\s+// ) { if ( $query =~ s/^(\w+)\s+// ) {
$type = lc $1; $type = lc $1;
MKDEBUG && _d('Query type:', $type); PTDEBUG && _d('Query type:', $type);
die "Cannot parse " . uc($type) . " queries" die "Cannot parse " . uc($type) . " queries"
unless $type =~ m/$allowed_types/i; unless $type =~ m/$allowed_types/i;
} }
@@ -2819,12 +2819,12 @@ sub parse {
my @subqueries; my @subqueries;
if ( $query =~ m/(\(SELECT )/i ) { if ( $query =~ m/(\(SELECT )/i ) {
MKDEBUG && _d('Removing subqueries'); PTDEBUG && _d('Removing subqueries');
@subqueries = $self->remove_subqueries($query); @subqueries = $self->remove_subqueries($query);
$query = shift @subqueries; $query = shift @subqueries;
} }
elsif ( $type eq 'create' && $query =~ m/\s+SELECT/ ) { elsif ( $type eq 'create' && $query =~ m/\s+SELECT/ ) {
MKDEBUG && _d('CREATE..SELECT'); PTDEBUG && _d('CREATE..SELECT');
($subqueries[0]->{query}) = $query =~ m/\s+(SELECT .+)/; ($subqueries[0]->{query}) = $query =~ m/\s+(SELECT .+)/;
$query =~ s/\s+SELECT.+//; $query =~ s/\s+SELECT.+//;
} }
@@ -2832,14 +2832,14 @@ sub parse {
my $parse_func = "parse_$type"; my $parse_func = "parse_$type";
my $struct = $self->$parse_func($query); my $struct = $self->$parse_func($query);
if ( !$struct ) { if ( !$struct ) {
MKDEBUG && _d($parse_func, 'failed to parse query'); PTDEBUG && _d($parse_func, 'failed to parse query');
return; return;
} }
$struct->{type} = $type; $struct->{type} = $type;
$self->_parse_clauses($struct); $self->_parse_clauses($struct);
if ( @subqueries ) { if ( @subqueries ) {
MKDEBUG && _d('Parsing subqueries'); PTDEBUG && _d('Parsing subqueries');
foreach my $subquery ( @subqueries ) { foreach my $subquery ( @subqueries ) {
my $subquery_struct = $self->parse($subquery->{query}); my $subquery_struct = $self->parse($subquery->{query});
@{$subquery_struct}{keys %$subquery} = values %$subquery; @{$subquery_struct}{keys %$subquery} = values %$subquery;
@@ -2847,7 +2847,7 @@ sub parse {
} }
} }
MKDEBUG && _d('Query struct:', Dumper($struct)); PTDEBUG && _d('Query struct:', Dumper($struct));
return $struct; return $struct;
} }
@@ -2866,7 +2866,7 @@ sub _parse_clauses {
$struct->{$clause} = $self->$parse_func($struct->{clauses}->{$clause}); $struct->{$clause} = $self->$parse_func($struct->{clauses}->{$clause});
if ( $clause eq 'select' ) { if ( $clause eq 'select' ) {
MKDEBUG && _d('Parsing subquery clauses'); PTDEBUG && _d('Parsing subquery clauses');
$struct->{select}->{type} = 'select'; $struct->{select}->{type} = 'select';
$self->_parse_clauses($struct->{select}); $self->_parse_clauses($struct->{select});
} }
@@ -2912,13 +2912,13 @@ sub _parse_query {
my $clause = $first_clause, my $clause = $first_clause,
my $value = shift @clause; my $value = shift @clause;
$struct->{clauses}->{$clause} = $value; $struct->{clauses}->{$clause} = $value;
MKDEBUG && _d('Clause:', $clause, $value); PTDEBUG && _d('Clause:', $clause, $value);
while ( @clause ) { while ( @clause ) {
$clause = shift @clause; $clause = shift @clause;
$value = shift @clause; $value = shift @clause;
$struct->{clauses}->{lc $clause} = $value; $struct->{clauses}->{lc $clause} = $value;
MKDEBUG && _d('Clause:', $clause, $value); PTDEBUG && _d('Clause:', $clause, $value);
} }
($struct->{unknown}) = ($query =~ m/\G(.+)/); ($struct->{unknown}) = ($query =~ m/\G(.+)/);
@@ -2950,7 +2950,7 @@ sub parse_insert {
my $values = $1; my $values = $1;
die "No values after ON DUPLICATE KEY UPDATE: $query" unless $values; die "No values after ON DUPLICATE KEY UPDATE: $query" unless $values;
$struct->{clauses}->{on_duplicate} = $values; $struct->{clauses}->{on_duplicate} = $values;
MKDEBUG && _d('Clause: on duplicate key update', $values); PTDEBUG && _d('Clause: on duplicate key update', $values);
$query =~ s/\s+ON DUPLICATE KEY UPDATE.+//; $query =~ s/\s+ON DUPLICATE KEY UPDATE.+//;
} }
@@ -2964,13 +2964,13 @@ sub parse_insert {
) { ) {
my $tbl = shift @into; # table ref my $tbl = shift @into; # table ref
$struct->{clauses}->{into} = $tbl; $struct->{clauses}->{into} = $tbl;
MKDEBUG && _d('Clause: into', $tbl); PTDEBUG && _d('Clause: into', $tbl);
my $cols = shift @into; # columns, maybe my $cols = shift @into; # columns, maybe
if ( $cols ) { if ( $cols ) {
$cols =~ s/[\(\)]//g; $cols =~ s/[\(\)]//g;
$struct->{clauses}->{columns} = $cols; $struct->{clauses}->{columns} = $cols;
MKDEBUG && _d('Clause: columns', $cols); PTDEBUG && _d('Clause: columns', $cols);
} }
my $next_clause = lc(shift @into); # VALUES, SET or SELECT my $next_clause = lc(shift @into); # VALUES, SET or SELECT
@@ -2980,7 +2980,7 @@ sub parse_insert {
my ($values) = ($query =~ m/\G(.+)/gci); my ($values) = ($query =~ m/\G(.+)/gci);
die "INSERT/REPLACE without values: $query" unless $values; die "INSERT/REPLACE without values: $query" unless $values;
$struct->{clauses}->{$next_clause} = $values; $struct->{clauses}->{$next_clause} = $values;
MKDEBUG && _d('Clause:', $next_clause, $values); PTDEBUG && _d('Clause:', $next_clause, $values);
} }
($struct->{unknown}) = ($query =~ m/\G(.+)/); ($struct->{unknown}) = ($query =~ m/\G(.+)/);
@@ -3053,7 +3053,7 @@ sub parse_create {
sub parse_from { sub parse_from {
my ( $self, $from ) = @_; my ( $self, $from ) = @_;
return unless $from; return unless $from;
MKDEBUG && _d('Parsing FROM', $from); PTDEBUG && _d('Parsing FROM', $from);
my $using_cols; my $using_cols;
($from, $using_cols) = $self->remove_using_columns($from); ($from, $using_cols) = $self->remove_using_columns($from);
@@ -3077,10 +3077,10 @@ sub parse_from {
$thing =~ s/^\s+//; $thing =~ s/^\s+//;
$thing =~ s/\s+$//; $thing =~ s/\s+$//;
MKDEBUG && _d('Table thing:', $thing); PTDEBUG && _d('Table thing:', $thing);
if ( $thing =~ m/\s+(?:ON|USING)\s+/i ) { if ( $thing =~ m/\s+(?:ON|USING)\s+/i ) {
MKDEBUG && _d("JOIN condition"); PTDEBUG && _d("JOIN condition");
my ($tbl_ref_txt, $join_condition_verb, $join_condition_value) my ($tbl_ref_txt, $join_condition_verb, $join_condition_value)
= $thing =~ m/^(.+?)\s+(ON|USING)\s+(.+)/i; = $thing =~ m/^(.+?)\s+(ON|USING)\s+(.+)/i;
@@ -3099,7 +3099,7 @@ sub parse_from {
$tbl_ref->{join} = $join; $tbl_ref->{join} = $join;
} }
push @tbls, $tbl_ref; push @tbls, $tbl_ref;
MKDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref));
$tbl_ref = undef; $tbl_ref = undef;
$join = {}; $join = {};
@@ -3117,7 +3117,7 @@ sub parse_from {
} }
else { else {
$tbl_ref = $self->parse_table_reference($thing); $tbl_ref = $self->parse_table_reference($thing);
MKDEBUG && _d('Table reference:', Dumper($tbl_ref)); PTDEBUG && _d('Table reference:', Dumper($tbl_ref));
} }
} }
@@ -3126,7 +3126,7 @@ sub parse_from {
$tbl_ref->{join} = $join; $tbl_ref->{join} = $join;
} }
push @tbls, $tbl_ref; push @tbls, $tbl_ref;
MKDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref));
} }
return \@tbls; return \@tbls;
@@ -3135,7 +3135,7 @@ sub parse_from {
sub parse_table_reference { sub parse_table_reference {
my ( $self, $tbl_ref ) = @_; my ( $self, $tbl_ref ) = @_;
return unless $tbl_ref; return unless $tbl_ref;
MKDEBUG && _d('Parsing table reference:', $tbl_ref); PTDEBUG && _d('Parsing table reference:', $tbl_ref);
my %tbl; my %tbl;
if ( $tbl_ref =~ s/ if ( $tbl_ref =~ s/
@@ -3146,7 +3146,7 @@ sub parse_table_reference {
)//xi) )//xi)
{ {
$tbl{index_hint} = $1; $tbl{index_hint} = $1;
MKDEBUG && _d('Index hint:', $tbl{index_hint}); PTDEBUG && _d('Index hint:', $tbl{index_hint});
} }
if ( $tbl_ref =~ m/$table_ident/ ) { if ( $tbl_ref =~ m/$table_ident/ ) {
@@ -3172,7 +3172,7 @@ sub parse_table_reference {
sub parse_where { sub parse_where {
my ( $self, $where, $functions ) = @_; my ( $self, $where, $functions ) = @_;
return unless $where; return unless $where;
MKDEBUG && _d("Parsing WHERE", $where); PTDEBUG && _d("Parsing WHERE", $where);
my $op_symbol = qr/ my $op_symbol = qr/
(?: (?:
@@ -3216,8 +3216,8 @@ sub parse_where {
$pred = substr $where, $offset; $pred = substr $where, $offset;
push @pred, $pred; push @pred, $pred;
push @has_op, $pred =~ m/$op_pat/o ? 1 : 0; push @has_op, $pred =~ m/$op_pat/o ? 1 : 0;
MKDEBUG && _d("Predicate fragments:", Dumper(\@pred)); PTDEBUG && _d("Predicate fragments:", Dumper(\@pred));
MKDEBUG && _d("Predicate frags with operators:", @has_op); PTDEBUG && _d("Predicate frags with operators:", @has_op);
my $n = scalar @pred - 1; my $n = scalar @pred - 1;
for my $i ( 1..$n ) { for my $i ( 1..$n ) {
@@ -3231,7 +3231,7 @@ sub parse_where {
$pred[$i] = undef; $pred[$i] = undef;
} }
} }
MKDEBUG && _d("Predicate fragments joined:", Dumper(\@pred)); PTDEBUG && _d("Predicate fragments joined:", Dumper(\@pred));
for my $i ( 0..@pred ) { for my $i ( 0..@pred ) {
$pred = $pred[$i]; $pred = $pred[$i];
@@ -3243,7 +3243,7 @@ sub parse_where {
$pred[$i + 1] = undef; $pred[$i + 1] = undef;
} }
} }
MKDEBUG && _d("Predicate fragments balanced:", Dumper(\@pred)); PTDEBUG && _d("Predicate fragments balanced:", Dumper(\@pred));
my @predicates; my @predicates;
foreach my $pred ( @pred ) { foreach my $pred ( @pred ) {
@@ -3315,7 +3315,7 @@ sub parse_having {
sub parse_group_by { sub parse_group_by {
my ( $self, $group_by ) = @_; my ( $self, $group_by ) = @_;
return unless $group_by; return unless $group_by;
MKDEBUG && _d('Parsing GROUP BY', $group_by); PTDEBUG && _d('Parsing GROUP BY', $group_by);
my $with_rollup = $group_by =~ s/\s+WITH ROLLUP\s*//i; my $with_rollup = $group_by =~ s/\s+WITH ROLLUP\s*//i;
@@ -3329,7 +3329,7 @@ sub parse_group_by {
sub parse_order_by { sub parse_order_by {
my ( $self, $order_by ) = @_; my ( $self, $order_by ) = @_;
return unless $order_by; return unless $order_by;
MKDEBUG && _d('Parsing ORDER BY', $order_by); PTDEBUG && _d('Parsing ORDER BY', $order_by);
my $idents = $self->parse_identifiers( $self->_parse_csv($order_by) ); my $idents = $self->parse_identifiers( $self->_parse_csv($order_by) );
return $idents; return $idents;
} }
@@ -3368,7 +3368,7 @@ sub parse_values {
sub parse_set { sub parse_set {
my ( $self, $set ) = @_; my ( $self, $set ) = @_;
MKDEBUG && _d("Parse SET", $set); PTDEBUG && _d("Parse SET", $set);
return unless $set; return unless $set;
my $vals = $self->_parse_csv($set); my $vals = $self->_parse_csv($set);
return unless $vals && @$vals; return unless $vals && @$vals;
@@ -3381,7 +3381,7 @@ sub parse_set {
%$ident_struct, %$ident_struct,
value => $val, value => $val,
}; };
MKDEBUG && _d("SET:", Dumper($set_struct)); PTDEBUG && _d("SET:", Dumper($set_struct));
push @set, $set_struct; push @set, $set_struct;
} }
return \@set; return \@set;
@@ -3396,9 +3396,9 @@ sub _parse_csv {
my $quote_char = ''; my $quote_char = '';
VAL: VAL:
foreach my $val ( split(',', $vals) ) { foreach my $val ( split(',', $vals) ) {
MKDEBUG && _d("Next value:", $val); PTDEBUG && _d("Next value:", $val);
if ( $quote_char ) { if ( $quote_char ) {
MKDEBUG && _d("Value is part of previous quoted value"); PTDEBUG && _d("Value is part of previous quoted value");
$vals[-1] .= ",$val"; $vals[-1] .= ",$val";
if ( $val =~ m/[^\\]*$quote_char$/ ) { if ( $val =~ m/[^\\]*$quote_char$/ ) {
@@ -3406,7 +3406,7 @@ sub _parse_csv {
$vals[-1] =~ s/^\s*$quote_char//; $vals[-1] =~ s/^\s*$quote_char//;
$vals[-1] =~ s/$quote_char\s*$//; $vals[-1] =~ s/$quote_char\s*$//;
} }
MKDEBUG && _d("Previous quoted value is complete:", $vals[-1]); PTDEBUG && _d("Previous quoted value is complete:", $vals[-1]);
$quote_char = ''; $quote_char = '';
} }
@@ -3416,10 +3416,10 @@ sub _parse_csv {
$val =~ s/^\s+//; $val =~ s/^\s+//;
if ( $val =~ m/^(['"])/ ) { if ( $val =~ m/^(['"])/ ) {
MKDEBUG && _d("Value is quoted"); PTDEBUG && _d("Value is quoted");
$quote_char = $1; # XXX $quote_char = $1; # XXX
if ( $val =~ m/.$quote_char$/ ) { if ( $val =~ m/.$quote_char$/ ) {
MKDEBUG && _d("Value is complete"); PTDEBUG && _d("Value is complete");
$quote_char = ''; $quote_char = '';
if ( $args{remove_quotes} ) { if ( $args{remove_quotes} ) {
$vals[-1] =~ s/^\s*$quote_char//; $vals[-1] =~ s/^\s*$quote_char//;
@@ -3427,14 +3427,14 @@ sub _parse_csv {
} }
} }
else { else {
MKDEBUG && _d("Quoted value is not complete"); PTDEBUG && _d("Quoted value is not complete");
} }
} }
else { else {
$val =~ s/\s+$//; $val =~ s/\s+$//;
} }
MKDEBUG && _d("Saving value", ($quote_char ? "fragment" : "")); PTDEBUG && _d("Saving value", ($quote_char ? "fragment" : ""));
push @vals, $val; push @vals, $val;
} }
} }
@@ -3451,7 +3451,7 @@ sub _parse_csv {
sub parse_columns { sub parse_columns {
my ( $self, $cols ) = @_; my ( $self, $cols ) = @_;
MKDEBUG && _d('Parsing columns list:', $cols); PTDEBUG && _d('Parsing columns list:', $cols);
my @cols; my @cols;
pos $cols = 0; pos $cols = 0;
@@ -3501,31 +3501,31 @@ sub remove_subqueries {
my $len_adj = 0; my $len_adj = 0;
my $n = 0; my $n = 0;
for my $i ( 0..$#start_pos ) { for my $i ( 0..$#start_pos ) {
MKDEBUG && _d('Query:', $query); PTDEBUG && _d('Query:', $query);
my $offset = $start_pos[$i]; my $offset = $start_pos[$i];
my $len = $end_pos[$i] - $start_pos[$i] - $len_adj; my $len = $end_pos[$i] - $start_pos[$i] - $len_adj;
MKDEBUG && _d("Subquery $n start", $start_pos[$i], PTDEBUG && _d("Subquery $n start", $start_pos[$i],
'orig end', $end_pos[$i], 'adj', $len_adj, 'adj end', 'orig end', $end_pos[$i], 'adj', $len_adj, 'adj end',
$offset + $len, 'len', $len); $offset + $len, 'len', $len);
my $struct = {}; my $struct = {};
my $token = '__SQ' . $n . '__'; my $token = '__SQ' . $n . '__';
my $subquery = substr($query, $offset, $len, $token); my $subquery = substr($query, $offset, $len, $token);
MKDEBUG && _d("Subquery $n:", $subquery); PTDEBUG && _d("Subquery $n:", $subquery);
my $outer_start = $start_pos[$i + 1]; my $outer_start = $start_pos[$i + 1];
my $outer_end = $end_pos[$i + 1]; my $outer_end = $end_pos[$i + 1];
if ( $outer_start && ($outer_start < $start_pos[$i]) if ( $outer_start && ($outer_start < $start_pos[$i])
&& $outer_end && ($outer_end > $end_pos[$i]) ) { && $outer_end && ($outer_end > $end_pos[$i]) ) {
MKDEBUG && _d("Subquery $n nested in next subquery"); PTDEBUG && _d("Subquery $n nested in next subquery");
$len_adj += $len - length $token; $len_adj += $len - length $token;
$struct->{nested} = $i + 1; $struct->{nested} = $i + 1;
} }
else { else {
MKDEBUG && _d("Subquery $n not nested"); PTDEBUG && _d("Subquery $n not nested");
$len_adj = 0; $len_adj = 0;
if ( $subqueries[-1] && $subqueries[-1]->{nested} ) { if ( $subqueries[-1] && $subqueries[-1]->{nested} ) {
MKDEBUG && _d("Outermost subquery"); PTDEBUG && _d("Outermost subquery");
} }
} }
@@ -3542,7 +3542,7 @@ sub remove_subqueries {
else { else {
$struct->{context} = 'identifier'; $struct->{context} = 'identifier';
} }
MKDEBUG && _d("Subquery $n context:", $struct->{context}); PTDEBUG && _d("Subquery $n context:", $struct->{context});
$subquery =~ s/^\s*\(//; $subquery =~ s/^\s*\(//;
$subquery =~ s/\s*\)\s*$//; $subquery =~ s/\s*\)\s*$//;
@@ -3558,7 +3558,7 @@ sub remove_subqueries {
sub remove_using_columns { sub remove_using_columns {
my ($self, $from) = @_; my ($self, $from) = @_;
return unless $from; return unless $from;
MKDEBUG && _d('Removing cols from USING clauses'); PTDEBUG && _d('Removing cols from USING clauses');
my $using = qr/ my $using = qr/
\bUSING \bUSING
\s* \s*
@@ -3568,7 +3568,7 @@ sub remove_using_columns {
/xi; /xi;
my @cols; my @cols;
$from =~ s/$using/push @cols, $1; "USING ($#cols)"/eg; $from =~ s/$using/push @cols, $1; "USING ($#cols)"/eg;
MKDEBUG && _d('FROM:', $from, Dumper(\@cols)); PTDEBUG && _d('FROM:', $from, Dumper(\@cols));
return $from, \@cols; return $from, \@cols;
} }
@@ -3586,21 +3586,21 @@ sub replace_function {
sub remove_functions { sub remove_functions {
my ($self, $clause) = @_; my ($self, $clause) = @_;
return unless $clause; return unless $clause;
MKDEBUG && _d('Removing functions from clause:', $clause); PTDEBUG && _d('Removing functions from clause:', $clause);
my @funcs; my @funcs;
$clause =~ s/$function_ident/replace_function($1, \@funcs)/eg; $clause =~ s/$function_ident/replace_function($1, \@funcs)/eg;
MKDEBUG && _d('Function-stripped clause:', $clause, Dumper(\@funcs)); PTDEBUG && _d('Function-stripped clause:', $clause, Dumper(\@funcs));
return $clause, \@funcs; return $clause, \@funcs;
} }
sub parse_identifiers { sub parse_identifiers {
my ( $self, $idents ) = @_; my ( $self, $idents ) = @_;
return unless $idents; return unless $idents;
MKDEBUG && _d("Parsing identifiers"); PTDEBUG && _d("Parsing identifiers");
my @ident_parts; my @ident_parts;
foreach my $ident ( @$idents ) { foreach my $ident ( @$idents ) {
MKDEBUG && _d("Identifier:", $ident); PTDEBUG && _d("Identifier:", $ident);
my $parts = {}; my $parts = {};
if ( $ident =~ s/\s+(ASC|DESC)\s*$//i ) { if ( $ident =~ s/\s+(ASC|DESC)\s*$//i ) {
@@ -3608,17 +3608,17 @@ sub parse_identifiers {
} }
if ( $ident =~ m/^\d+$/ ) { # Position like 5 if ( $ident =~ m/^\d+$/ ) { # Position like 5
MKDEBUG && _d("Positional ident"); PTDEBUG && _d("Positional ident");
$parts->{position} = $ident; $parts->{position} = $ident;
} }
elsif ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col) elsif ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col)
MKDEBUG && _d("Expression ident"); PTDEBUG && _d("Expression ident");
my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/; my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/;
$parts->{function} = uc $func; $parts->{function} = uc $func;
$parts->{expression} = $expr if $expr; $parts->{expression} = $expr if $expr;
} }
else { # Ref like (table.)column else { # Ref like (table.)column
MKDEBUG && _d("Table/column ident"); PTDEBUG && _d("Table/column ident");
my ($tbl, $col) = $self->split_unquote($ident); my ($tbl, $col) = $self->split_unquote($ident);
$parts->{table} = $tbl if $tbl; $parts->{table} = $tbl if $tbl;
$parts->{column} = $col; $parts->{column} = $col;
@@ -3632,11 +3632,11 @@ sub parse_identifiers {
sub parse_identifier { sub parse_identifier {
my ( $self, $type, $ident ) = @_; my ( $self, $type, $ident ) = @_;
return unless $type && $ident; return unless $type && $ident;
MKDEBUG && _d("Parsing", $type, "identifier:", $ident); PTDEBUG && _d("Parsing", $type, "identifier:", $ident);
if ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col) if ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col)
my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/; my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/;
MKDEBUG && _d('Function', $func, 'arg', $expr); PTDEBUG && _d('Function', $func, 'arg', $expr);
return { col => $ident } unless $expr; # NOW() return { col => $ident } unless $expr; # NOW()
$ident = $expr; # col from MAX(col) $ident = $expr; # col from MAX(col)
} }
@@ -3676,7 +3676,7 @@ sub parse_identifier {
} }
} }
MKDEBUG && _d($type, "identifier struct:", Dumper(\%ident_struct)); PTDEBUG && _d($type, "identifier struct:", Dumper(\%ident_struct));
return \%ident_struct; return \%ident_struct;
} }
@@ -3752,7 +3752,7 @@ $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0; $Data::Dumper::Quotekeys = 0;
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
sub new { sub new {
my ( $class, %args ) = @_; my ( $class, %args ) = @_;
@@ -3777,7 +3777,7 @@ sub get_table_usage {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($query) = @args{@required_args}; my ($query) = @args{@required_args};
MKDEBUG && _d('Getting table access for', PTDEBUG && _d('Getting table access for',
substr($query, 0, 100), (length $query > 100 ? '...' : '')); substr($query, 0, 100), (length $query > 100 ? '...' : ''));
$self->{errors} = []; $self->{errors} = [];
@@ -3792,7 +3792,7 @@ sub get_table_usage {
$query_struct = $self->{SQLParser}->parse($query); $query_struct = $self->{SQLParser}->parse($query);
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
MKDEBUG && _d('Failed to parse query with SQLParser:', $EVAL_ERROR); PTDEBUG && _d('Failed to parse query with SQLParser:', $EVAL_ERROR);
if ( $EVAL_ERROR =~ m/Cannot parse/ ) { if ( $EVAL_ERROR =~ m/Cannot parse/ ) {
$tables = $self->_get_tables_used_from_query_parser(%args); $tables = $self->_get_tables_used_from_query_parser(%args);
} }
@@ -3807,7 +3807,7 @@ sub get_table_usage {
); );
} }
MKDEBUG && _d('Query table usage:', Dumper($tables)); PTDEBUG && _d('Query table usage:', Dumper($tables));
return $tables; return $tables;
} }
@@ -3823,7 +3823,7 @@ sub _get_tables_used_from_query_parser {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($query) = @args{@required_args}; my ($query) = @args{@required_args};
MKDEBUG && _d('Getting tables used from query parser'); PTDEBUG && _d('Getting tables used from query parser');
$query = $self->{QueryParser}->clean_query($query); $query = $self->{QueryParser}->clean_query($query);
my ($query_type) = $query =~ m/^\s*(\w+)\s+/; my ($query_type) = $query =~ m/^\s*(\w+)\s+/;
@@ -3856,15 +3856,15 @@ sub _get_tables_used_from_query_struct {
} }
my ($query_struct) = @args{@required_args}; my ($query_struct) = @args{@required_args};
MKDEBUG && _d('Getting table used from query struct'); PTDEBUG && _d('Getting table used from query struct');
my $query_type = uc $query_struct->{type}; my $query_type = uc $query_struct->{type};
if ( $query_type eq 'CREATE' ) { if ( $query_type eq 'CREATE' ) {
MKDEBUG && _d('CREATE query'); PTDEBUG && _d('CREATE query');
my $sel_tables; my $sel_tables;
if ( my $sq_struct = $query_struct->{subqueries}->[0] ) { if ( my $sq_struct = $query_struct->{subqueries}->[0] ) {
MKDEBUG && _d('CREATE query with SELECT'); PTDEBUG && _d('CREATE query with SELECT');
$sel_tables = $self->_get_tables_used_from_query_struct( $sel_tables = $self->_get_tables_used_from_query_struct(
%args, %args,
query => $sq_struct->{query}, query => $sq_struct->{query},
@@ -3884,7 +3884,7 @@ sub _get_tables_used_from_query_struct {
my $tables = $self->_get_tables($query_struct); my $tables = $self->_get_tables($query_struct);
if ( !$tables || @$tables == 0 ) { if ( !$tables || @$tables == 0 ) {
MKDEBUG && _d("Query does not use any tables"); PTDEBUG && _d("Query does not use any tables");
return [ return [
[ { context => $query_type, table => $self->{constant_data_value} } ] [ { context => $query_type, table => $self->{constant_data_value} } ]
]; ];
@@ -3899,17 +3899,17 @@ sub _get_tables_used_from_query_struct {
); );
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns"); PTDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
} }
my @tables_used; my @tables_used;
if ( $query_type eq 'UPDATE' && @{$query_struct->{tables}} > 1 ) { if ( $query_type eq 'UPDATE' && @{$query_struct->{tables}} > 1 ) {
MKDEBUG && _d("Multi-table UPDATE"); PTDEBUG && _d("Multi-table UPDATE");
my @join_tables; my @join_tables;
foreach my $table ( @$tables ) { foreach my $table ( @$tables ) {
@@ -3923,7 +3923,7 @@ sub _get_tables_used_from_query_struct {
context => 'JOIN', context => 'JOIN',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from TLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from TLIST:", Dumper($table_usage));
push @join_tables, $table_usage; push @join_tables, $table_usage;
} }
if ( $where && $where->{joined_tables} ) { if ( $where && $where->{joined_tables} ) {
@@ -3932,7 +3932,7 @@ sub _get_tables_used_from_query_struct {
context => $query_type, context => $query_type,
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE (implicit join):", PTDEBUG && _d("Table usage from WHERE (implicit join):",
Dumper($table_usage)); Dumper($table_usage));
push @join_tables, $table_usage; push @join_tables, $table_usage;
} }
@@ -3945,7 +3945,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE', context => 'WHERE',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE:", Dumper($table_usage)); PTDEBUG && _d("Table usage from WHERE:", Dumper($table_usage));
push @where_tables, $table_usage; push @where_tables, $table_usage;
} }
} }
@@ -3966,7 +3966,7 @@ sub _get_tables_used_from_query_struct {
table => $table->{value}, table => $table->{value},
}, },
); );
MKDEBUG && _d("Table usage from UPDATE SET:", Dumper(\@table_usage)); PTDEBUG && _d("Table usage from UPDATE SET:", Dumper(\@table_usage));
push @tables_used, [ push @tables_used, [
@table_usage, @table_usage,
@join_tables, @join_tables,
@@ -3983,11 +3983,11 @@ sub _get_tables_used_from_query_struct {
); );
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns"); PTDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
foreach my $table ( @$clist_tables ) { foreach my $table ( @$clist_tables ) {
@@ -3995,7 +3995,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT', context => 'SELECT',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from CLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from CLIST:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -4014,7 +4014,7 @@ sub _get_tables_used_from_query_struct {
if ( $table->{join} && $table->{join}->{condition} ) { if ( $table->{join} && $table->{join}->{condition} ) {
$context = 'JOIN'; $context = 'JOIN';
if ( $table->{join}->{condition} eq 'using' ) { if ( $table->{join}->{condition} eq 'using' ) {
MKDEBUG && _d("Table joined with USING condition"); PTDEBUG && _d("Table joined with USING condition");
my $joined_table = $self->_qualify_table_name( my $joined_table = $self->_qualify_table_name(
%args, %args,
tables => $tables, tables => $tables,
@@ -4029,22 +4029,22 @@ sub _get_tables_used_from_query_struct {
); );
} }
elsif ( $table->{join}->{condition} eq 'on' ) { elsif ( $table->{join}->{condition} eq 'on' ) {
MKDEBUG && _d("Table joined with ON condition"); PTDEBUG && _d("Table joined with ON condition");
my ($on_tables, $ambig) = $self->_get_tables_used_in_where( my ($on_tables, $ambig) = $self->_get_tables_used_in_where(
%args, %args,
tables => $tables, tables => $tables,
where => $table->{join}->{where}, where => $table->{join}->{where},
clause => 'JOIN condition', # just for debugging clause => 'JOIN condition', # just for debugging
); );
MKDEBUG && _d("JOIN ON tables:", Dumper($on_tables)); PTDEBUG && _d("JOIN ON tables:", Dumper($on_tables));
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED", PTDEBUG && _d("Using EXPLAIN EXTENDED",
"to disambiguate columns"); "to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
foreach my $joined_table ( @{$on_tables->{joined_tables}} ) { foreach my $joined_table ( @{$on_tables->{joined_tables}} ) {
@@ -4066,14 +4066,14 @@ sub _get_tables_used_from_query_struct {
context => $context, context => $context,
table => $qualified_table, table => $qualified_table,
}; };
MKDEBUG && _d("Table usage from TLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from TLIST:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
if ( $where && $where->{joined_tables} ) { if ( $where && $where->{joined_tables} ) {
foreach my $joined_table ( @{$where->{joined_tables}} ) { foreach my $joined_table ( @{$where->{joined_tables}} ) {
MKDEBUG && _d("Table joined implicitly in WHERE:", $joined_table); PTDEBUG && _d("Table joined implicitly in WHERE:", $joined_table);
$self->_change_context( $self->_change_context(
tables => $tables, tables => $tables,
table => $joined_table, table => $joined_table,
@@ -4086,7 +4086,7 @@ sub _get_tables_used_from_query_struct {
if ( $query_type =~ m/(?:INSERT|REPLACE)/ ) { if ( $query_type =~ m/(?:INSERT|REPLACE)/ ) {
if ( $query_struct->{select} ) { if ( $query_struct->{select} ) {
MKDEBUG && _d("Getting tables used in INSERT-SELECT"); PTDEBUG && _d("Getting tables used in INSERT-SELECT");
my $select_tables = $self->_get_tables_used_from_query_struct( my $select_tables = $self->_get_tables_used_from_query_struct(
%args, %args,
query_struct => $query_struct->{select}, query_struct => $query_struct->{select},
@@ -4098,7 +4098,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT', context => 'SELECT',
table => $self->{constant_data_value}, table => $self->{constant_data_value},
}; };
MKDEBUG && _d("Table usage from SET/VALUES:", Dumper($table_usage)); PTDEBUG && _d("Table usage from SET/VALUES:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -4114,7 +4114,7 @@ sub _get_tables_used_from_query_struct {
table => $table->{value_is_table} ? $table->{table} table => $table->{value_is_table} ? $table->{table}
: $self->{constant_data_value}, : $self->{constant_data_value},
}; };
MKDEBUG && _d("Table usage from SET:", Dumper($table_usage)); PTDEBUG && _d("Table usage from SET:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -4125,7 +4125,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE', context => 'WHERE',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE:", Dumper($table_usage)); PTDEBUG && _d("Table usage from WHERE:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -4142,11 +4142,11 @@ sub _get_tables_used_in_columns {
} }
my ($tables, $columns) = @args{@required_args}; my ($tables, $columns) = @args{@required_args};
MKDEBUG && _d("Getting tables used in CLIST"); PTDEBUG && _d("Getting tables used in CLIST");
my @tables; my @tables;
my $ambig = 0; # found any ambiguous columns? my $ambig = 0; # found any ambiguous columns?
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
MKDEBUG && _d("Single table SELECT:", $tables->[0]->{tbl}); PTDEBUG && _d("Single table SELECT:", $tables->[0]->{tbl});
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
db => $tables->[0]->{db}, db => $tables->[0]->{db},
@@ -4156,7 +4156,7 @@ sub _get_tables_used_in_columns {
} }
elsif ( @$columns == 1 && $columns->[0]->{col} eq '*' ) { elsif ( @$columns == 1 && $columns->[0]->{col} eq '*' ) {
if ( $columns->[0]->{tbl} ) { if ( $columns->[0]->{tbl} ) {
MKDEBUG && _d("SELECT all columns from one table"); PTDEBUG && _d("SELECT all columns from one table");
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
db => $columns->[0]->{db}, db => $columns->[0]->{db},
@@ -4165,7 +4165,7 @@ sub _get_tables_used_in_columns {
@tables = ($table); @tables = ($table);
} }
else { else {
MKDEBUG && _d("SELECT all columns from all tables"); PTDEBUG && _d("SELECT all columns from all tables");
foreach my $table ( @$tables ) { foreach my $table ( @$tables ) {
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
@@ -4178,14 +4178,14 @@ sub _get_tables_used_in_columns {
} }
} }
else { else {
MKDEBUG && _d(scalar @$tables, "table SELECT"); PTDEBUG && _d(scalar @$tables, "table SELECT");
my %seen; my %seen;
my $colno = 0; my $colno = 0;
COLUMN: COLUMN:
foreach my $column ( @$columns ) { foreach my $column ( @$columns ) {
MKDEBUG && _d('Getting table for column', Dumper($column)); PTDEBUG && _d('Getting table for column', Dumper($column));
if ( $column->{col} eq '*' && !$column->{tbl} ) { if ( $column->{col} eq '*' && !$column->{tbl} ) {
MKDEBUG && _d('Ignoring FUNC(*) column'); PTDEBUG && _d('Ignoring FUNC(*) column');
$colno++; $colno++;
next; next;
} }
@@ -4195,7 +4195,7 @@ sub _get_tables_used_in_columns {
n_cols => scalar @$columns, n_cols => scalar @$columns,
); );
if ( !$column->{tbl} ) { if ( !$column->{tbl} ) {
MKDEBUG && _d("Column", $column->{col}, "is not table-qualified;", PTDEBUG && _d("Column", $column->{col}, "is not table-qualified;",
"and query has multiple tables; cannot determine its table"); "and query has multiple tables; cannot determine its table");
$ambig++; $ambig++;
next COLUMN; next COLUMN;
@@ -4222,14 +4222,14 @@ sub _get_tables_used_in_where {
my ($tables, $where) = @args{@required_args}; my ($tables, $where) = @args{@required_args};
my $sql_parser = $self->{SQLParser}; my $sql_parser = $self->{SQLParser};
MKDEBUG && _d("Getting tables used in", $args{clause} || 'WHERE'); PTDEBUG && _d("Getting tables used in", $args{clause} || 'WHERE');
my %filter_tables; my %filter_tables;
my %join_tables; my %join_tables;
my $ambig = 0; # found any ambiguous tables? my $ambig = 0; # found any ambiguous tables?
CONDITION: CONDITION:
foreach my $cond ( @$where ) { foreach my $cond ( @$where ) {
MKDEBUG && _d("Condition:", Dumper($cond)); PTDEBUG && _d("Condition:", Dumper($cond));
my @tables; # tables used in this condition my @tables; # tables used in this condition
my $n_vals = 0; my $n_vals = 0;
my $is_constant = 0; my $is_constant = 0;
@@ -4237,13 +4237,13 @@ sub _get_tables_used_in_where {
ARG: ARG:
foreach my $arg ( qw(left_arg right_arg) ) { foreach my $arg ( qw(left_arg right_arg) ) {
if ( !defined $cond->{$arg} ) { if ( !defined $cond->{$arg} ) {
MKDEBUG && _d($arg, "is a constant value"); PTDEBUG && _d($arg, "is a constant value");
$is_constant = 1; $is_constant = 1;
next ARG; next ARG;
} }
if ( $sql_parser->is_identifier($cond->{$arg}) ) { if ( $sql_parser->is_identifier($cond->{$arg}) ) {
MKDEBUG && _d($arg, "is an identifier"); PTDEBUG && _d($arg, "is an identifier");
my $ident_struct = $sql_parser->parse_identifier( my $ident_struct = $sql_parser->parse_identifier(
'column', 'column',
$cond->{$arg} $cond->{$arg}
@@ -4254,12 +4254,12 @@ sub _get_tables_used_in_where {
); );
if ( !$ident_struct->{tbl} ) { if ( !$ident_struct->{tbl} ) {
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
MKDEBUG && _d("Condition column is not table-qualified; ", PTDEBUG && _d("Condition column is not table-qualified; ",
"using query's only table:", $tables->[0]->{tbl}); "using query's only table:", $tables->[0]->{tbl});
$ident_struct->{tbl} = $tables->[0]->{tbl}; $ident_struct->{tbl} = $tables->[0]->{tbl};
} }
else { else {
MKDEBUG && _d("Condition column is not table-qualified and", PTDEBUG && _d("Condition column is not table-qualified and",
"query has multiple tables; cannot determine its table"); "query has multiple tables; cannot determine its table");
if ( $cond->{$arg} !~ m/\w+\(/ # not a function if ( $cond->{$arg} !~ m/\w+\(/ # not a function
&& $cond->{$arg} !~ m/^[\d.]+$/) { # not a number && $cond->{$arg} !~ m/^[\d.]+$/) { # not a number
@@ -4271,7 +4271,7 @@ sub _get_tables_used_in_where {
} }
if ( !$ident_struct->{db} && @$tables == 1 && $tables->[0]->{db} ) { if ( !$ident_struct->{db} && @$tables == 1 && $tables->[0]->{db} ) {
MKDEBUG && _d("Condition column is not database-qualified; ", PTDEBUG && _d("Condition column is not database-qualified; ",
"using its table's database:", $tables->[0]->{db}); "using its table's database:", $tables->[0]->{db});
$ident_struct->{db} = $tables->[0]->{db}; $ident_struct->{db} = $tables->[0]->{db};
} }
@@ -4285,29 +4285,29 @@ sub _get_tables_used_in_where {
} }
} }
else { else {
MKDEBUG && _d($arg, "is a value"); PTDEBUG && _d($arg, "is a value");
$n_vals++; $n_vals++;
} }
} # ARG } # ARG
if ( $is_constant || $n_vals == 2 ) { if ( $is_constant || $n_vals == 2 ) {
MKDEBUG && _d("Condition is a constant or two values"); PTDEBUG && _d("Condition is a constant or two values");
$filter_tables{$self->{constant_data_value}} = undef; $filter_tables{$self->{constant_data_value}} = undef;
} }
else { else {
if ( @tables == 1 ) { if ( @tables == 1 ) {
if ( $unknown_table ) { if ( $unknown_table ) {
MKDEBUG && _d("Condition joins table", PTDEBUG && _d("Condition joins table",
$tables[0], "to column from unknown table"); $tables[0], "to column from unknown table");
$join_tables{$tables[0]} = undef; $join_tables{$tables[0]} = undef;
} }
else { else {
MKDEBUG && _d("Condition filters table", $tables[0]); PTDEBUG && _d("Condition filters table", $tables[0]);
$filter_tables{$tables[0]} = undef; $filter_tables{$tables[0]} = undef;
} }
} }
elsif ( @tables == 2 ) { elsif ( @tables == 2 ) {
MKDEBUG && _d("Condition joins tables", PTDEBUG && _d("Condition joins tables",
$tables[0], "and", $tables[1]); $tables[0], "and", $tables[1]);
$join_tables{$tables[0]} = undef; $join_tables{$tables[0]} = undef;
$join_tables{$tables[1]} = undef; $join_tables{$tables[1]} = undef;
@@ -4333,7 +4333,7 @@ sub _get_tables_used_in_set {
my ($tables, $set) = @args{@required_args}; my ($tables, $set) = @args{@required_args};
my $sql_parser = $self->{SQLParser}; my $sql_parser = $self->{SQLParser};
MKDEBUG && _d("Getting tables used in SET"); PTDEBUG && _d("Getting tables used in SET");
my @tables; my @tables;
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
@@ -4394,11 +4394,11 @@ sub _get_real_table_name {
foreach my $table ( @$tables ) { foreach my $table ( @$tables ) {
if ( lc($table->{tbl}) eq $name if ( lc($table->{tbl}) eq $name
|| lc($table->{alias} || "") eq $name ) { || lc($table->{alias} || "") eq $name ) {
MKDEBUG && _d("Real table name for", $name, "is", $table->{tbl}); PTDEBUG && _d("Real table name for", $name, "is", $table->{tbl});
return $table->{tbl}; return $table->{tbl};
} }
} }
MKDEBUG && _d("Table", $name, "does not exist in query"); PTDEBUG && _d("Table", $name, "does not exist in query");
return; return;
} }
@@ -4410,7 +4410,7 @@ sub _qualify_table_name {
} }
my ($tables, $table) = @args{@required_args}; my ($tables, $table) = @args{@required_args};
MKDEBUG && _d("Qualifying table with database:", $table); PTDEBUG && _d("Qualifying table with database:", $table);
my ($tbl, $db) = reverse split /[.]/, $table; my ($tbl, $db) = reverse split /[.]/, $table;
@@ -4442,12 +4442,12 @@ sub _qualify_table_name {
} }
if ( !$db_tbl ) { if ( !$db_tbl ) {
MKDEBUG && _d("Cannot determine database for table", $tbl); PTDEBUG && _d("Cannot determine database for table", $tbl);
$db_tbl = $tbl; $db_tbl = $tbl;
} }
} }
MKDEBUG && _d("Table qualified with database:", $db_tbl); PTDEBUG && _d("Table qualified with database:", $db_tbl);
return $db_tbl; return $db_tbl;
} }
@@ -4458,7 +4458,7 @@ sub _change_context {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($tables_used, $table, $old_context, $new_context) = @args{@required_args}; my ($tables_used, $table, $old_context, $new_context) = @args{@required_args};
MKDEBUG && _d("Change context of table", $table, "from", $old_context, PTDEBUG && _d("Change context of table", $table, "from", $old_context,
"to", $new_context); "to", $new_context);
foreach my $used_table ( @$tables_used ) { foreach my $used_table ( @$tables_used ) {
if ( $used_table->{table} eq $table if ( $used_table->{table} eq $table
@@ -4467,7 +4467,7 @@ sub _change_context {
return; return;
} }
} }
MKDEBUG && _d("Table", $table, "is not used; cannot set its context"); PTDEBUG && _d("Table", $table, "is not used; cannot set its context");
return; return;
} }
@@ -4478,18 +4478,18 @@ sub _explain_query {
my $sql; my $sql;
if ( $db ) { if ( $db ) {
$sql = "USE `$db`"; $sql = "USE `$db`";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
$dbh->do($sql); $dbh->do($sql);
} }
$sql = "EXPLAIN EXTENDED $query"; $sql = "EXPLAIN EXTENDED $query";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { eval {
$dbh->do($sql); # don't need the result $dbh->do($sql); # don't need the result
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
if ( $EVAL_ERROR =~ m/No database/i ) { if ( $EVAL_ERROR =~ m/No database/i ) {
MKDEBUG && _d($EVAL_ERROR); PTDEBUG && _d($EVAL_ERROR);
push @{$self->{errors}}, 'NO_DB_SELECTED'; push @{$self->{errors}}, 'NO_DB_SELECTED';
return; return;
} }
@@ -4497,9 +4497,9 @@ sub _explain_query {
} }
$sql = "SHOW WARNINGS"; $sql = "SHOW WARNINGS";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my $warning = $dbh->selectrow_hashref($sql); my $warning = $dbh->selectrow_hashref($sql);
MKDEBUG && _d(Dumper($warning)); PTDEBUG && _d(Dumper($warning));
if ( ($warning->{level} || "") !~ m/Note/i if ( ($warning->{level} || "") !~ m/Note/i
|| ($warning->{code} || 0) != 1003 ) { || ($warning->{code} || 0) != 1003 ) {
die "EXPLAIN EXTENDED failed:\n" die "EXPLAIN EXTENDED failed:\n"
@@ -4527,7 +4527,7 @@ sub _reparse_query {
my ($self, %args) = @_; my ($self, %args) = @_;
my @required_args = qw(query query_struct); my @required_args = qw(query query_struct);
my ($query, $query_struct) = @args{@required_args}; my ($query, $query_struct) = @args{@required_args};
MKDEBUG && _d("Reparsing query with EXPLAIN EXTENDED"); PTDEBUG && _d("Reparsing query with EXPLAIN EXTENDED");
$self->{query_reparsed} = 1; $self->{query_reparsed} = 1;
@@ -4571,7 +4571,7 @@ sub _ex_qualify_column {
return $col unless $self->{ex_query_struct}; return $col unless $self->{ex_query_struct};
my $ex = $self->{ex_query_struct}; my $ex = $self->{ex_query_struct};
MKDEBUG && _d('Qualifying column',$col->{col},'with EXPLAIN EXTENDED query'); PTDEBUG && _d('Qualifying column',$col->{col},'with EXPLAIN EXTENDED query');
return unless $col; return unless $col;
@@ -4581,7 +4581,7 @@ sub _ex_qualify_column {
if ( !$col->{tbl} ) { if ( !$col->{tbl} ) {
if ( $where_arg ) { if ( $where_arg ) {
MKDEBUG && _d('Searching WHERE conditions for column'); PTDEBUG && _d('Searching WHERE conditions for column');
CONDITION: CONDITION:
foreach my $cond ( @{$ex->{where}} ) { foreach my $cond ( @{$ex->{where}} ) {
if ( defined $cond->{$where_arg} if ( defined $cond->{$where_arg}
@@ -4604,16 +4604,16 @@ sub _ex_qualify_column {
elsif ( defined $colno elsif ( defined $colno
&& $ex->{columns}->[$colno] && $ex->{columns}->[$colno]
&& lc($ex->{columns}->[$colno]->{col}) eq $colname ) { && lc($ex->{columns}->[$colno]->{col}) eq $colname ) {
MKDEBUG && _d('Exact match by col name and number'); PTDEBUG && _d('Exact match by col name and number');
$col = $ex->{columns}->[$colno]; $col = $ex->{columns}->[$colno];
} }
elsif ( defined $colno elsif ( defined $colno
&& scalar @{$ex->{columns}} == $n_cols ) { && scalar @{$ex->{columns}} == $n_cols ) {
MKDEBUG && _d('Match by column number in CLIST'); PTDEBUG && _d('Match by column number in CLIST');
$col = $ex->{columns}->[$colno]; $col = $ex->{columns}->[$colno];
} }
else { else {
MKDEBUG && _d('Searching for unique column in every db.tbl'); PTDEBUG && _d('Searching for unique column in every db.tbl');
my ($uniq_db, $uniq_tbl); my ($uniq_db, $uniq_tbl);
my $colcnt = 0; my $colcnt = 0;
my $schemas = $self->{schemas}; my $schemas = $self->{schemas};
@@ -4636,14 +4636,14 @@ sub _ex_qualify_column {
} }
if ( !$col->{db} && $col->{tbl} ) { if ( !$col->{db} && $col->{tbl} ) {
MKDEBUG && _d('Column has table, needs db'); PTDEBUG && _d('Column has table, needs db');
if ( my $real_tbl = $self->{table_for}->{lc $col->{tbl}} ) { if ( my $real_tbl = $self->{table_for}->{lc $col->{tbl}} ) {
MKDEBUG && _d('Table is an alias'); PTDEBUG && _d('Table is an alias');
$col->{db} = $real_tbl->{db}; $col->{db} = $real_tbl->{db};
$col->{tbl} = $real_tbl->{tbl}; $col->{tbl} = $real_tbl->{tbl};
} }
else { else {
MKDEBUG && _d('Searching for unique table in every db'); PTDEBUG && _d('Searching for unique table in every db');
my $real_tbl = $self->_get_real_table_name( my $real_tbl = $self->_get_real_table_name(
tables => $ex->{from}, tables => $ex->{from},
name => $col->{tbl}, name => $col->{tbl},
@@ -4668,7 +4668,7 @@ sub _ex_qualify_column {
} }
} }
MKDEBUG && _d('Qualified column:', Dumper($col)); PTDEBUG && _d('Qualified column:', Dumper($col));
return $col; return $col;
} }

2
lib/DiskstatsGroupByAll.pm
View File

@@ -26,7 +26,7 @@ package DiskstatsGroupByAll;
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats ); use base qw( Diskstats );

2
lib/DiskstatsGroupByDisk.pm
View File

@@ -26,7 +26,7 @@ package DiskstatsGroupByDisk;
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats ); use base qw( Diskstats );

2
lib/ReadKeyMini.pm
View File

@@ -37,7 +37,7 @@ BEGIN { $INC{"ReadKeyMini.pm"} ||= 1 }
use warnings; use warnings;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw( :termios_h ); use POSIX qw( :termios_h );
use Fcntl qw( F_SETFL F_GETFL ); use Fcntl qw( F_SETFL F_GETFL );

146
lib/TableUsage.pm
View File

@@ -40,7 +40,7 @@ $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0; $Data::Dumper::Quotekeys = 0;
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# Sub: new # Sub: new
# #
@@ -103,7 +103,7 @@ sub get_table_usage {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($query) = @args{@required_args}; my ($query) = @args{@required_args};
MKDEBUG && _d('Getting table access for', PTDEBUG && _d('Getting table access for',
substr($query, 0, 100), (length $query > 100 ? '...' : '')); substr($query, 0, 100), (length $query > 100 ? '...' : ''));
$self->{errors} = []; $self->{errors} = [];
@@ -121,7 +121,7 @@ sub get_table_usage {
$query_struct = $self->{SQLParser}->parse($query); $query_struct = $self->{SQLParser}->parse($query);
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
MKDEBUG && _d('Failed to parse query with SQLParser:', $EVAL_ERROR); PTDEBUG && _d('Failed to parse query with SQLParser:', $EVAL_ERROR);
if ( $EVAL_ERROR =~ m/Cannot parse/ ) { if ( $EVAL_ERROR =~ m/Cannot parse/ ) {
# SQLParser can't parse this type of query, so it's probably some # SQLParser can't parse this type of query, so it's probably some
# data definition statement with just a table list. Use QueryParser # data definition statement with just a table list. Use QueryParser
@@ -142,7 +142,7 @@ sub get_table_usage {
); );
} }
MKDEBUG && _d('Query table usage:', Dumper($tables)); PTDEBUG && _d('Query table usage:', Dumper($tables));
return $tables; return $tables;
} }
@@ -158,7 +158,7 @@ sub _get_tables_used_from_query_parser {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($query) = @args{@required_args}; my ($query) = @args{@required_args};
MKDEBUG && _d('Getting tables used from query parser'); PTDEBUG && _d('Getting tables used from query parser');
$query = $self->{QueryParser}->clean_query($query); $query = $self->{QueryParser}->clean_query($query);
my ($query_type) = $query =~ m/^\s*(\w+)\s+/; my ($query_type) = $query =~ m/^\s*(\w+)\s+/;
@@ -193,15 +193,15 @@ sub _get_tables_used_from_query_struct {
} }
my ($query_struct) = @args{@required_args}; my ($query_struct) = @args{@required_args};
MKDEBUG && _d('Getting table used from query struct'); PTDEBUG && _d('Getting table used from query struct');
my $query_type = uc $query_struct->{type}; my $query_type = uc $query_struct->{type};
if ( $query_type eq 'CREATE' ) { if ( $query_type eq 'CREATE' ) {
MKDEBUG && _d('CREATE query'); PTDEBUG && _d('CREATE query');
my $sel_tables; my $sel_tables;
if ( my $sq_struct = $query_struct->{subqueries}->[0] ) { if ( my $sq_struct = $query_struct->{subqueries}->[0] ) {
MKDEBUG && _d('CREATE query with SELECT'); PTDEBUG && _d('CREATE query with SELECT');
$sel_tables = $self->_get_tables_used_from_query_struct( $sel_tables = $self->_get_tables_used_from_query_struct(
%args, %args,
query => $sq_struct->{query}, query => $sq_struct->{query},
@@ -221,7 +221,7 @@ sub _get_tables_used_from_query_struct {
my $tables = $self->_get_tables($query_struct); my $tables = $self->_get_tables($query_struct);
if ( !$tables || @$tables == 0 ) { if ( !$tables || @$tables == 0 ) {
MKDEBUG && _d("Query does not use any tables"); PTDEBUG && _d("Query does not use any tables");
return [ return [
[ { context => $query_type, table => $self->{constant_data_value} } ] [ { context => $query_type, table => $self->{constant_data_value} } ]
]; ];
@@ -237,17 +237,17 @@ sub _get_tables_used_from_query_struct {
); );
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns"); PTDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
} }
my @tables_used; my @tables_used;
if ( $query_type eq 'UPDATE' && @{$query_struct->{tables}} > 1 ) { if ( $query_type eq 'UPDATE' && @{$query_struct->{tables}} > 1 ) {
MKDEBUG && _d("Multi-table UPDATE"); PTDEBUG && _d("Multi-table UPDATE");
# UPDATE queries with multiple tables are a special case. The query # UPDATE queries with multiple tables are a special case. The query
# reads from each referenced table and writes only to tables referenced # reads from each referenced table and writes only to tables referenced
# in the SET clause. Each written table is like its own query, so # in the SET clause. Each written table is like its own query, so
@@ -265,7 +265,7 @@ sub _get_tables_used_from_query_struct {
context => 'JOIN', context => 'JOIN',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from TLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from TLIST:", Dumper($table_usage));
push @join_tables, $table_usage; push @join_tables, $table_usage;
} }
if ( $where && $where->{joined_tables} ) { if ( $where && $where->{joined_tables} ) {
@@ -274,7 +274,7 @@ sub _get_tables_used_from_query_struct {
context => $query_type, context => $query_type,
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE (implicit join):", PTDEBUG && _d("Table usage from WHERE (implicit join):",
Dumper($table_usage)); Dumper($table_usage));
push @join_tables, $table_usage; push @join_tables, $table_usage;
} }
@@ -287,7 +287,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE', context => 'WHERE',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE:", Dumper($table_usage)); PTDEBUG && _d("Table usage from WHERE:", Dumper($table_usage));
push @where_tables, $table_usage; push @where_tables, $table_usage;
} }
} }
@@ -308,7 +308,7 @@ sub _get_tables_used_from_query_struct {
table => $table->{value}, table => $table->{value},
}, },
); );
MKDEBUG && _d("Table usage from UPDATE SET:", Dumper(\@table_usage)); PTDEBUG && _d("Table usage from UPDATE SET:", Dumper(\@table_usage));
push @tables_used, [ push @tables_used, [
@table_usage, @table_usage,
@join_tables, @join_tables,
@@ -329,11 +329,11 @@ sub _get_tables_used_from_query_struct {
); );
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns"); PTDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
foreach my $table ( @$clist_tables ) { foreach my $table ( @$clist_tables ) {
@@ -341,7 +341,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT', context => 'SELECT',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from CLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from CLIST:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -360,7 +360,7 @@ sub _get_tables_used_from_query_struct {
if ( $table->{join} && $table->{join}->{condition} ) { if ( $table->{join} && $table->{join}->{condition} ) {
$context = 'JOIN'; $context = 'JOIN';
if ( $table->{join}->{condition} eq 'using' ) { if ( $table->{join}->{condition} eq 'using' ) {
MKDEBUG && _d("Table joined with USING condition"); PTDEBUG && _d("Table joined with USING condition");
my $joined_table = $self->_qualify_table_name( my $joined_table = $self->_qualify_table_name(
%args, %args,
tables => $tables, tables => $tables,
@@ -375,22 +375,22 @@ sub _get_tables_used_from_query_struct {
); );
} }
elsif ( $table->{join}->{condition} eq 'on' ) { elsif ( $table->{join}->{condition} eq 'on' ) {
MKDEBUG && _d("Table joined with ON condition"); PTDEBUG && _d("Table joined with ON condition");
my ($on_tables, $ambig) = $self->_get_tables_used_in_where( my ($on_tables, $ambig) = $self->_get_tables_used_in_where(
%args, %args,
tables => $tables, tables => $tables,
where => $table->{join}->{where}, where => $table->{join}->{where},
clause => 'JOIN condition', # just for debugging clause => 'JOIN condition', # just for debugging
); );
MKDEBUG && _d("JOIN ON tables:", Dumper($on_tables)); PTDEBUG && _d("JOIN ON tables:", Dumper($on_tables));
if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) { if ( $ambig && $self->{dbh} && !$self->{query_reparsed} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED", PTDEBUG && _d("Using EXPLAIN EXTENDED",
"to disambiguate columns"); "to disambiguate columns");
if ( $self->_reparse_query(%args) ) { if ( $self->_reparse_query(%args) ) {
return $self->_get_tables_used_from_query_struct(%args); return $self->_get_tables_used_from_query_struct(%args);
} }
MKDEBUG && _d('Failed to disambiguate columns'); PTDEBUG && _d('Failed to disambiguate columns');
} }
foreach my $joined_table ( @{$on_tables->{joined_tables}} ) { foreach my $joined_table ( @{$on_tables->{joined_tables}} ) {
@@ -412,14 +412,14 @@ sub _get_tables_used_from_query_struct {
context => $context, context => $context,
table => $qualified_table, table => $qualified_table,
}; };
MKDEBUG && _d("Table usage from TLIST:", Dumper($table_usage)); PTDEBUG && _d("Table usage from TLIST:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
if ( $where && $where->{joined_tables} ) { if ( $where && $where->{joined_tables} ) {
foreach my $joined_table ( @{$where->{joined_tables}} ) { foreach my $joined_table ( @{$where->{joined_tables}} ) {
MKDEBUG && _d("Table joined implicitly in WHERE:", $joined_table); PTDEBUG && _d("Table joined implicitly in WHERE:", $joined_table);
$self->_change_context( $self->_change_context(
tables => $tables, tables => $tables,
table => $joined_table, table => $joined_table,
@@ -432,7 +432,7 @@ sub _get_tables_used_from_query_struct {
if ( $query_type =~ m/(?:INSERT|REPLACE)/ ) { if ( $query_type =~ m/(?:INSERT|REPLACE)/ ) {
if ( $query_struct->{select} ) { if ( $query_struct->{select} ) {
MKDEBUG && _d("Getting tables used in INSERT-SELECT"); PTDEBUG && _d("Getting tables used in INSERT-SELECT");
my $select_tables = $self->_get_tables_used_from_query_struct( my $select_tables = $self->_get_tables_used_from_query_struct(
%args, %args,
query_struct => $query_struct->{select}, query_struct => $query_struct->{select},
@@ -444,7 +444,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT', context => 'SELECT',
table => $self->{constant_data_value}, table => $self->{constant_data_value},
}; };
MKDEBUG && _d("Table usage from SET/VALUES:", Dumper($table_usage)); PTDEBUG && _d("Table usage from SET/VALUES:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -460,7 +460,7 @@ sub _get_tables_used_from_query_struct {
table => $table->{value_is_table} ? $table->{table} table => $table->{value_is_table} ? $table->{table}
: $self->{constant_data_value}, : $self->{constant_data_value},
}; };
MKDEBUG && _d("Table usage from SET:", Dumper($table_usage)); PTDEBUG && _d("Table usage from SET:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -471,7 +471,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE', context => 'WHERE',
table => $table, table => $table,
}; };
MKDEBUG && _d("Table usage from WHERE:", Dumper($table_usage)); PTDEBUG && _d("Table usage from WHERE:", Dumper($table_usage));
push @{$tables_used[0]}, $table_usage; push @{$tables_used[0]}, $table_usage;
} }
} }
@@ -488,13 +488,13 @@ sub _get_tables_used_in_columns {
} }
my ($tables, $columns) = @args{@required_args}; my ($tables, $columns) = @args{@required_args};
MKDEBUG && _d("Getting tables used in CLIST"); PTDEBUG && _d("Getting tables used in CLIST");
my @tables; my @tables;
my $ambig = 0; # found any ambiguous columns? my $ambig = 0; # found any ambiguous columns?
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
# SELECT a, b FROM t WHERE ... -- one table so cols a and b must # SELECT a, b FROM t WHERE ... -- one table so cols a and b must
# be from that table. # be from that table.
MKDEBUG && _d("Single table SELECT:", $tables->[0]->{tbl}); PTDEBUG && _d("Single table SELECT:", $tables->[0]->{tbl});
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
db => $tables->[0]->{db}, db => $tables->[0]->{db},
@@ -505,7 +505,7 @@ sub _get_tables_used_in_columns {
elsif ( @$columns == 1 && $columns->[0]->{col} eq '*' ) { elsif ( @$columns == 1 && $columns->[0]->{col} eq '*' ) {
if ( $columns->[0]->{tbl} ) { if ( $columns->[0]->{tbl} ) {
# SELECT t1.* FROM ... -- selecting only from table t1 # SELECT t1.* FROM ... -- selecting only from table t1
MKDEBUG && _d("SELECT all columns from one table"); PTDEBUG && _d("SELECT all columns from one table");
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
db => $columns->[0]->{db}, db => $columns->[0]->{db},
@@ -515,7 +515,7 @@ sub _get_tables_used_in_columns {
} }
else { else {
# SELECT * FROM ... -- selecting from all tables # SELECT * FROM ... -- selecting from all tables
MKDEBUG && _d("SELECT all columns from all tables"); PTDEBUG && _d("SELECT all columns from all tables");
foreach my $table ( @$tables ) { foreach my $table ( @$tables ) {
my $table = $self->_qualify_table_name( my $table = $self->_qualify_table_name(
%args, %args,
@@ -530,14 +530,14 @@ sub _get_tables_used_in_columns {
else { else {
# SELECT x, y FROM t1, t2 -- have to determine from which table each # SELECT x, y FROM t1, t2 -- have to determine from which table each
# column is. # column is.
MKDEBUG && _d(scalar @$tables, "table SELECT"); PTDEBUG && _d(scalar @$tables, "table SELECT");
my %seen; my %seen;
my $colno = 0; my $colno = 0;
COLUMN: COLUMN:
foreach my $column ( @$columns ) { foreach my $column ( @$columns ) {
MKDEBUG && _d('Getting table for column', Dumper($column)); PTDEBUG && _d('Getting table for column', Dumper($column));
if ( $column->{col} eq '*' && !$column->{tbl} ) { if ( $column->{col} eq '*' && !$column->{tbl} ) {
MKDEBUG && _d('Ignoring FUNC(*) column'); PTDEBUG && _d('Ignoring FUNC(*) column');
$colno++; $colno++;
next; next;
} }
@@ -547,7 +547,7 @@ sub _get_tables_used_in_columns {
n_cols => scalar @$columns, n_cols => scalar @$columns,
); );
if ( !$column->{tbl} ) { if ( !$column->{tbl} ) {
MKDEBUG && _d("Column", $column->{col}, "is not table-qualified;", PTDEBUG && _d("Column", $column->{col}, "is not table-qualified;",
"and query has multiple tables; cannot determine its table"); "and query has multiple tables; cannot determine its table");
$ambig++; $ambig++;
next COLUMN; next COLUMN;
@@ -574,14 +574,14 @@ sub _get_tables_used_in_where {
my ($tables, $where) = @args{@required_args}; my ($tables, $where) = @args{@required_args};
my $sql_parser = $self->{SQLParser}; my $sql_parser = $self->{SQLParser};
MKDEBUG && _d("Getting tables used in", $args{clause} || 'WHERE'); PTDEBUG && _d("Getting tables used in", $args{clause} || 'WHERE');
my %filter_tables; my %filter_tables;
my %join_tables; my %join_tables;
my $ambig = 0; # found any ambiguous tables? my $ambig = 0; # found any ambiguous tables?
CONDITION: CONDITION:
foreach my $cond ( @$where ) { foreach my $cond ( @$where ) {
MKDEBUG && _d("Condition:", Dumper($cond)); PTDEBUG && _d("Condition:", Dumper($cond));
my @tables; # tables used in this condition my @tables; # tables used in this condition
my $n_vals = 0; my $n_vals = 0;
my $is_constant = 0; my $is_constant = 0;
@@ -589,13 +589,13 @@ sub _get_tables_used_in_where {
ARG: ARG:
foreach my $arg ( qw(left_arg right_arg) ) { foreach my $arg ( qw(left_arg right_arg) ) {
if ( !defined $cond->{$arg} ) { if ( !defined $cond->{$arg} ) {
MKDEBUG && _d($arg, "is a constant value"); PTDEBUG && _d($arg, "is a constant value");
$is_constant = 1; $is_constant = 1;
next ARG; next ARG;
} }
if ( $sql_parser->is_identifier($cond->{$arg}) ) { if ( $sql_parser->is_identifier($cond->{$arg}) ) {
MKDEBUG && _d($arg, "is an identifier"); PTDEBUG && _d($arg, "is an identifier");
my $ident_struct = $sql_parser->parse_identifier( my $ident_struct = $sql_parser->parse_identifier(
'column', 'column',
$cond->{$arg} $cond->{$arg}
@@ -606,12 +606,12 @@ sub _get_tables_used_in_where {
); );
if ( !$ident_struct->{tbl} ) { if ( !$ident_struct->{tbl} ) {
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
MKDEBUG && _d("Condition column is not table-qualified; ", PTDEBUG && _d("Condition column is not table-qualified; ",
"using query's only table:", $tables->[0]->{tbl}); "using query's only table:", $tables->[0]->{tbl});
$ident_struct->{tbl} = $tables->[0]->{tbl}; $ident_struct->{tbl} = $tables->[0]->{tbl};
} }
else { else {
MKDEBUG && _d("Condition column is not table-qualified and", PTDEBUG && _d("Condition column is not table-qualified and",
"query has multiple tables; cannot determine its table"); "query has multiple tables; cannot determine its table");
if ( $cond->{$arg} !~ m/\w+\(/ # not a function if ( $cond->{$arg} !~ m/\w+\(/ # not a function
&& $cond->{$arg} !~ m/^[\d.]+$/) { # not a number && $cond->{$arg} !~ m/^[\d.]+$/) { # not a number
@@ -623,7 +623,7 @@ sub _get_tables_used_in_where {
} }
if ( !$ident_struct->{db} && @$tables == 1 && $tables->[0]->{db} ) { if ( !$ident_struct->{db} && @$tables == 1 && $tables->[0]->{db} ) {
MKDEBUG && _d("Condition column is not database-qualified; ", PTDEBUG && _d("Condition column is not database-qualified; ",
"using its table's database:", $tables->[0]->{db}); "using its table's database:", $tables->[0]->{db});
$ident_struct->{db} = $tables->[0]->{db}; $ident_struct->{db} = $tables->[0]->{db};
} }
@@ -637,29 +637,29 @@ sub _get_tables_used_in_where {
} }
} }
else { else {
MKDEBUG && _d($arg, "is a value"); PTDEBUG && _d($arg, "is a value");
$n_vals++; $n_vals++;
} }
} # ARG } # ARG
if ( $is_constant || $n_vals == 2 ) { if ( $is_constant || $n_vals == 2 ) {
MKDEBUG && _d("Condition is a constant or two values"); PTDEBUG && _d("Condition is a constant or two values");
$filter_tables{$self->{constant_data_value}} = undef; $filter_tables{$self->{constant_data_value}} = undef;
} }
else { else {
if ( @tables == 1 ) { if ( @tables == 1 ) {
if ( $unknown_table ) { if ( $unknown_table ) {
MKDEBUG && _d("Condition joins table", PTDEBUG && _d("Condition joins table",
$tables[0], "to column from unknown table"); $tables[0], "to column from unknown table");
$join_tables{$tables[0]} = undef; $join_tables{$tables[0]} = undef;
} }
else { else {
MKDEBUG && _d("Condition filters table", $tables[0]); PTDEBUG && _d("Condition filters table", $tables[0]);
$filter_tables{$tables[0]} = undef; $filter_tables{$tables[0]} = undef;
} }
} }
elsif ( @tables == 2 ) { elsif ( @tables == 2 ) {
MKDEBUG && _d("Condition joins tables", PTDEBUG && _d("Condition joins tables",
$tables[0], "and", $tables[1]); $tables[0], "and", $tables[1]);
$join_tables{$tables[0]} = undef; $join_tables{$tables[0]} = undef;
$join_tables{$tables[1]} = undef; $join_tables{$tables[1]} = undef;
@@ -686,7 +686,7 @@ sub _get_tables_used_in_set {
my ($tables, $set) = @args{@required_args}; my ($tables, $set) = @args{@required_args};
my $sql_parser = $self->{SQLParser}; my $sql_parser = $self->{SQLParser};
MKDEBUG && _d("Getting tables used in SET"); PTDEBUG && _d("Getting tables used in SET");
my @tables; my @tables;
if ( @$tables == 1 ) { if ( @$tables == 1 ) {
@@ -748,13 +748,13 @@ sub _get_real_table_name {
foreach my $table ( @$tables ) { foreach my $table ( @$tables ) {
if ( lc($table->{tbl}) eq $name if ( lc($table->{tbl}) eq $name
|| lc($table->{alias} || "") eq $name ) { || lc($table->{alias} || "") eq $name ) {
MKDEBUG && _d("Real table name for", $name, "is", $table->{tbl}); PTDEBUG && _d("Real table name for", $name, "is", $table->{tbl});
return $table->{tbl}; return $table->{tbl};
} }
} }
# The named thing isn't referenced as a table by the query, so it's # The named thing isn't referenced as a table by the query, so it's
# probably a function or something else. # probably a function or something else.
MKDEBUG && _d("Table", $name, "does not exist in query"); PTDEBUG && _d("Table", $name, "does not exist in query");
return; return;
} }
@@ -766,7 +766,7 @@ sub _qualify_table_name {
} }
my ($tables, $table) = @args{@required_args}; my ($tables, $table) = @args{@required_args};
MKDEBUG && _d("Qualifying table with database:", $table); PTDEBUG && _d("Qualifying table with database:", $table);
my ($tbl, $db) = reverse split /[.]/, $table; my ($tbl, $db) = reverse split /[.]/, $table;
@@ -804,12 +804,12 @@ sub _qualify_table_name {
# Can't db-qualify the table, so return just the real table name. # Can't db-qualify the table, so return just the real table name.
if ( !$db_tbl ) { if ( !$db_tbl ) {
MKDEBUG && _d("Cannot determine database for table", $tbl); PTDEBUG && _d("Cannot determine database for table", $tbl);
$db_tbl = $tbl; $db_tbl = $tbl;
} }
} }
MKDEBUG && _d("Table qualified with database:", $db_tbl); PTDEBUG && _d("Table qualified with database:", $db_tbl);
return $db_tbl; return $db_tbl;
} }
@@ -820,7 +820,7 @@ sub _change_context {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
} }
my ($tables_used, $table, $old_context, $new_context) = @args{@required_args}; my ($tables_used, $table, $old_context, $new_context) = @args{@required_args};
MKDEBUG && _d("Change context of table", $table, "from", $old_context, PTDEBUG && _d("Change context of table", $table, "from", $old_context,
"to", $new_context); "to", $new_context);
foreach my $used_table ( @$tables_used ) { foreach my $used_table ( @$tables_used ) {
if ( $used_table->{table} eq $table if ( $used_table->{table} eq $table
@@ -829,7 +829,7 @@ sub _change_context {
return; return;
} }
} }
MKDEBUG && _d("Table", $table, "is not used; cannot set its context"); PTDEBUG && _d("Table", $table, "is not used; cannot set its context");
return; return;
} }
@@ -840,18 +840,18 @@ sub _explain_query {
my $sql; my $sql;
if ( $db ) { if ( $db ) {
$sql = "USE `$db`"; $sql = "USE `$db`";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
$dbh->do($sql); $dbh->do($sql);
} }
$sql = "EXPLAIN EXTENDED $query"; $sql = "EXPLAIN EXTENDED $query";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { eval {
$dbh->do($sql); # don't need the result $dbh->do($sql); # don't need the result
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
if ( $EVAL_ERROR =~ m/No database/i ) { if ( $EVAL_ERROR =~ m/No database/i ) {
MKDEBUG && _d($EVAL_ERROR); PTDEBUG && _d($EVAL_ERROR);
push @{$self->{errors}}, 'NO_DB_SELECTED'; push @{$self->{errors}}, 'NO_DB_SELECTED';
return; return;
} }
@@ -859,9 +859,9 @@ sub _explain_query {
} }
$sql = "SHOW WARNINGS"; $sql = "SHOW WARNINGS";
MKDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my $warning = $dbh->selectrow_hashref($sql); my $warning = $dbh->selectrow_hashref($sql);
MKDEBUG && _d(Dumper($warning)); PTDEBUG && _d(Dumper($warning));
if ( ($warning->{level} || "") !~ m/Note/i if ( ($warning->{level} || "") !~ m/Note/i
|| ($warning->{code} || 0) != 1003 ) { || ($warning->{code} || 0) != 1003 ) {
die "EXPLAIN EXTENDED failed:\n" die "EXPLAIN EXTENDED failed:\n"
@@ -890,7 +890,7 @@ sub _reparse_query {
my ($self, %args) = @_; my ($self, %args) = @_;
my @required_args = qw(query query_struct); my @required_args = qw(query query_struct);
my ($query, $query_struct) = @args{@required_args}; my ($query, $query_struct) = @args{@required_args};
MKDEBUG && _d("Reparsing query with EXPLAIN EXTENDED"); PTDEBUG && _d("Reparsing query with EXPLAIN EXTENDED");
# Set this first so if there's an error we won't re-explain, # Set this first so if there's an error we won't re-explain,
# re-error, and repeat. # re-error, and repeat.
@@ -938,7 +938,7 @@ sub _ex_qualify_column {
return $col unless $self->{ex_query_struct}; return $col unless $self->{ex_query_struct};
my $ex = $self->{ex_query_struct}; my $ex = $self->{ex_query_struct};
MKDEBUG && _d('Qualifying column',$col->{col},'with EXPLAIN EXTENDED query'); PTDEBUG && _d('Qualifying column',$col->{col},'with EXPLAIN EXTENDED query');
# Nothing to qualify. # Nothing to qualify.
return unless $col; return unless $col;
@@ -950,7 +950,7 @@ sub _ex_qualify_column {
if ( !$col->{tbl} ) { if ( !$col->{tbl} ) {
if ( $where_arg ) { if ( $where_arg ) {
MKDEBUG && _d('Searching WHERE conditions for column'); PTDEBUG && _d('Searching WHERE conditions for column');
# A col in WHERE without a table must be unique in one table, # A col in WHERE without a table must be unique in one table,
# so search for it in the WHERE conditions in the explained # so search for it in the WHERE conditions in the explained
# extended struct. # extended struct.
@@ -976,16 +976,16 @@ sub _ex_qualify_column {
elsif ( defined $colno elsif ( defined $colno
&& $ex->{columns}->[$colno] && $ex->{columns}->[$colno]
&& lc($ex->{columns}->[$colno]->{col}) eq $colname ) { && lc($ex->{columns}->[$colno]->{col}) eq $colname ) {
MKDEBUG && _d('Exact match by col name and number'); PTDEBUG && _d('Exact match by col name and number');
$col = $ex->{columns}->[$colno]; $col = $ex->{columns}->[$colno];
} }
elsif ( defined $colno elsif ( defined $colno
&& scalar @{$ex->{columns}} == $n_cols ) { && scalar @{$ex->{columns}} == $n_cols ) {
MKDEBUG && _d('Match by column number in CLIST'); PTDEBUG && _d('Match by column number in CLIST');
$col = $ex->{columns}->[$colno]; $col = $ex->{columns}->[$colno];
} }
else { else {
MKDEBUG && _d('Searching for unique column in every db.tbl'); PTDEBUG && _d('Searching for unique column in every db.tbl');
my ($uniq_db, $uniq_tbl); my ($uniq_db, $uniq_tbl);
my $colcnt = 0; my $colcnt = 0;
my $schemas = $self->{schemas}; my $schemas = $self->{schemas};
@@ -1008,14 +1008,14 @@ sub _ex_qualify_column {
} }
if ( !$col->{db} && $col->{tbl} ) { if ( !$col->{db} && $col->{tbl} ) {
MKDEBUG && _d('Column has table, needs db'); PTDEBUG && _d('Column has table, needs db');
if ( my $real_tbl = $self->{table_for}->{lc $col->{tbl}} ) { if ( my $real_tbl = $self->{table_for}->{lc $col->{tbl}} ) {
MKDEBUG && _d('Table is an alias'); PTDEBUG && _d('Table is an alias');
$col->{db} = $real_tbl->{db}; $col->{db} = $real_tbl->{db};
$col->{tbl} = $real_tbl->{tbl}; $col->{tbl} = $real_tbl->{tbl};
} }
else { else {
MKDEBUG && _d('Searching for unique table in every db'); PTDEBUG && _d('Searching for unique table in every db');
my $real_tbl = $self->_get_real_table_name( my $real_tbl = $self->_get_real_table_name(
tables => $ex->{from}, tables => $ex->{from},
name => $col->{tbl}, name => $col->{tbl},
@@ -1040,7 +1040,7 @@ sub _ex_qualify_column {
} }
} }
MKDEBUG && _d('Qualified column:', Dumper($col)); PTDEBUG && _d('Qualified column:', Dumper($col));
return $col; return $col;
} }

4
t/lib/samples/pod/mqa-rule-LIT.001.pod
View File

@@ -59,10 +59,10 @@ Print more information.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 VERSION =head1 VERSION

6
t/lib/samples/pod/pod_sample_01.txt
View File

@@ -106,10 +106,10 @@ other negatable.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 SYSTEM REQUIREMENTS =head1 SYSTEM REQUIREMENTS
@@ -128,7 +128,7 @@ support or report bugs: L<http://sourceforge.net/projects/maatkit/>.
Please include the complete command-line used to reproduce the problem you are Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable. running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY =head1 COPYRIGHT, LICENSE AND WARRANTY

6
t/lib/samples/pod/pod_sample_02.txt
View File

@@ -14,10 +14,10 @@ etc.)--those are tested in pod_sample_02.txt.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 SYSTEM REQUIREMENTS =head1 SYSTEM REQUIREMENTS
@@ -36,7 +36,7 @@ support or report bugs: L<http://sourceforge.net/projects/maatkit/>.
Please include the complete command-line used to reproduce the problem you are Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable. running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY =head1 COPYRIGHT, LICENSE AND WARRANTY

6
t/lib/samples/pod/pod_sample_03.txt
View File

@@ -20,10 +20,10 @@ etc.)--those are tested in pod_sample_02.txt.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 SYSTEM REQUIREMENTS =head1 SYSTEM REQUIREMENTS
@@ -42,7 +42,7 @@ support or report bugs: L<http://sourceforge.net/projects/maatkit/>.
Please include the complete command-line used to reproduce the problem you are Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable. running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY =head1 COPYRIGHT, LICENSE AND WARRANTY

6
t/lib/samples/pod/pod_sample_04.txt
View File

@@ -30,10 +30,10 @@ This option also has a description.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 SYSTEM REQUIREMENTS =head1 SYSTEM REQUIREMENTS
@@ -52,7 +52,7 @@ support or report bugs: L<http://sourceforge.net/projects/maatkit/>.
Please include the complete command-line used to reproduce the problem you are Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable. running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY =head1 COPYRIGHT, LICENSE AND WARRANTY

4
t/lib/samples/pod/pod_sample_issue_140.txt
View File

@@ -18,9 +18,9 @@ New negatable bar.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=cut =cut

4
t/lib/samples/pod/pod_sample_mqa.txt
View File

@@ -138,10 +138,10 @@ Print more information.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 VERSION =head1 VERSION

8
t/lib/samples/podsample.txt
View File

@@ -83,7 +83,7 @@ half second. Since the update happens as soon as possible after the beginning
of the second on the master, this allows one half second of replication delay of the second on the master, this allows one half second of replication delay
before reporting that the slave lags the master by one second. If your clocks before reporting that the slave lags the master by one second. If your clocks
are not completely accurate or there is some other reason you'd like to delay are not completely accurate or there is some other reason you'd like to delay
the slave more or less, you can tweak this value. Try setting the C<MKDEBUG> the slave more or less, you can tweak this value. Try setting the C<PTDEBUG>
environment variable to see the effect this has. environment variable to see the effect this has.
=item --verbose =item --verbose
@@ -120,10 +120,10 @@ This item is not part of the main option list and should not be read.
=head1 ENVIRONMENT =head1 ENVIRONMENT
The environment variable C<MKDEBUG> enables verbose debugging output in all of the The environment variable C<PTDEBUG> enables verbose debugging output in all of the
Maatkit tools: Maatkit tools:
MKDEBUG=1 mk-.... PTDEBUG=1 mk-....
=head1 SYSTEM REQUIREMENTS =head1 SYSTEM REQUIREMENTS
@@ -142,7 +142,7 @@ support or report bugs: L<http://sourceforge.net/projects/maatkit/>.
Please include the complete command-line used to reproduce the problem you are Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable. running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY =head1 COPYRIGHT, LICENSE AND WARRANTY

6
t/pt-archiver/samples/bulk_regular_insert.pm
View File

@@ -28,7 +28,7 @@ package bulk_regular_insert;
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG}; use constant PTDEBUG => $ENV{PTDEBUG};
# ########################################################################### # ###########################################################################
# Customize these values for your tables. # Customize these values for your tables.
@@ -96,7 +96,7 @@ sub before_bulk_insert {
$sql .= join(", ", @vals); $sql .= join(", ", @vals);
$sql .= " /* mk-archiver bulk_regular_insert plugin */"; # trace $sql .= " /* mk-archiver bulk_regular_insert plugin */"; # trace
MKDEBUG && _d("Bulk regular insert:", $sql); PTDEBUG && _d("Bulk regular insert:", $sql);
$dbh->do($sql); $dbh->do($sql);
return; return;
@@ -112,7 +112,7 @@ sub custom_sth_bulk {
# called with 1 bind variables when 0 are needed [for Statement "SELECT 1"] # called with 1 bind variables when 0 are needed [for Statement "SELECT 1"]
# at mk-archiver line 4100. # at mk-archiver line 4100.
my $sql = "SELECT ?"; my $sql = "SELECT ?";
MKDEBUG && _d("Custom sth bulk:", $sql); PTDEBUG && _d("Custom sth bulk:", $sql);
my $sth = $dbh->prepare($sql); my $sth = $dbh->prepare($sql);
return $sth; return $sth;

20
t/pt-archiver/samples/compact_col_vals.pm
View File

@@ -38,7 +38,7 @@ use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
@@ -65,7 +65,7 @@ sub new {
my $db_tbl = $q->quote($args{db}, $args{tbl}); my $db_tbl = $q->quote($args{db}, $args{tbl});
my $sql = "UPDATE $db_tbl SET `$compact_column`=? " my $sql = "UPDATE $db_tbl SET `$compact_column`=? "
. "WHERE `$compact_column`=?"; . "WHERE `$compact_column`=?";
MKDEBUG && _d('sth:', $sql); PTDEBUG && _d('sth:', $sql);
if ( !$o->get('dry-run') ) { if ( !$o->get('dry-run') ) {
$sth = $dbh->prepare($sql); $sth = $dbh->prepare($sql);
} }
@@ -87,7 +87,7 @@ sub new {
sub before_begin { sub before_begin {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
my $allcols = $args{allcols}; my $allcols = $args{allcols};
MKDEBUG && _d('allcols:', Dumper($allcols)); PTDEBUG && _d('allcols:', Dumper($allcols));
my $colpos = -1; my $colpos = -1;
foreach my $col ( @$allcols ) { foreach my $col ( @$allcols ) {
$colpos++; $colpos++;
@@ -97,7 +97,7 @@ sub before_begin {
die "Column $compact_column not selected by mk-archiver: " die "Column $compact_column not selected by mk-archiver: "
. join(', ', @$allcols); . join(', ', @$allcols);
} }
MKDEBUG && _d('col pos:', $colpos); PTDEBUG && _d('col pos:', $colpos);
$self->{col_pos} = $colpos; $self->{col_pos} = $colpos;
return; return;
} }
@@ -108,25 +108,25 @@ sub is_archivable {
my $row = $args{row}; my $row = $args{row};
my $val = $row->[$self->{col_pos}]; my $val = $row->[$self->{col_pos}];
my $sth = $self->{sth}; my $sth = $self->{sth};
MKDEBUG && _d('val:', $val); PTDEBUG && _d('val:', $val);
if ( $next_val ){ if ( $next_val ){
if ( $val > $next_val ) { if ( $val > $next_val ) {
MKDEBUG && _d('Updating', $val, 'to', $next_val); PTDEBUG && _d('Updating', $val, 'to', $next_val);
$sth->execute($next_val, $val); $sth->execute($next_val, $val);
} }
else { else {
MKDEBUG && _d('Val is OK'); PTDEBUG && _d('Val is OK');
} }
} }
else { else {
# This should happen once. # This should happen once.
MKDEBUG && _d('First val:', $val); PTDEBUG && _d('First val:', $val);
$self->{next_val} = $val; $self->{next_val} = $val;
} }
$self->{next_val}++; $self->{next_val}++;
MKDEBUG && _d('Next val should be', $self->{next_val}); PTDEBUG && _d('Next val should be', $self->{next_val});
# No rows are archivable because we're exploiting mk-archiver # No rows are archivable because we're exploiting mk-archiver
# just for its ability to nibble the table. To be safe, return 0 # just for its ability to nibble the table. To be safe, return 0
@@ -155,7 +155,7 @@ sub after_finish {
my $o = $self->{OptionParser}; my $o = $self->{OptionParser};
my $sql = "ALTER TABLE $self->{db_tbl} AUTO_INCREMENT=$self->{next_val}"; my $sql = "ALTER TABLE $self->{db_tbl} AUTO_INCREMENT=$self->{next_val}";
if ( !$o->get('dry-run') ) { if ( !$o->get('dry-run') ) {
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
$self->{dbh}->do($sql); $self->{dbh}->do($sql);
} }
else { else {

16
t/pt-archiver/samples/delete_more.pm
View File

@@ -45,7 +45,7 @@ use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG}; use constant PTDEBUG => $ENV{PTDEBUG};
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
@@ -79,7 +79,7 @@ sub new {
$other_table = $other_table_base . $id; $other_table = $other_table_base . $id;
} }
$other_table = $q->quote($other_db, $other_table); $other_table = $q->quote($other_db, $other_table);
MKDEBUG && _d('Other table:', $other_table); PTDEBUG && _d('Other table:', $other_table);
my $self = { my $self = {
dbh => $args{dbh}, dbh => $args{dbh},
@@ -100,7 +100,7 @@ sub new {
sub before_begin { sub before_begin {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
my $allcols = $args{allcols}; my $allcols = $args{allcols};
MKDEBUG && _d('allcols:', Dumper($allcols)); PTDEBUG && _d('allcols:', Dumper($allcols));
my $colpos = -1; my $colpos = -1;
foreach my $col ( @$allcols ) { foreach my $col ( @$allcols ) {
$colpos++; $colpos++;
@@ -110,7 +110,7 @@ sub before_begin {
die "Main table column $main_table_col not selected by mk-archiver: " die "Main table column $main_table_col not selected by mk-archiver: "
. join(', ', @$allcols); . join(', ', @$allcols);
} }
MKDEBUG && _d('main col pos:', $colpos); PTDEBUG && _d('main col pos:', $colpos);
$self->{main_col_pos} = $colpos; $self->{main_col_pos} = $colpos;
return; return;
} }
@@ -131,12 +131,12 @@ sub before_delete {
my $sql = "DELETE FROM $self->{other_tbl} " my $sql = "DELETE FROM $self->{other_tbl} "
. "WHERE $other_table_col=$val"; . "WHERE $other_table_col=$val";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
eval { eval {
$dbh->do($sql); $dbh->do($sql);
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
MKDEBUG && _d($EVAL_ERROR); PTDEBUG && _d($EVAL_ERROR);
warn $EVAL_ERROR; warn $EVAL_ERROR;
} }
@@ -159,12 +159,12 @@ sub before_bulk_delete {
my $sql = "DELETE FROM $self->{other_tbl} " my $sql = "DELETE FROM $self->{other_tbl} "
. "WHERE $other_table_col IN ($delete_rows) "; . "WHERE $other_table_col IN ($delete_rows) ";
# . "LIMIT $self->{limit}"; # . "LIMIT $self->{limit}";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
eval { eval {
$dbh->do($sql); $dbh->do($sql);
}; };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
MKDEBUG && _d($EVAL_ERROR); PTDEBUG && _d($EVAL_ERROR);
warn $EVAL_ERROR; warn $EVAL_ERROR;
} }

16
t/pt-archiver/samples/gt_n.pm
View File

@@ -2,7 +2,7 @@ package gt_n;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG}; use constant PTDEBUG => $ENV{PTDEBUG};
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
@@ -18,7 +18,7 @@ sub new {
my ( $class, %args ) = @_; my ( $class, %args ) = @_;
my $sql = "SELECT COUNT(*) FROM $args{db}.$args{tbl} WHERE " . WHERE; my $sql = "SELECT COUNT(*) FROM $args{db}.$args{tbl} WHERE " . WHERE;
MKDEBUG && _d('Row count sql:', $sql); PTDEBUG && _d('Row count sql:', $sql);
my $sth = $args{dbh}->prepare($sql); my $sth = $args{dbh}->prepare($sql);
my $self = { my $self = {
@@ -35,30 +35,30 @@ sub get_row_count {
my $sth = $self->{row_count_sth}; my $sth = $self->{row_count_sth};
$sth->execute(); $sth->execute();
my @row = $sth->fetchrow_array(); my @row = $sth->fetchrow_array();
MKDEBUG && _d('Row count:', $row[0]); PTDEBUG && _d('Row count:', $row[0]);
$sth->finish(); $sth->finish();
return $row[0]; return $row[0];
} }
sub before_begin { sub before_begin {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
MKDEBUG && _d('before begin'); PTDEBUG && _d('before begin');
# We don't need to do anything here. # We don't need to do anything here.
return; return;
} }
sub is_archivable { sub is_archivable {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
MKDEBUG && _d('is archivable'); PTDEBUG && _d('is archivable');
if ( $self->{done} ) { if ( $self->{done} ) {
MKDEBUG && _d("Already done, skipping row count"); PTDEBUG && _d("Already done, skipping row count");
return 0; return 0;
} }
my $n_rows = $self->get_row_count(); my $n_rows = $self->get_row_count();
if ( $n_rows <= MAX_ROWS ) { if ( $n_rows <= MAX_ROWS ) {
MKDEBUG && _d('Done archiving, row count <', MAX_ROWS, PTDEBUG && _d('Done archiving, row count <', MAX_ROWS,
'; first non-archived row:', Dumper($args{row})); '; first non-archived row:', Dumper($args{row}));
$self->{done} = 1; $self->{done} = 1;
return 0; return 0;
@@ -75,7 +75,7 @@ sub before_delete {
sub after_finish { sub after_finish {
my ( $self ) = @_; my ( $self ) = @_;
MKDEBUG && _d('after finish'); PTDEBUG && _d('after finish');
# Just to show in debug output how many rows are left at the end. # Just to show in debug output how many rows are left at the end.
my $n_rows = $self->get_row_count(); my $n_rows = $self->get_row_count();
return; return;

22
t/pt-archiver/samples/res_fk.pm
View File

@@ -47,7 +47,7 @@ package res_fk;
use strict; use strict;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG}; use constant PTDEBUG => $ENV{PTDEBUG};
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Indent = 1; $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
@@ -63,26 +63,26 @@ sub new {
my $sql = "INSERT INTO $dst_db.`user` " my $sql = "INSERT INTO $dst_db.`user` "
. "SELECT * FROM $src_db.`user` " . "SELECT * FROM $src_db.`user` "
. 'WHERE comp_id=?'; . 'WHERE comp_id=?';
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
my $archive_users_sth = $dbh->prepare($sql); my $archive_users_sth = $dbh->prepare($sql);
$sql = "DELETE FROM $src_db.`user` WHERE comp_id=?"; $sql = "DELETE FROM $src_db.`user` WHERE comp_id=?";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
my $delete_users_sth = $dbh->prepare($sql); my $delete_users_sth = $dbh->prepare($sql);
# Prepare statements for prod table. # Prepare statements for prod table.
$sql = "INSERT INTO $dst_db.`prod` " $sql = "INSERT INTO $dst_db.`prod` "
. "SELECT * FROM $src_db.`prod` " . "SELECT * FROM $src_db.`prod` "
. 'WHERE comp_id=?'; . 'WHERE comp_id=?';
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
my $archive_prods_sth = $dbh->prepare($sql); my $archive_prods_sth = $dbh->prepare($sql);
$sql = "SELECT DISTINCT `id` FROM $src_db.`prod` WHERE comp_id=?"; $sql = "SELECT DISTINCT `id` FROM $src_db.`prod` WHERE comp_id=?";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
my $get_prods_sth = $dbh->prepare($sql); my $get_prods_sth = $dbh->prepare($sql);
$sql = "DELETE FROM $src_db.`prod` WHERE comp_id=?"; $sql = "DELETE FROM $src_db.`prod` WHERE comp_id=?";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
my $delete_prods_sth = $dbh->prepare($sql); my $delete_prods_sth = $dbh->prepare($sql);
my $self = { my $self = {
@@ -129,13 +129,13 @@ sub is_archivable {
# tables with INSERT SELECT ($archive_*_sth). # tables with INSERT SELECT ($archive_*_sth).
sub before_delete { sub before_delete {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
MKDEBUG && _d('before delete'); PTDEBUG && _d('before delete');
my $dbh = $self->{dbh}; my $dbh = $self->{dbh};
my $src_db = $self->{src_db}; my $src_db = $self->{src_db};
my $dst_db = $self->{dst_db}; my $dst_db = $self->{dst_db};
my $comp_id = $args{row}->[0]; # id is first column my $comp_id = $args{row}->[0]; # id is first column
my $sql; my $sql;
MKDEBUG && _d('row:', Dumper($args{row})); PTDEBUG && _d('row:', Dumper($args{row}));
# Archive rows from prod then user, in that order because # Archive rows from prod then user, in that order because
# user referenes prod. # user referenes prod.
@@ -149,11 +149,11 @@ sub before_delete {
$self->{get_prods_sth}->execute($comp_id); $self->{get_prods_sth}->execute($comp_id);
my $prod_ids = $self->{get_prods_sth}->fetchall_arrayref(); my $prod_ids = $self->{get_prods_sth}->fetchall_arrayref();
my $all_prod_ids = join(',', map { $_->[0]; } @$prod_ids); my $all_prod_ids = join(',', map { $_->[0]; } @$prod_ids);
MKDEBUG && _d('prod ids:', $all_prod_ids); PTDEBUG && _d('prod ids:', $all_prod_ids);
my $sql = "INSERT INTO $dst_db.`prod_details` " my $sql = "INSERT INTO $dst_db.`prod_details` "
. "SELECT * FROM $src_db.`prod_details` " . "SELECT * FROM $src_db.`prod_details` "
. "WHERE prod_id IN ($all_prod_ids)"; . "WHERE prod_id IN ($all_prod_ids)";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
$dbh->do($sql); $dbh->do($sql);
# Now we can delete the rows from user, prod_details then prod # Now we can delete the rows from user, prod_details then prod
@@ -161,7 +161,7 @@ sub before_delete {
$self->{delete_users_sth}->execute($comp_id); $self->{delete_users_sth}->execute($comp_id);
$sql = "DELETE FROM $src_db.`prod_details` " $sql = "DELETE FROM $src_db.`prod_details` "
. "WHERE prod_id IN ($all_prod_ids)"; . "WHERE prod_id IN ($all_prod_ids)";
MKDEBUG && _d($sql); PTDEBUG && _d($sql);
$dbh->do($sql); $dbh->do($sql);
$self->{delete_prods_sth}->execute($comp_id); $self->{delete_prods_sth}->execute($comp_id);

2
t/pt-query-digest/mirror.t
View File

@@ -49,7 +49,7 @@ $cmd = "$trunk/bin/pt-query-digest "
$ENV{PTDEBUG}=1; $ENV{PTDEBUG}=1;
`$cmd > /tmp/read_only.txt 2>&1 &`; `$cmd > /tmp/read_only.txt 2>&1 &`;
$ENV{MKDEBUG}=0; $ENV{PTDEBUG}=0;
sleep 3; sleep 3;
$dbh1->do('select sleep(1)'); $dbh1->do('select sleep(1)');

4
t/pt-query-digest/samples/filter-add-ymdh-attribs.txt
View File

@@ -5,7 +5,7 @@ if ( $event->{ts} ) {
($year, $month, $day, $hour) ($year, $month, $day, $hour)
= $event->{ts} =~ /^(\d\d)(\d\d)(\d\d)\s+(\d\d):/; = $event->{ts} =~ /^(\d\d)(\d\d)(\d\d)\s+(\d\d):/;
} }
MKDEBUG && _d('ymdh:', $year, $month, $day, $hour); PTDEBUG && _d('ymdh:', $year, $month, $day, $hour);
$event->{year} = $year || 0; $event->{year} = $year || 0;
$event->{month} = $month || 0; $event->{month} = $month || 0;
$event->{day} = $day || 0; $event->{day} = $day || 0;
@@ -16,7 +16,7 @@ $event->{hour} = $hour || 24; # 0 is a valid hour
my $ok = 1; my $ok = 1;
foreach my $filter ( qw(YEAR MONTH HOUR DAY) ) { foreach my $filter ( qw(YEAR MONTH HOUR DAY) ) {
if ( $ENV{$filter} && $event->{lc $filter} != $ENV{$filter} ) { if ( $ENV{$filter} && $event->{lc $filter} != $ENV{$filter} ) {
MKDEBUG && _d('Event does not match', $filter, '=', $ENV{$filter}); PTDEBUG && _d('Event does not match', $filter, '=', $ENV{$filter});
$ok = 0; $ok = 0;
last; last;
} }