Replace the last instances of MKDEBUG

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

View File

@@ -6,7 +6,7 @@
use strict;
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.
BEGIN {
@@ -1319,7 +1319,7 @@ BEGIN { $INC{"ReadKeyMini.pm"} ||= 1 }
use warnings;
use strict;
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw( :termios_h );
use Fcntl qw( F_SETFL F_GETFL );
@@ -2489,7 +2489,7 @@ package DiskstatsGroupByAll;
use warnings;
use strict;
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats );
@@ -2562,7 +2562,7 @@ package DiskstatsGroupByDisk;
use warnings;
use strict;
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats );

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -40,7 +40,7 @@ $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# Sub: new
#
@@ -103,7 +103,7 @@ sub get_table_usage {
die "I need a $arg argument" unless $args{$arg};
}
my ($query) = @args{@required_args};
MKDEBUG && _d('Getting table access for',
PTDEBUG && _d('Getting table access for',
substr($query, 0, 100), (length $query > 100 ? '...' : ''));
$self->{errors} = [];
@@ -121,7 +121,7 @@ sub get_table_usage {
$query_struct = $self->{SQLParser}->parse($query);
};
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/ ) {
# SQLParser can't parse this type of query, so it's probably some
# 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;
}
@@ -158,7 +158,7 @@ sub _get_tables_used_from_query_parser {
die "I need a $arg argument" unless $args{$arg};
}
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);
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};
MKDEBUG && _d('Getting table used from query struct');
PTDEBUG && _d('Getting table used from query struct');
my $query_type = uc $query_struct->{type};
if ( $query_type eq 'CREATE' ) {
MKDEBUG && _d('CREATE query');
PTDEBUG && _d('CREATE query');
my $sel_tables;
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(
%args,
query => $sq_struct->{query},
@@ -221,7 +221,7 @@ sub _get_tables_used_from_query_struct {
my $tables = $self->_get_tables($query_struct);
if ( !$tables || @$tables == 0 ) {
MKDEBUG && _d("Query does not use any tables");
PTDEBUG && _d("Query does not use any tables");
return [
[ { 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} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
PTDEBUG && _d("Using EXPLAIN EXTENDED to disambiguate columns");
if ( $self->_reparse_query(%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;
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
# reads from each referenced table and writes only to tables referenced
# 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',
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;
}
if ( $where && $where->{joined_tables} ) {
@@ -274,7 +274,7 @@ sub _get_tables_used_from_query_struct {
context => $query_type,
table => $table,
};
MKDEBUG && _d("Table usage from WHERE (implicit join):",
PTDEBUG && _d("Table usage from WHERE (implicit join):",
Dumper($table_usage));
push @join_tables, $table_usage;
}
@@ -287,7 +287,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE',
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;
}
}
@@ -308,7 +308,7 @@ sub _get_tables_used_from_query_struct {
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, [
@table_usage,
@join_tables,
@@ -329,11 +329,11 @@ sub _get_tables_used_from_query_struct {
);
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) ) {
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 ) {
@@ -341,7 +341,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT',
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;
}
}
@@ -360,7 +360,7 @@ sub _get_tables_used_from_query_struct {
if ( $table->{join} && $table->{join}->{condition} ) {
$context = 'JOIN';
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(
%args,
tables => $tables,
@@ -375,22 +375,22 @@ sub _get_tables_used_from_query_struct {
);
}
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(
%args,
tables => $tables,
where => $table->{join}->{where},
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} ) {
MKDEBUG && _d("Using EXPLAIN EXTENDED",
PTDEBUG && _d("Using EXPLAIN EXTENDED",
"to disambiguate columns");
if ( $self->_reparse_query(%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}} ) {
@@ -412,14 +412,14 @@ sub _get_tables_used_from_query_struct {
context => $context,
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;
}
}
if ( $where && $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(
tables => $tables,
table => $joined_table,
@@ -432,7 +432,7 @@ sub _get_tables_used_from_query_struct {
if ( $query_type =~ m/(?:INSERT|REPLACE)/ ) {
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(
%args,
query_struct => $query_struct->{select},
@@ -444,7 +444,7 @@ sub _get_tables_used_from_query_struct {
context => 'SELECT',
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;
}
}
@@ -460,7 +460,7 @@ sub _get_tables_used_from_query_struct {
table => $table->{value_is_table} ? $table->{table}
: $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;
}
}
@@ -471,7 +471,7 @@ sub _get_tables_used_from_query_struct {
context => 'WHERE',
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;
}
}
@@ -488,13 +488,13 @@ sub _get_tables_used_in_columns {
}
my ($tables, $columns) = @args{@required_args};
MKDEBUG && _d("Getting tables used in CLIST");
PTDEBUG && _d("Getting tables used in CLIST");
my @tables;
my $ambig = 0; # found any ambiguous columns?
if ( @$tables == 1 ) {
# SELECT a, b FROM t WHERE ... -- one table so cols a and b must
# 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(
%args,
db => $tables->[0]->{db},
@@ -505,7 +505,7 @@ sub _get_tables_used_in_columns {
elsif ( @$columns == 1 && $columns->[0]->{col} eq '*' ) {
if ( $columns->[0]->{tbl} ) {
# 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(
%args,
db => $columns->[0]->{db},
@@ -515,7 +515,7 @@ sub _get_tables_used_in_columns {
}
else {
# 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 ) {
my $table = $self->_qualify_table_name(
%args,
@@ -530,14 +530,14 @@ sub _get_tables_used_in_columns {
else {
# SELECT x, y FROM t1, t2 -- have to determine from which table each
# column is.
MKDEBUG && _d(scalar @$tables, "table SELECT");
PTDEBUG && _d(scalar @$tables, "table SELECT");
my %seen;
my $colno = 0;
COLUMN:
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} ) {
MKDEBUG && _d('Ignoring FUNC(*) column');
PTDEBUG && _d('Ignoring FUNC(*) column');
$colno++;
next;
}
@@ -547,7 +547,7 @@ sub _get_tables_used_in_columns {
n_cols => scalar @$columns,
);
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");
$ambig++;
next COLUMN;
@@ -574,14 +574,14 @@ sub _get_tables_used_in_where {
my ($tables, $where) = @args{@required_args};
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 %join_tables;
my $ambig = 0; # found any ambiguous tables?
CONDITION:
foreach my $cond ( @$where ) {
MKDEBUG && _d("Condition:", Dumper($cond));
PTDEBUG && _d("Condition:", Dumper($cond));
my @tables; # tables used in this condition
my $n_vals = 0;
my $is_constant = 0;
@@ -589,13 +589,13 @@ sub _get_tables_used_in_where {
ARG:
foreach my $arg ( qw(left_arg right_arg) ) {
if ( !defined $cond->{$arg} ) {
MKDEBUG && _d($arg, "is a constant value");
PTDEBUG && _d($arg, "is a constant value");
$is_constant = 1;
next 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(
'column',
$cond->{$arg}
@@ -606,12 +606,12 @@ sub _get_tables_used_in_where {
);
if ( !$ident_struct->{tbl} ) {
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});
$ident_struct->{tbl} = $tables->[0]->{tbl};
}
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");
if ( $cond->{$arg} !~ m/\w+\(/ # not a function
&& $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} ) {
MKDEBUG && _d("Condition column is not database-qualified; ",
PTDEBUG && _d("Condition column is not database-qualified; ",
"using its table's database:", $tables->[0]->{db});
$ident_struct->{db} = $tables->[0]->{db};
}
@@ -637,29 +637,29 @@ sub _get_tables_used_in_where {
}
}
else {
MKDEBUG && _d($arg, "is a value");
PTDEBUG && _d($arg, "is a value");
$n_vals++;
}
} # ARG
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;
}
else {
if ( @tables == 1 ) {
if ( $unknown_table ) {
MKDEBUG && _d("Condition joins table",
PTDEBUG && _d("Condition joins table",
$tables[0], "to column from unknown table");
$join_tables{$tables[0]} = undef;
}
else {
MKDEBUG && _d("Condition filters table", $tables[0]);
PTDEBUG && _d("Condition filters table", $tables[0]);
$filter_tables{$tables[0]} = undef;
}
}
elsif ( @tables == 2 ) {
MKDEBUG && _d("Condition joins tables",
PTDEBUG && _d("Condition joins tables",
$tables[0], "and", $tables[1]);
$join_tables{$tables[0]} = undef;
$join_tables{$tables[1]} = undef;
@@ -686,7 +686,7 @@ sub _get_tables_used_in_set {
my ($tables, $set) = @args{@required_args};
my $sql_parser = $self->{SQLParser};
MKDEBUG && _d("Getting tables used in SET");
PTDEBUG && _d("Getting tables used in SET");
my @tables;
if ( @$tables == 1 ) {
@@ -748,13 +748,13 @@ sub _get_real_table_name {
foreach my $table ( @$tables ) {
if ( lc($table->{tbl}) 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};
}
}
# The named thing isn't referenced as a table by the query, so it's
# 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;
}
@@ -766,7 +766,7 @@ sub _qualify_table_name {
}
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;
@@ -804,12 +804,12 @@ sub _qualify_table_name {
# Can't db-qualify the table, so return just the real table name.
if ( !$db_tbl ) {
MKDEBUG && _d("Cannot determine database for table", $tbl);
PTDEBUG && _d("Cannot determine database for table", $tbl);
$db_tbl = $tbl;
}
}
MKDEBUG && _d("Table qualified with database:", $db_tbl);
PTDEBUG && _d("Table qualified with database:", $db_tbl);
return $db_tbl;
}
@@ -820,7 +820,7 @@ sub _change_context {
die "I need a $arg argument" unless $args{$arg};
}
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);
foreach my $used_table ( @$tables_used ) {
if ( $used_table->{table} eq $table
@@ -829,7 +829,7 @@ sub _change_context {
return;
}
}
MKDEBUG && _d("Table", $table, "is not used; cannot set its context");
PTDEBUG && _d("Table", $table, "is not used; cannot set its context");
return;
}
@@ -840,18 +840,18 @@ sub _explain_query {
my $sql;
if ( $db ) {
$sql = "USE `$db`";
MKDEBUG && _d($dbh, $sql);
PTDEBUG && _d($dbh, $sql);
$dbh->do($sql);
}
$sql = "EXPLAIN EXTENDED $query";
MKDEBUG && _d($dbh, $sql);
PTDEBUG && _d($dbh, $sql);
eval {
$dbh->do($sql); # don't need the result
};
if ( $EVAL_ERROR ) {
if ( $EVAL_ERROR =~ m/No database/i ) {
MKDEBUG && _d($EVAL_ERROR);
PTDEBUG && _d($EVAL_ERROR);
push @{$self->{errors}}, 'NO_DB_SELECTED';
return;
}
@@ -859,9 +859,9 @@ sub _explain_query {
}
$sql = "SHOW WARNINGS";
MKDEBUG && _d($dbh, $sql);
PTDEBUG && _d($dbh, $sql);
my $warning = $dbh->selectrow_hashref($sql);
MKDEBUG && _d(Dumper($warning));
PTDEBUG && _d(Dumper($warning));
if ( ($warning->{level} || "") !~ m/Note/i
|| ($warning->{code} || 0) != 1003 ) {
die "EXPLAIN EXTENDED failed:\n"
@@ -890,7 +890,7 @@ sub _reparse_query {
my ($self, %args) = @_;
my @required_args = qw(query query_struct);
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,
# re-error, and repeat.
@@ -938,7 +938,7 @@ sub _ex_qualify_column {
return $col unless $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.
return unless $col;
@@ -950,7 +950,7 @@ sub _ex_qualify_column {
if ( !$col->{tbl} ) {
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,
# so search for it in the WHERE conditions in the explained
# extended struct.
@@ -976,16 +976,16 @@ sub _ex_qualify_column {
elsif ( defined $colno
&& $ex->{columns}->[$colno]
&& 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];
}
elsif ( defined $colno
&& 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];
}
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 $colcnt = 0;
my $schemas = $self->{schemas};
@@ -1008,14 +1008,14 @@ sub _ex_qualify_column {
}
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}} ) {
MKDEBUG && _d('Table is an alias');
PTDEBUG && _d('Table is an alias');
$col->{db} = $real_tbl->{db};
$col->{tbl} = $real_tbl->{tbl};
}
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(
tables => $ex->{from},
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;
}

View File

@@ -59,10 +59,10 @@ Print more information.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=head1 VERSION

View File

@@ -106,10 +106,10 @@ other negatable.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=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
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
running with the C<MKDEBUG=1> environment variable.
running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY

View File

@@ -14,10 +14,10 @@ etc.)--those are tested in pod_sample_02.txt.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=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
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
running with the C<MKDEBUG=1> environment variable.
running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY

View File

@@ -20,10 +20,10 @@ etc.)--those are tested in pod_sample_02.txt.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=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
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
running with the C<MKDEBUG=1> environment variable.
running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY

View File

@@ -30,10 +30,10 @@ This option also has a description.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=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
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
running with the C<MKDEBUG=1> environment variable.
running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY

View File

@@ -18,9 +18,9 @@ New negatable bar.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=cut

View File

@@ -138,10 +138,10 @@ Print more information.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=head1 VERSION

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
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
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.
=item --verbose
@@ -120,10 +120,10 @@ This item is not part of the main option list and should not be read.
=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:
MKDEBUG=1 mk-....
PTDEBUG=1 mk-....
=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
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
running with the C<MKDEBUG=1> environment variable.
running with the C<PTDEBUG=1> environment variable.
=head1 COPYRIGHT, LICENSE AND WARRANTY

View File

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

View File

@@ -38,7 +38,7 @@ use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
@@ -65,7 +65,7 @@ sub new {
my $db_tbl = $q->quote($args{db}, $args{tbl});
my $sql = "UPDATE $db_tbl SET `$compact_column`=? "
. "WHERE `$compact_column`=?";
MKDEBUG && _d('sth:', $sql);
PTDEBUG && _d('sth:', $sql);
if ( !$o->get('dry-run') ) {
$sth = $dbh->prepare($sql);
}
@@ -87,7 +87,7 @@ sub new {
sub before_begin {
my ( $self, %args ) = @_;
my $allcols = $args{allcols};
MKDEBUG && _d('allcols:', Dumper($allcols));
PTDEBUG && _d('allcols:', Dumper($allcols));
my $colpos = -1;
foreach my $col ( @$allcols ) {
$colpos++;
@@ -97,7 +97,7 @@ sub before_begin {
die "Column $compact_column not selected by mk-archiver: "
. join(', ', @$allcols);
}
MKDEBUG && _d('col pos:', $colpos);
PTDEBUG && _d('col pos:', $colpos);
$self->{col_pos} = $colpos;
return;
}
@@ -108,25 +108,25 @@ sub is_archivable {
my $row = $args{row};
my $val = $row->[$self->{col_pos}];
my $sth = $self->{sth};
MKDEBUG && _d('val:', $val);
PTDEBUG && _d('val:', $val);
if ( $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);
}
else {
MKDEBUG && _d('Val is OK');
PTDEBUG && _d('Val is OK');
}
}
else {
# This should happen once.
MKDEBUG && _d('First val:', $val);
PTDEBUG && _d('First val:', $val);
$self->{next_val} = $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
# 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 $sql = "ALTER TABLE $self->{db_tbl} AUTO_INCREMENT=$self->{next_val}";
if ( !$o->get('dry-run') ) {
MKDEBUG && _d($sql);
PTDEBUG && _d($sql);
$self->{dbh}->do($sql);
}
else {

View File

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

View File

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

View File

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

View File

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

View File

@@ -5,7 +5,7 @@ if ( $event->{ts} ) {
($year, $month, $day, $hour)
= $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->{month} = $month || 0;
$event->{day} = $day || 0;
@@ -16,7 +16,7 @@ $event->{hour} = $hour || 24; # 0 is a valid hour
my $ok = 1;
foreach my $filter ( qw(YEAR MONTH HOUR DAY) ) {
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;
last;
}