#!/usr/bin/env perl

# This program is part of Percona Toolkit: http://www.percona.com/software/
# See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal
# notices and disclaimers.

use strict;
use warnings FATAL => 'all';
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

# ###########################################################################
# DSNParser package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/DSNParser.pm
#   t/lib/DSNParser.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package DSNParser;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;

eval {
   require DBI;
};
my $have_dbi = $EVAL_ERROR ? 0 : 1;

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(opts) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $self = {
      opts => {}  # h, P, u, etc.  Should come from DSN OPTIONS section in POD.
   };
   foreach my $opt ( @{$args{opts}} ) {
      if ( !$opt->{key} || !$opt->{desc} ) {
         die "Invalid DSN option: ", Dumper($opt);
      }
      MKDEBUG && _d('DSN option:',
         join(', ',
            map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') }
               keys %$opt
         )
      );
      $self->{opts}->{$opt->{key}} = {
         dsn  => $opt->{dsn},
         desc => $opt->{desc},
         copy => $opt->{copy} || 0,
      };
   }
   return bless $self, $class;
}

sub prop {
   my ( $self, $prop, $value ) = @_;
   if ( @_ > 2 ) {
      MKDEBUG && _d('Setting', $prop, 'property');
      $self->{$prop} = $value;
   }
   return $self->{$prop};
}

sub parse {
   my ( $self, $dsn, $prev, $defaults ) = @_;
   if ( !$dsn ) {
      MKDEBUG && _d('No DSN to parse');
      return;
   }
   MKDEBUG && _d('Parsing', $dsn);
   $prev     ||= {};
   $defaults ||= {};
   my %given_props;
   my %final_props;
   my $opts = $self->{opts};

   foreach my $dsn_part ( split(/,/, $dsn) ) {
      if ( my ($prop_key, $prop_val) = $dsn_part =~  m/^(.)=(.*)$/ ) {
         $given_props{$prop_key} = $prop_val;
      }
      else {
         MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part);
         $given_props{h} = $dsn_part;
      }
   }

   foreach my $key ( keys %$opts ) {
      MKDEBUG && _d('Finding value for', $key);
      $final_props{$key} = $given_props{$key};
      if (   !defined $final_props{$key}
           && defined $prev->{$key} && $opts->{$key}->{copy} )
      {
         $final_props{$key} = $prev->{$key};
         MKDEBUG && _d('Copying value for', $key, 'from previous DSN');
      }
      if ( !defined $final_props{$key} ) {
         $final_props{$key} = $defaults->{$key};
         MKDEBUG && _d('Copying value for', $key, 'from defaults');
      }
   }

   foreach my $key ( keys %given_props ) {
      die "Unknown DSN option '$key' in '$dsn'.  For more details, "
            . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
            . "for complete documentation."
         unless exists $opts->{$key};
   }
   if ( (my $required = $self->prop('required')) ) {
      foreach my $key ( keys %$required ) {
         die "Missing required DSN option '$key' in '$dsn'.  For more details, "
               . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
               . "for complete documentation."
            unless $final_props{$key};
      }
   }

   return \%final_props;
}

sub parse_options {
   my ( $self, $o ) = @_;
   die 'I need an OptionParser object' unless ref $o eq 'OptionParser';
   my $dsn_string
      = join(',',
          map  { "$_=".$o->get($_); }
          grep { $o->has($_) && $o->get($_) }
          keys %{$self->{opts}}
        );
   MKDEBUG && _d('DSN string made from options:', $dsn_string);
   return $self->parse($dsn_string);
}

sub as_string {
   my ( $self, $dsn, $props ) = @_;
   return $dsn unless ref $dsn;
   my @keys = $props ? @$props : sort keys %$dsn;
   return join(',',
      map  { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) }
      grep {
         exists $self->{opts}->{$_}
         && exists $dsn->{$_}
         && defined $dsn->{$_}
      } @keys);
}

sub usage {
   my ( $self ) = @_;
   my $usage
      = "DSN syntax is key=value[,key=value...]  Allowable DSN keys:\n\n"
      . "  KEY  COPY  MEANING\n"
      . "  ===  ====  =============================================\n";
   my %opts = %{$self->{opts}};
   foreach my $key ( sort keys %opts ) {
      $usage .= "  $key    "
             .  ($opts{$key}->{copy} ? 'yes   ' : 'no    ')
             .  ($opts{$key}->{desc} || '[No description]')
             . "\n";
   }
   $usage .= "\n  If the DSN is a bareword, the word is treated as the 'h' key.\n";
   return $usage;
}

sub get_cxn_params {
   my ( $self, $info ) = @_;
   my $dsn;
   my %opts = %{$self->{opts}};
   my $driver = $self->prop('dbidriver') || '';
   if ( $driver eq 'Pg' ) {
      $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(h P));
   }
   else {
      $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
                     grep { defined $info->{$_} }
                     qw(F h P S A))
         . ';mysql_read_default_group=client';
   }
   MKDEBUG && _d($dsn);
   return ($dsn, $info->{u}, $info->{p});
}

sub fill_in_dsn {
   my ( $self, $dbh, $dsn ) = @_;
   my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name');
   my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()');
   $user =~ s/@.*//;
   $dsn->{h} ||= $vars->{hostname}->{Value};
   $dsn->{S} ||= $vars->{'socket'}->{Value};
   $dsn->{P} ||= $vars->{port}->{Value};
   $dsn->{u} ||= $user;
   $dsn->{D} ||= $db;
}

sub get_dbh {
   my ( $self, $cxn_string, $user, $pass, $opts ) = @_;
   $opts ||= {};
   my $defaults = {
      AutoCommit         => 0,
      RaiseError         => 1,
      PrintError         => 0,
      ShowErrorStatement => 1,
      mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0),
   };
   @{$defaults}{ keys %$opts } = values %$opts;

   if ( $opts->{mysql_use_result} ) {
      $defaults->{mysql_use_result} = 1;
   }

   if ( !$have_dbi ) {
      die "Cannot connect to MySQL because the Perl DBI module is not "
         . "installed or not found.  Run 'perl -MDBI' to see the directories "
         . "that Perl searches for DBI.  If DBI is not installed, try:\n"
         . "  Debian/Ubuntu  apt-get install libdbi-perl\n"
         . "  RHEL/CentOS    yum install perl-DBI\n"
         . "  OpenSolaris    pgk install pkg:/SUNWpmdbi\n";

   }

   my $dbh;
   my $tries = 2;
   while ( !$dbh && $tries-- ) {
      MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 
         join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));

      eval {
         $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);

         if ( $cxn_string =~ m/mysql/i ) {
            my $sql;

            $sql = 'SELECT @@SQL_MODE';
            MKDEBUG && _d($dbh, $sql);
            my ($sql_mode) = $dbh->selectrow_array($sql);

            $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
                 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
                 . ($sql_mode ? ",$sql_mode" : '')
                 . '\'*/';
            MKDEBUG && _d($dbh, $sql);
            $dbh->do($sql);

            if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
               $sql = "/*!40101 SET NAMES $charset*/";
               MKDEBUG && _d($dbh, ':', $sql);
               $dbh->do($sql);
               MKDEBUG && _d('Enabling charset for STDOUT');
               if ( $charset eq 'utf8' ) {
                  binmode(STDOUT, ':utf8')
                     or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
               }
               else {
                  binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
               }
            }

            if ( $self->prop('set-vars') ) {
               $sql = "SET " . $self->prop('set-vars');
               MKDEBUG && _d($dbh, ':', $sql);
               $dbh->do($sql);
            }
         }
      };
      if ( !$dbh && $EVAL_ERROR ) {
         MKDEBUG && _d($EVAL_ERROR);
         if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
            MKDEBUG && _d('Going to try again without utf8 support');
            delete $defaults->{mysql_enable_utf8};
         }
         elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
            die "Cannot connect to MySQL because the Perl DBD::mysql module is "
               . "not installed or not found.  Run 'perl -MDBD::mysql' to see "
               . "the directories that Perl searches for DBD::mysql.  If "
               . "DBD::mysql is not installed, try:\n"
               . "  Debian/Ubuntu  apt-get install libdbd-mysql-perl\n"
               . "  RHEL/CentOS    yum install perl-DBD-MySQL\n"
               . "  OpenSolaris    pgk install pkg:/SUNWapu13dbd-mysql\n";
         }
         if ( !$tries ) {
            die $EVAL_ERROR;
         }
      }
   }

   MKDEBUG && _d('DBH info: ',
      $dbh,
      Dumper($dbh->selectrow_hashref(
         'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
      'Connection info:',      $dbh->{mysql_hostinfo},
      'Character set info:',   Dumper($dbh->selectall_arrayref(
                     'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),
      '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
      '$DBI::VERSION:',        $DBI::VERSION,
   );

   return $dbh;
}

sub get_hostname {
   my ( $self, $dbh ) = @_;
   if ( my ($host) = ($dbh->{mysql_hostinfo} || '') =~ m/^(\w+) via/ ) {
      return $host;
   }
   my ( $hostname, $one ) = $dbh->selectrow_array(
      'SELECT /*!50038 @@hostname, */ 1');
   return $hostname;
}

sub disconnect {
   my ( $self, $dbh ) = @_;
   MKDEBUG && $self->print_active_handles($dbh);
   $dbh->disconnect;
}

sub print_active_handles {
   my ( $self, $thing, $level ) = @_;
   $level ||= 0;
   printf("# Active %sh: %s %s %s\n", ($thing->{Type} || 'undef'), "\t" x $level,
      $thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : ''))
      or die "Cannot print: $OS_ERROR";
   foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) {
      $self->print_active_handles( $handle, $level + 1 );
   }
}

sub copy {
   my ( $self, $dsn_1, $dsn_2, %args ) = @_;
   die 'I need a dsn_1 argument' unless $dsn_1;
   die 'I need a dsn_2 argument' unless $dsn_2;
   my %new_dsn = map {
      my $key = $_;
      my $val;
      if ( $args{overwrite} ) {
         $val = defined $dsn_1->{$key} ? $dsn_1->{$key} : $dsn_2->{$key};
      }
      else {
         $val = defined $dsn_2->{$key} ? $dsn_2->{$key} : $dsn_1->{$key};
      }
      $key => $val;
   } keys %{$self->{opts}};
   return \%new_dsn;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End DSNParser package
# ###########################################################################

# ###########################################################################
# OptionParser package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/OptionParser.pm
#   t/lib/OptionParser.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package OptionParser;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use List::Util qw(max);
use Getopt::Long;

my $POD_link_re = '[LC]<"?([^">]+)"?>';

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw();
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }

   my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
   $program_name ||= $PROGRAM_NAME;
   my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';

   my %attributes = (
      'type'       => 1,
      'short form' => 1,
      'group'      => 1,
      'default'    => 1,
      'cumulative' => 1,
      'negatable'  => 1,
   );

   my $self = {
      head1             => 'OPTIONS',        # These args are used internally
      skip_rules        => 0,                # to instantiate another Option-
      item              => '--(.*)',         # Parser obj that parses the
      attributes        => \%attributes,     # DSN OPTIONS section.  Tools
      parse_attributes  => \&_parse_attribs, # don't tinker with these args.

      %args,

      strict            => 1,  # disabled by a special rule
      program_name      => $program_name,
      opts              => {},
      got_opts          => 0,
      short_opts        => {},
      defaults          => {},
      groups            => {},
      allowed_groups    => {},
      errors            => [],
      rules             => [],  # desc of rules for --help
      mutex             => [],  # rule: opts are mutually exclusive
      atleast1          => [],  # rule: at least one opt is required
      disables          => {},  # rule: opt disables other opts 
      defaults_to       => {},  # rule: opt defaults to value of other opt
      DSNParser         => undef,
      default_files     => [
         "/etc/percona-toolkit/percona-toolkit.conf",
         "/etc/percona-toolkit/$program_name.conf",
         "$home/.percona-toolkit.conf",
         "$home/.$program_name.conf",
      ],
      types             => {
         string => 's', # standard Getopt type
         int    => 'i', # standard Getopt type
         float  => 'f', # standard Getopt type
         Hash   => 'H', # hash, formed from a comma-separated list
         hash   => 'h', # hash as above, but only if a value is given
         Array  => 'A', # array, similar to Hash
         array  => 'a', # array, similar to hash
         DSN    => 'd', # DSN
         size   => 'z', # size with kMG suffix (powers of 2^10)
         time   => 'm', # time, with an optional suffix of s/h/m/d
      },
   };

   return bless $self, $class;
}

sub get_specs {
   my ( $self, $file ) = @_;
   $file ||= $self->{file} || __FILE__;
   my @specs = $self->_pod_to_specs($file);
   $self->_parse_specs(@specs);

   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
   my $contents = do { local $/ = undef; <$fh> };
   close $fh;
   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
      MKDEBUG && _d('Parsing DSN OPTIONS');
      my $dsn_attribs = {
         dsn  => 1,
         copy => 1,
      };
      my $parse_dsn_attribs = sub {
         my ( $self, $option, $attribs ) = @_;
         map {
            my $val = $attribs->{$_};
            if ( $val ) {
               $val    = $val eq 'yes' ? 1
                       : $val eq 'no'  ? 0
                       :                 $val;
               $attribs->{$_} = $val;
            }
         } keys %$attribs;
         return {
            key => $option,
            %$attribs,
         };
      };
      my $dsn_o = new OptionParser(
         description       => 'DSN OPTIONS',
         head1             => 'DSN OPTIONS',
         dsn               => 0,         # XXX don't infinitely recurse!
         item              => '\* (.)',  # key opts are a single character
         skip_rules        => 1,         # no rules before opts
         attributes        => $dsn_attribs,
         parse_attributes  => $parse_dsn_attribs,
      );
      my @dsn_opts = map {
         my $opts = {
            key  => $_->{spec}->{key},
            dsn  => $_->{spec}->{dsn},
            copy => $_->{spec}->{copy},
            desc => $_->{desc},
         };
         $opts;
      } $dsn_o->_pod_to_specs($file);
      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
   }

   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
      $self->{version} = $1;
      MKDEBUG && _d($self->{version});
   }

   return;
}

sub DSNParser {
   my ( $self ) = @_;
   return $self->{DSNParser};
};

sub get_defaults_files {
   my ( $self ) = @_;
   return @{$self->{default_files}};
}

sub _pod_to_specs {
   my ( $self, $file ) = @_;
   $file ||= $self->{file} || __FILE__;
   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";

   my @specs = ();
   my @rules = ();
   my $para;

   local $INPUT_RECORD_SEPARATOR = '';
   while ( $para = <$fh> ) {
      next unless $para =~ m/^=head1 $self->{head1}/;
      last;
   }

   while ( $para = <$fh> ) {
      last if $para =~ m/^=over/;
      next if $self->{skip_rules};
      chomp $para;
      $para =~ s/\s+/ /g;
      $para =~ s/$POD_link_re/$1/go;
      MKDEBUG && _d('Option rule:', $para);
      push @rules, $para;
   }

   die "POD has no $self->{head1} section" unless $para;

   do {
      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
         chomp $para;
         MKDEBUG && _d($para);
         my %attribs;

         $para = <$fh>; # read next paragraph, possibly attributes

         if ( $para =~ m/: / ) { # attributes
            $para =~ s/\s+\Z//g;
            %attribs = map {
                  my ( $attrib, $val) = split(/: /, $_);
                  die "Unrecognized attribute for --$option: $attrib"
                     unless $self->{attributes}->{$attrib};
                  ($attrib, $val);
               } split(/; /, $para);
            if ( $attribs{'short form'} ) {
               $attribs{'short form'} =~ s/-//;
            }
            $para = <$fh>; # read next paragraph, probably short help desc
         }
         else {
            MKDEBUG && _d('Option has no attributes');
         }

         $para =~ s/\s+\Z//g;
         $para =~ s/\s+/ /g;
         $para =~ s/$POD_link_re/$1/go;

         $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s;
         MKDEBUG && _d('Short help:', $para);

         die "No description after option spec $option" if $para =~ m/^=item/;

         if ( my ($base_option) =  $option =~ m/^\[no\](.*)/ ) {
            $option = $base_option;
            $attribs{'negatable'} = 1;
         }

         push @specs, {
            spec  => $self->{parse_attributes}->($self, $option, \%attribs), 
            desc  => $para
               . (defined $attribs{default} ? " (default $attribs{default})" : ''),
            group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
         };
      }
      while ( $para = <$fh> ) {
         last unless $para;
         if ( $para =~ m/^=head1/ ) {
            $para = undef; # Can't 'last' out of a do {} block.
            last;
         }
         last if $para =~ m/^=item /;
      }
   } while ( $para );

   die "No valid specs in $self->{head1}" unless @specs;

   close $fh;
   return @specs, @rules;
}

sub _parse_specs {
   my ( $self, @specs ) = @_;
   my %disables; # special rule that requires deferred checking

   foreach my $opt ( @specs ) {
      if ( ref $opt ) { # It's an option spec, not a rule.
         MKDEBUG && _d('Parsing opt spec:',
            map { ($_, '=>', $opt->{$_}) } keys %$opt);

         my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
         if ( !$long ) {
            die "Cannot parse long option from spec $opt->{spec}";
         }
         $opt->{long} = $long;

         die "Duplicate long option --$long" if exists $self->{opts}->{$long};
         $self->{opts}->{$long} = $opt;

         if ( length $long == 1 ) {
            MKDEBUG && _d('Long opt', $long, 'looks like short opt');
            $self->{short_opts}->{$long} = $long;
         }

         if ( $short ) {
            die "Duplicate short option -$short"
               if exists $self->{short_opts}->{$short};
            $self->{short_opts}->{$short} = $long;
            $opt->{short} = $short;
         }
         else {
            $opt->{short} = undef;
         }

         $opt->{is_negatable}  = $opt->{spec} =~ m/!/        ? 1 : 0;
         $opt->{is_cumulative} = $opt->{spec} =~ m/\+/       ? 1 : 0;
         $opt->{is_required}   = $opt->{desc} =~ m/required/ ? 1 : 0;

         $opt->{group} ||= 'default';
         $self->{groups}->{ $opt->{group} }->{$long} = 1;

         $opt->{value} = undef;
         $opt->{got}   = 0;

         my ( $type ) = $opt->{spec} =~ m/=(.)/;
         $opt->{type} = $type;
         MKDEBUG && _d($long, 'type:', $type);


         $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ );

         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
            $self->{defaults}->{$long} = defined $def ? $def : 1;
            MKDEBUG && _d($long, 'default:', $def);
         }

         if ( $long eq 'config' ) {
            $self->{defaults}->{$long} = join(',', $self->get_defaults_files());
         }

         if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) {
            $disables{$long} = $dis;
            MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
         }

         $self->{opts}->{$long} = $opt;
      }
      else { # It's an option rule, not a spec.
         MKDEBUG && _d('Parsing rule:', $opt); 
         push @{$self->{rules}}, $opt;
         my @participants = $self->_get_participants($opt);
         my $rule_ok = 0;

         if ( $opt =~ m/mutually exclusive|one and only one/ ) {
            $rule_ok = 1;
            push @{$self->{mutex}}, \@participants;
            MKDEBUG && _d(@participants, 'are mutually exclusive');
         }
         if ( $opt =~ m/at least one|one and only one/ ) {
            $rule_ok = 1;
            push @{$self->{atleast1}}, \@participants;
            MKDEBUG && _d(@participants, 'require at least one');
         }
         if ( $opt =~ m/default to/ ) {
            $rule_ok = 1;
            $self->{defaults_to}->{$participants[0]} = $participants[1];
            MKDEBUG && _d($participants[0], 'defaults to', $participants[1]);
         }
         if ( $opt =~ m/restricted to option groups/ ) {
            $rule_ok = 1;
            my ($groups) = $opt =~ m/groups ([\w\s\,]+)/;
            my @groups = split(',', $groups);
            %{$self->{allowed_groups}->{$participants[0]}} = map {
               s/\s+//;
               $_ => 1;
            } @groups;
         }
         if( $opt =~ m/accepts additional command-line arguments/ ) {
            $rule_ok = 1;
            $self->{strict} = 0;
            MKDEBUG && _d("Strict mode disabled by rule");
         }

         die "Unrecognized option rule: $opt" unless $rule_ok;
      }
   }

   foreach my $long ( keys %disables ) {
      my @participants = $self->_get_participants($disables{$long});
      $self->{disables}->{$long} = \@participants;
      MKDEBUG && _d('Option', $long, 'disables', @participants);
   }

   return; 
}

sub _get_participants {
   my ( $self, $str ) = @_;
   my @participants;
   foreach my $long ( $str =~ m/--(?:\[no\])?([\w-]+)/g ) {
      die "Option --$long does not exist while processing rule $str"
         unless exists $self->{opts}->{$long};
      push @participants, $long;
   }
   MKDEBUG && _d('Participants for', $str, ':', @participants);
   return @participants;
}

sub opts {
   my ( $self ) = @_;
   my %opts = %{$self->{opts}};
   return %opts;
}

sub short_opts {
   my ( $self ) = @_;
   my %short_opts = %{$self->{short_opts}};
   return %short_opts;
}

sub set_defaults {
   my ( $self, %defaults ) = @_;
   $self->{defaults} = {};
   foreach my $long ( keys %defaults ) {
      die "Cannot set default for nonexistent option $long"
         unless exists $self->{opts}->{$long};
      $self->{defaults}->{$long} = $defaults{$long};
      MKDEBUG && _d('Default val for', $long, ':', $defaults{$long});
   }
   return;
}

sub get_defaults {
   my ( $self ) = @_;
   return $self->{defaults};
}

sub get_groups {
   my ( $self ) = @_;
   return $self->{groups};
}

sub _set_option {
   my ( $self, $opt, $val ) = @_;
   my $long = exists $self->{opts}->{$opt}       ? $opt
            : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt}
            : die "Getopt::Long gave a nonexistent option: $opt";

   $opt = $self->{opts}->{$long};
   if ( $opt->{is_cumulative} ) {
      $opt->{value}++;
   }
   else {
      $opt->{value} = $val;
   }
   $opt->{got} = 1;
   MKDEBUG && _d('Got option', $long, '=', $val);
}

sub get_opts {
   my ( $self ) = @_; 

   foreach my $long ( keys %{$self->{opts}} ) {
      $self->{opts}->{$long}->{got} = 0;
      $self->{opts}->{$long}->{value}
         = exists $self->{defaults}->{$long}       ? $self->{defaults}->{$long}
         : $self->{opts}->{$long}->{is_cumulative} ? 0
         : undef;
   }
   $self->{got_opts} = 0;

   $self->{errors} = [];

   if ( @ARGV && $ARGV[0] eq "--config" ) {
      shift @ARGV;
      $self->_set_option('config', shift @ARGV);
   }
   if ( $self->has('config') ) {
      my @extra_args;
      foreach my $filename ( split(',', $self->get('config')) ) {
         eval {
            push @extra_args, $self->_read_config_file($filename);
         };
         if ( $EVAL_ERROR ) {
            if ( $self->got('config') ) {
               die $EVAL_ERROR;
            }
            elsif ( MKDEBUG ) {
               _d($EVAL_ERROR);
            }
         }
      }
      unshift @ARGV, @extra_args;
   }

   Getopt::Long::Configure('no_ignore_case', 'bundling');
   GetOptions(
      map    { $_->{spec} => sub { $self->_set_option(@_); } }
      grep   { $_->{long} ne 'config' } # --config is handled specially above.
      values %{$self->{opts}}
   ) or $self->save_error('Error parsing options');

   if ( exists $self->{opts}->{version} && $self->{opts}->{version}->{got} ) {
      if ( $self->{version} ) {
         print $self->{version}, "\n";
      }
      else {
         print "Error parsing version.  See the VERSION section of the tool's documentation.\n";
      }
      exit 0;
   }

   if ( @ARGV && $self->{strict} ) {
      $self->save_error("Unrecognized command-line options @ARGV");
   }

   foreach my $mutex ( @{$self->{mutex}} ) {
      my @set = grep { $self->{opts}->{$_}->{got} } @$mutex;
      if ( @set > 1 ) {
         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
                      @{$mutex}[ 0 .. scalar(@$mutex) - 2] )
                 . ' and --'.$self->{opts}->{$mutex->[-1]}->{long}
                 . ' are mutually exclusive.';
         $self->save_error($err);
      }
   }

   foreach my $required ( @{$self->{atleast1}} ) {
      my @set = grep { $self->{opts}->{$_}->{got} } @$required;
      if ( @set == 0 ) {
         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
                      @{$required}[ 0 .. scalar(@$required) - 2] )
                 .' or --'.$self->{opts}->{$required->[-1]}->{long};
         $self->save_error("Specify at least one of $err");
      }
   }

   $self->_check_opts( keys %{$self->{opts}} );
   $self->{got_opts} = 1;
   return;
}

sub _check_opts {
   my ( $self, @long ) = @_;
   my $long_last = scalar @long;
   while ( @long ) {
      foreach my $i ( 0..$#long ) {
         my $long = $long[$i];
         next unless $long;
         my $opt  = $self->{opts}->{$long};
         if ( $opt->{got} ) {
            if ( exists $self->{disables}->{$long} ) {
               my @disable_opts = @{$self->{disables}->{$long}};
               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
               MKDEBUG && _d('Unset options', @disable_opts,
                  'because', $long,'disables them');
            }

            if ( exists $self->{allowed_groups}->{$long} ) {

               my @restricted_groups = grep {
                  !exists $self->{allowed_groups}->{$long}->{$_}
               } keys %{$self->{groups}};

               my @restricted_opts;
               foreach my $restricted_group ( @restricted_groups ) {
                  RESTRICTED_OPT:
                  foreach my $restricted_opt (
                     keys %{$self->{groups}->{$restricted_group}} )
                  {
                     next RESTRICTED_OPT if $restricted_opt eq $long;
                     push @restricted_opts, $restricted_opt
                        if $self->{opts}->{$restricted_opt}->{got};
                  }
               }

               if ( @restricted_opts ) {
                  my $err;
                  if ( @restricted_opts == 1 ) {
                     $err = "--$restricted_opts[0]";
                  }
                  else {
                     $err = join(', ',
                               map { "--$self->{opts}->{$_}->{long}" }
                               grep { $_ } 
                               @restricted_opts[0..scalar(@restricted_opts) - 2]
                            )
                          . ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long};
                  }
                  $self->save_error("--$long is not allowed with $err");
               }
            }

         }
         elsif ( $opt->{is_required} ) { 
            $self->save_error("Required option --$long must be specified");
         }

         $self->_validate_type($opt);
         if ( $opt->{parsed} ) {
            delete $long[$i];
         }
         else {
            MKDEBUG && _d('Temporarily failed to parse', $long);
         }
      }

      die "Failed to parse options, possibly due to circular dependencies"
         if @long == $long_last;
      $long_last = @long;
   }

   return;
}

sub _validate_type {
   my ( $self, $opt ) = @_;
   return unless $opt;

   if ( !$opt->{type} ) {
      $opt->{parsed} = 1;
      return;
   }

   my $val = $opt->{value};

   if ( $val && $opt->{type} eq 'm' ) {  # type time
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
      if ( !$suffix ) {
         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
         $suffix = $s || 's';
         MKDEBUG && _d('No suffix given; using', $suffix, 'for',
            $opt->{long}, '(value:', $val, ')');
      }
      if ( $suffix =~ m/[smhd]/ ) {
         $val = $suffix eq 's' ? $num            # Seconds
              : $suffix eq 'm' ? $num * 60       # Minutes
              : $suffix eq 'h' ? $num * 3600     # Hours
              :                  $num * 86400;   # Days
         $opt->{value} = ($prefix || '') . $val;
         MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
      }
      else {
         $self->save_error("Invalid time suffix for --$opt->{long}");
      }
   }
   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
      my $prev = {};
      my $from_key = $self->{defaults_to}->{ $opt->{long} };
      if ( $from_key ) {
         MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
         if ( $self->{opts}->{$from_key}->{parsed} ) {
            $prev = $self->{opts}->{$from_key}->{value};
         }
         else {
            MKDEBUG && _d('Cannot parse', $opt->{long}, 'until',
               $from_key, 'parsed');
            return;
         }
      }
      my $defaults = $self->{DSNParser}->parse_options($self);
      $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
   }
   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
      $self->_parse_size($opt, $val);
   }
   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
      $opt->{value} = { map { $_ => 1 } split(/(?<!\\),\s*/, ($val || '')) };
   }
   elsif ( $opt->{type} eq 'A' || (defined $val && $opt->{type} eq 'a') ) {
      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
   }
   else {
      MKDEBUG && _d('Nothing to validate for option',
         $opt->{long}, 'type', $opt->{type}, 'value', $val);
   }

   $opt->{parsed} = 1;
   return;
}

sub get {
   my ( $self, $opt ) = @_;
   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
   die "Option $opt does not exist"
      unless $long && exists $self->{opts}->{$long};
   return $self->{opts}->{$long}->{value};
}

sub got {
   my ( $self, $opt ) = @_;
   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
   die "Option $opt does not exist"
      unless $long && exists $self->{opts}->{$long};
   return $self->{opts}->{$long}->{got};
}

sub has {
   my ( $self, $opt ) = @_;
   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
   return defined $long ? exists $self->{opts}->{$long} : 0;
}

sub set {
   my ( $self, $opt, $val ) = @_;
   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
   die "Option $opt does not exist"
      unless $long && exists $self->{opts}->{$long};
   $self->{opts}->{$long}->{value} = $val;
   return;
}

sub save_error {
   my ( $self, $error ) = @_;
   push @{$self->{errors}}, $error;
   return;
}

sub errors {
   my ( $self ) = @_;
   return $self->{errors};
}

sub usage {
   my ( $self ) = @_;
   warn "No usage string is set" unless $self->{usage}; # XXX
   return "Usage: " . ($self->{usage} || '') . "\n";
}

sub descr {
   my ( $self ) = @_;
   warn "No description string is set" unless $self->{description}; # XXX
   my $descr  = ($self->{description} || $self->{program_name} || '')
              . "  For more details, please use the --help option, "
              . "or try 'perldoc $PROGRAM_NAME' "
              . "for complete documentation.";
   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g)
      unless $ENV{DONT_BREAK_LINES};
   $descr =~ s/ +$//mg;
   return $descr;
}

sub usage_or_errors {
   my ( $self, $file, $return ) = @_;
   $file ||= $self->{file} || __FILE__;

   if ( !$self->{description} || !$self->{usage} ) {
      MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
      my %synop = $self->_parse_synopsis($file);
      $self->{description} ||= $synop{description};
      $self->{usage}       ||= $synop{usage};
      MKDEBUG && _d("Description:", $self->{description},
         "\nUsage:", $self->{usage});
   }

   if ( $self->{opts}->{help}->{got} ) {
      print $self->print_usage() or die "Cannot print usage: $OS_ERROR";
      exit 0 unless $return;
   }
   elsif ( scalar @{$self->{errors}} ) {
      print $self->print_errors() or die "Cannot print errors: $OS_ERROR";
      exit 0 unless $return;
   }

   return;
}

sub print_errors {
   my ( $self ) = @_;
   my $usage = $self->usage() . "\n";
   if ( (my @errors = @{$self->{errors}}) ) {
      $usage .= join("\n  * ", 'Errors in command-line arguments:', @errors)
              . "\n";
   }
   return $usage . "\n" . $self->descr();
}

sub print_usage {
   my ( $self ) = @_;
   die "Run get_opts() before print_usage()" unless $self->{got_opts};
   my @opts = values %{$self->{opts}};

   my $maxl = max(
      map {
         length($_->{long})               # option long name
         + ($_->{is_negatable} ? 4 : 0)   # "[no]" if opt is negatable
         + ($_->{type} ? 2 : 0)           # "=x" where x is the opt type
      }
      @opts);

   my $maxs = max(0,
      map {
         length($_)
         + ($self->{opts}->{$_}->{is_negatable} ? 4 : 0)
         + ($self->{opts}->{$_}->{type} ? 2 : 0)
      }
      values %{$self->{short_opts}});

   my $lcol = max($maxl, ($maxs + 3));
   my $rcol = 80 - $lcol - 6;
   my $rpad = ' ' x ( 80 - $rcol );

   $maxs = max($lcol - 3, $maxs);

   my $usage = $self->descr() . "\n" . $self->usage();

   my @groups = reverse sort grep { $_ ne 'default'; } keys %{$self->{groups}};
   push @groups, 'default';

   foreach my $group ( reverse @groups ) {
      $usage .= "\n".($group eq 'default' ? 'Options' : $group).":\n\n";
      foreach my $opt (
         sort { $a->{long} cmp $b->{long} }
         grep { $_->{group} eq $group }
         @opts )
      {
         my $long  = $opt->{is_negatable} ? "[no]$opt->{long}" : $opt->{long};
         my $short = $opt->{short};
         my $desc  = $opt->{desc};

         $long .= $opt->{type} ? "=$opt->{type}" : "";

         if ( $opt->{type} && $opt->{type} eq 'm' ) {
            my ($s) = $desc =~ m/\(suffix (.)\)/;
            $s    ||= 's';
            $desc =~ s/\s+\(suffix .\)//;
            $desc .= ".  Optional suffix s=seconds, m=minutes, h=hours, "
                   . "d=days; if no suffix, $s is used.";
         }
         $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol})(?:\s+|$)/g);
         $desc =~ s/ +$//mg;
         if ( $short ) {
            $usage .= sprintf("  --%-${maxs}s -%s  %s\n", $long, $short, $desc);
         }
         else {
            $usage .= sprintf("  --%-${lcol}s  %s\n", $long, $desc);
         }
      }
   }

   $usage .= "\nOption types: s=string, i=integer, f=float, h/H/a/A=comma-separated list, d=DSN, z=size, m=time\n";

   if ( (my @rules = @{$self->{rules}}) ) {
      $usage .= "\nRules:\n\n";
      $usage .= join("\n", map { "  $_" } @rules) . "\n";
   }
   if ( $self->{DSNParser} ) {
      $usage .= "\n" . $self->{DSNParser}->usage();
   }
   $usage .= "\nOptions and values after processing arguments:\n\n";
   foreach my $opt ( sort { $a->{long} cmp $b->{long} } @opts ) {
      my $val   = $opt->{value};
      my $type  = $opt->{type} || '';
      my $bool  = $opt->{spec} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
      $val      = $bool              ? ( $val ? 'TRUE' : 'FALSE' )
                : !defined $val      ? '(No value)'
                : $type eq 'd'       ? $self->{DSNParser}->as_string($val)
                : $type =~ m/H|h/    ? join(',', sort keys %$val)
                : $type =~ m/A|a/    ? join(',', @$val)
                :                    $val;
      $usage .= sprintf("  --%-${lcol}s  %s\n", $opt->{long}, $val);
   }
   return $usage;
}

sub prompt_noecho {
   shift @_ if ref $_[0] eq __PACKAGE__;
   my ( $prompt ) = @_;
   local $OUTPUT_AUTOFLUSH = 1;
   print $prompt
      or die "Cannot print: $OS_ERROR";
   my $response;
   eval {
      require Term::ReadKey;
      Term::ReadKey::ReadMode('noecho');
      chomp($response = <STDIN>);
      Term::ReadKey::ReadMode('normal');
      print "\n"
         or die "Cannot print: $OS_ERROR";
   };
   if ( $EVAL_ERROR ) {
      die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR";
   }
   return $response;
}

sub _read_config_file {
   my ( $self, $filename ) = @_;
   open my $fh, "<", $filename or die "Cannot open $filename: $OS_ERROR\n";
   my @args;
   my $prefix = '--';
   my $parse  = 1;

   LINE:
   while ( my $line = <$fh> ) {
      chomp $line;
      next LINE if $line =~ m/^\s*(?:\#|\;|$)/;
      $line =~ s/\s+#.*$//g;
      $line =~ s/^\s+|\s+$//g;
      if ( $line eq '--' ) {
         $prefix = '';
         $parse  = 0;
         next LINE;
      }
      if ( $parse
         && (my($opt, $arg) = $line =~ m/^\s*([^=\s]+?)(?:\s*=\s*(.*?)\s*)?$/)
      ) {
         push @args, grep { defined $_ } ("$prefix$opt", $arg);
      }
      elsif ( $line =~ m/./ ) {
         push @args, $line;
      }
      else {
         die "Syntax error in file $filename at line $INPUT_LINE_NUMBER";
      }
   }
   close $fh;
   return @args;
}

sub read_para_after {
   my ( $self, $file, $regex ) = @_;
   open my $fh, "<", $file or die "Can't open $file: $OS_ERROR";
   local $INPUT_RECORD_SEPARATOR = '';
   my $para;
   while ( $para = <$fh> ) {
      next unless $para =~ m/^=pod$/m;
      last;
   }
   while ( $para = <$fh> ) {
      next unless $para =~ m/$regex/;
      last;
   }
   $para = <$fh>;
   chomp($para);
   close $fh or die "Can't close $file: $OS_ERROR";
   return $para;
}

sub clone {
   my ( $self ) = @_;

   my %clone = map {
      my $hashref  = $self->{$_};
      my $val_copy = {};
      foreach my $key ( keys %$hashref ) {
         my $ref = ref $hashref->{$key};
         $val_copy->{$key} = !$ref           ? $hashref->{$key}
                           : $ref eq 'HASH'  ? { %{$hashref->{$key}} }
                           : $ref eq 'ARRAY' ? [ @{$hashref->{$key}} ]
                           : $hashref->{$key};
      }
      $_ => $val_copy;
   } qw(opts short_opts defaults);

   foreach my $scalar ( qw(got_opts) ) {
      $clone{$scalar} = $self->{$scalar};
   }

   return bless \%clone;     
}

sub _parse_size {
   my ( $self, $opt, $val ) = @_;

   if ( lc($val || '') eq 'null' ) {
      MKDEBUG && _d('NULL size for', $opt->{long});
      $opt->{value} = 'null';
      return;
   }

   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);
   my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
   if ( defined $num ) {
      if ( $factor ) {
         $num *= $factor_for{$factor};
         MKDEBUG && _d('Setting option', $opt->{y},
            'to num', $num, '* factor', $factor);
      }
      $opt->{value} = ($pre || '') . $num;
   }
   else {
      $self->save_error("Invalid size for --$opt->{long}: $val");
   }
   return;
}

sub _parse_attribs {
   my ( $self, $option, $attribs ) = @_;
   my $types = $self->{types};
   return $option
      . ($attribs->{'short form'} ? '|' . $attribs->{'short form'}   : '' )
      . ($attribs->{'negatable'}  ? '!'                              : '' )
      . ($attribs->{'cumulative'} ? '+'                              : '' )
      . ($attribs->{'type'}       ? '=' . $types->{$attribs->{type}} : '' );
}

sub _parse_synopsis {
   my ( $self, $file ) = @_;
   $file ||= $self->{file} || __FILE__;
   MKDEBUG && _d("Parsing SYNOPSIS in", $file);

   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
   my $para;
   1 while defined($para = <$fh>) && $para !~ m/^=head1 SYNOPSIS/;
   die "$file does not contain a SYNOPSIS section" unless $para;
   my @synop;
   for ( 1..2 ) {  # 1 for the usage, 2 for the description
      my $para = <$fh>;
      push @synop, $para;
   }
   close $fh;
   MKDEBUG && _d("Raw SYNOPSIS text:", @synop);
   my ($usage, $desc) = @synop;
   die "The SYNOPSIS section in $file is not formatted properly"
      unless $usage && $desc;

   $usage =~ s/^\s*Usage:\s+(.+)/$1/;
   chomp $usage;

   $desc =~ s/\n/ /g;
   $desc =~ s/\s{2,}/ /g;
   $desc =~ s/\. ([A-Z][a-z])/.  $1/g;
   $desc =~ s/\s+$//;

   return (
      description => $desc,
      usage       => $usage,
   );
};

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

if ( MKDEBUG ) {
   print '# ', $^X, ' ', $], "\n";
   if ( my $uname = `uname -a` ) {
      $uname =~ s/\s+/ /g;
      print "# $uname\n";
   }
   print '# Arguments: ',
      join(' ', map { my $a = "_[$_]_"; $a =~ s/\n/\n# /g; $a; } @ARGV), "\n";
}

1;
}
# ###########################################################################
# End OptionParser package
# ###########################################################################

# ###########################################################################
# Cxn package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Cxn.pm
#   t/lib/Cxn.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Cxn;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(DSNParser OptionParser);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   };
   my ($dp, $o) = @args{@required_args};

   my $dsn_defaults = $dp->parse_options($o);
   my $prev_dsn     = $args{prev_dsn};
   my $dsn          = $args{dsn};
   if ( !$dsn ) {
      $args{dsn_string} ||= 'h=' . ($dsn_defaults->{h} || 'localhost');

      $dsn = $dp->parse(
         $args{dsn_string}, $prev_dsn, $dsn_defaults);
   }
   elsif ( $prev_dsn ) {
      $dsn = $dp->copy($prev_dsn, $dsn);
   }

   my $self = {
      dsn          => $dsn,
      dbh          => $args{dbh},
      dsn_name     => $dp->as_string($dsn, [qw(h P S)]),
      hostname     => '',
      set          => $args{set},
      dbh_set      => 0,
      OptionParser => $o,
      DSNParser    => $dp,
   };

   return bless $self, $class;
}

sub connect {
   my ( $self ) = @_;
   my $dsn = $self->{dsn};
   my $dp  = $self->{DSNParser};
   my $o   = $self->{OptionParser};

   my $dbh = $self->{dbh};
   if ( !$dbh || !$dbh->ping() ) {
      if ( $o->get('ask-pass') && !$self->{asked_for_pass} ) {
         $dsn->{p} = OptionParser::prompt_noecho("Enter MySQL password: ");
         $self->{asked_for_pass} = 1;
      }
      $dbh = $dp->get_dbh($dp->get_cxn_params($dsn),  { AutoCommit => 1 });
   }
   MKDEBUG && _d($dbh, 'Connected dbh to', $self->{name});

   return $self->set_dbh($dbh);
}

sub set_dbh {
   my ($self, $dbh) = @_;

   if ( $self->{dbh} && $self->{dbh} == $dbh && $self->{dbh_set} ) {
      MKDEBUG && _d($dbh, 'Already set dbh');
      return $dbh;
   }

   MKDEBUG && _d($dbh, 'Setting dbh');

   $dbh->{FetchHashKeyName} = 'NAME_lc';
   
   my $sql = 'SELECT @@hostname, @@server_id';
   MKDEBUG && _d($dbh, $sql);
   my ($hostname, $server_id) = $dbh->selectrow_array($sql);
   MKDEBUG && _d($dbh, 'hostname:', $hostname, $server_id);
   if ( $hostname ) {
      $self->{hostname} = $hostname;
   }

   if ( my $set = $self->{set}) {
      $set->($dbh);
   }

   $self->{dbh}     = $dbh;
   $self->{dbh_set} = 1;
   return $dbh;
}

sub dbh {
   my ($self) = @_;
   return $self->{dbh};
}

sub dsn {
   my ($self) = @_;
   return $self->{dsn};
}

sub name {
   my ($self) = @_;
   return $self->{dsn_name} if PERCONA_TOOLKIT_TEST_USE_DSN_NAMES;
   return $self->{hostname} || $self->{dsn_name} || 'unknown host';
}

sub DESTROY {
   my ($self) = @_;
   if ( $self->{dbh} ) {
      MKDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});
      $self->{dbh}->disconnect();
   }
   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End Cxn package
# ###########################################################################

# ###########################################################################
# Quoter package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Quoter.pm
#   t/lib/Quoter.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Quoter;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   return bless {}, $class;
}

sub quote {
   my ( $self, @vals ) = @_;
   foreach my $val ( @vals ) {
      $val =~ s/`/``/g;
   }
   return join('.', map { '`' . $_ . '`' } @vals);
}

sub quote_val {
   my ( $self, $val ) = @_;

   return 'NULL' unless defined $val;          # undef = NULL
   return "''" if $val eq '';                  # blank string = ''
   return $val if $val =~ m/^0x[0-9a-fA-F]+$/;  # hex data

   $val =~ s/(['\\])/\\$1/g;
   return "'$val'";
}

sub split_unquote {
   my ( $self, $db_tbl, $default_db ) = @_;
   $db_tbl =~ s/`//g;
   my ( $db, $tbl ) = split(/[.]/, $db_tbl);
   if ( !$tbl ) {
      $tbl = $db;
      $db  = $default_db;
   }
   return ($db, $tbl);
}

sub literal_like {
   my ( $self, $like ) = @_;
   return unless $like;
   $like =~ s/([%_])/\\$1/g;
   return "'$like'";
}

sub join_quote {
   my ( $self, $default_db, $db_tbl ) = @_;
   return unless $db_tbl;
   my ($db, $tbl) = split(/[.]/, $db_tbl);
   if ( !$tbl ) {
      $tbl = $db;
      $db  = $default_db;
   }
   $db  = "`$db`"  if $db  && $db  !~ m/^`/;
   $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/;
   return $db ? "$db.$tbl" : $tbl;
}

1;
}
# ###########################################################################
# End Quoter package
# ###########################################################################

# ###########################################################################
# VersionParser package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/VersionParser.pm
#   t/lib/VersionParser.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package VersionParser;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class ) = @_;
   bless {}, $class;
}

sub parse {
   my ( $self, $str ) = @_;
   my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);
   MKDEBUG && _d($str, 'parses to', $result);
   return $result;
}

sub version_ge {
   my ( $self, $dbh, $target ) = @_;
   if ( !$self->{$dbh} ) {
      $self->{$dbh} = $self->parse(
         $dbh->selectrow_array('SELECT VERSION()'));
   }
   my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
   MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
   return $result;
}

sub innodb_version {
   my ( $self, $dbh ) = @_;
   return unless $dbh;
   my $innodb_version = "NO";

   my ($innodb) =
      grep { $_->{engine} =~ m/InnoDB/i }
      map  {
         my %hash;
         @hash{ map { lc $_ } keys %$_ } = values %$_;
         \%hash;
      }
      @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
   if ( $innodb ) {
      MKDEBUG && _d("InnoDB support:", $innodb->{support});
      if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
         my $vars = $dbh->selectrow_hashref(
            "SHOW VARIABLES LIKE 'innodb_version'");
         $innodb_version = !$vars ? "BUILTIN"
                         :          ($vars->{Value} || $vars->{value});
      }
      else {
         $innodb_version = $innodb->{support};  # probably DISABLED or NO
      }
   }

   MKDEBUG && _d("InnoDB version:", $innodb_version);
   return $innodb_version;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End VersionParser package
# ###########################################################################

# ###########################################################################
# TableParser package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/TableParser.pm
#   t/lib/TableParser.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package TableParser;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Quotekeys = 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $self = { %args };
   return bless $self, $class;
}

sub get_create_table {
   my ( $self, $dbh, $db, $tbl ) = @_;
   die "I need a dbh parameter" unless $dbh;
   die "I need a db parameter"  unless $db;
   die "I need a tbl parameter" unless $tbl;
   my $q = $self->{Quoter};

   my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
           . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
           . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
           . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
   MKDEBUG && _d($sql);
   eval { $dbh->do($sql); };
   MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);

   $sql = 'USE ' . $q->quote($db);
   MKDEBUG && _d($dbh, $sql);
   $dbh->do($sql);

   $sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
   MKDEBUG && _d($sql);
   my $href;
   eval { $href = $dbh->selectrow_hashref($sql); };
   if ( $EVAL_ERROR ) {
      MKDEBUG && _d($EVAL_ERROR);
      return;
   }

   $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
        . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
   MKDEBUG && _d($sql);
   $dbh->do($sql);

   my ($key) = grep { m/create table/i } keys %$href;
   if ( $key ) {
      MKDEBUG && _d('This table is a base table');
      $href->{$key}  =~ s/\b[ ]{2,}/ /g;
      $href->{$key} .= "\n";
   }
   else {
      MKDEBUG && _d('This table is a view');
      ($key) = grep { m/create view/i } keys %$href;
   }

   return $href->{$key};
}

sub parse {
   my ( $self, $ddl, $opts ) = @_;
   return unless $ddl;

   if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
      die "Cannot parse table definition; is ANSI quoting "
         . "enabled or SQL_QUOTE_SHOW_CREATE disabled?";
   }

   my ($name)     = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
   (undef, $name) = $self->{Quoter}->split_unquote($name) if $name;

   $ddl =~ s/(`[^`]+`)/\L$1/g;

   my $engine = $self->get_engine($ddl);

   my @defs   = $ddl =~ m/^(\s+`.*?),?$/gm;
   my @cols   = map { $_ =~ m/`([^`]+)`/ } @defs;
   MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols));

   my %def_for;
   @def_for{@cols} = @defs;

   my (@nums, @null);
   my (%type_for, %is_nullable, %is_numeric, %is_autoinc);
   foreach my $col ( @cols ) {
      my $def = $def_for{$col};
      my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/;
      die "Can't determine column type for $def" unless $type;
      $type_for{$col} = $type;
      if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) {
         push @nums, $col;
         $is_numeric{$col} = 1;
      }
      if ( $def !~ m/NOT NULL/ ) {
         push @null, $col;
         $is_nullable{$col} = 1;
      }
      $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0;
   }

   my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable);

   my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/;

   return {
      name           => $name,
      cols           => \@cols,
      col_posn       => { map { $cols[$_] => $_ } 0..$#cols },
      is_col         => { map { $_ => 1 } @cols },
      null_cols      => \@null,
      is_nullable    => \%is_nullable,
      is_autoinc     => \%is_autoinc,
      clustered_key  => $clustered_key,
      keys           => $keys,
      defs           => \%def_for,
      numeric_cols   => \@nums,
      is_numeric     => \%is_numeric,
      engine         => $engine,
      type_for       => \%type_for,
      charset        => $charset,
   };
}

sub sort_indexes {
   my ( $self, $tbl ) = @_;

   my @indexes
      = sort {
         (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY'))
         || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} )
         || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} )
         || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) )
      }
      grep {
         $tbl->{keys}->{$_}->{type} eq 'BTREE'
      }
      sort keys %{$tbl->{keys}};

   MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes));
   return @indexes;
}

sub find_best_index {
   my ( $self, $tbl, $index ) = @_;
   my $best;
   if ( $index ) {
      ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}};
   }
   if ( !$best ) {
      if ( $index ) {
         die "Index '$index' does not exist in table";
      }
      else {
         ($best) = $self->sort_indexes($tbl);
      }
   }
   MKDEBUG && _d('Best index found is', $best);
   return $best;
}

sub find_possible_keys {
   my ( $self, $dbh, $database, $table, $quoter, $where ) = @_;
   return () unless $where;
   my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table)
      . ' WHERE ' . $where;
   MKDEBUG && _d($sql);
   my $expl = $dbh->selectrow_hashref($sql);
   $expl = { map { lc($_) => $expl->{$_} } keys %$expl };
   if ( $expl->{possible_keys} ) {
      MKDEBUG && _d('possible_keys =', $expl->{possible_keys});
      my @candidates = split(',', $expl->{possible_keys});
      my %possible   = map { $_ => 1 } @candidates;
      if ( $expl->{key} ) {
         MKDEBUG && _d('MySQL chose', $expl->{key});
         unshift @candidates, grep { $possible{$_} } split(',', $expl->{key});
         MKDEBUG && _d('Before deduping:', join(', ', @candidates));
         my %seen;
         @candidates = grep { !$seen{$_}++ } @candidates;
      }
      MKDEBUG && _d('Final list:', join(', ', @candidates));
      return @candidates;
   }
   else {
      MKDEBUG && _d('No keys in possible_keys');
      return ();
   }
}

sub check_table {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh db tbl);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $db, $tbl) = @args{@required_args};
   my $q      = $self->{Quoter};
   my $db_tbl = $q->quote($db, $tbl);
   MKDEBUG && _d('Checking', $db_tbl);

   my $sql = "SHOW TABLES FROM " . $q->quote($db)
           . ' LIKE ' . $q->literal_like($tbl);
   MKDEBUG && _d($sql);
   my $row;
   eval {
      $row = $dbh->selectrow_arrayref($sql);
   };
   if ( $EVAL_ERROR ) {
      MKDEBUG && _d($EVAL_ERROR);
      return 0;
   }
   if ( !$row->[0] || $row->[0] ne $tbl ) {
      MKDEBUG && _d('Table does not exist');
      return 0;
   }

   MKDEBUG && _d('Table exists; no privs to check');
   return 1 unless $args{all_privs};

   $sql = "SHOW FULL COLUMNS FROM $db_tbl";
   MKDEBUG && _d($sql);
   eval {
      $row = $dbh->selectrow_hashref($sql);
   };
   if ( $EVAL_ERROR ) {
      MKDEBUG && _d($EVAL_ERROR);
      return 0;
   }
   if ( !scalar keys %$row ) {
      MKDEBUG && _d('Table has no columns:', Dumper($row));
      return 0;
   }
   my $privs = $row->{privileges} || $row->{Privileges};

   $sql = "DELETE FROM $db_tbl LIMIT 0";
   MKDEBUG && _d($sql);
   eval {
      $dbh->do($sql);
   };
   my $can_delete = $EVAL_ERROR ? 0 : 1;

   MKDEBUG && _d('User privs on', $db_tbl, ':', $privs,
      ($can_delete ? 'delete' : ''));

   if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/
          && $can_delete) ) {
      MKDEBUG && _d('User does not have all privs');
      return 0;
   }

   MKDEBUG && _d('User has all privs');
   return 1;
}

sub get_engine {
   my ( $self, $ddl, $opts ) = @_;
   my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/;
   MKDEBUG && _d('Storage engine:', $engine);
   return $engine || undef;
}

sub get_keys {
   my ( $self, $ddl, $opts, $is_nullable ) = @_;
   my $engine        = $self->get_engine($ddl);
   my $keys          = {};
   my $clustered_key = undef;

   KEY:
   foreach my $key ( $ddl =~ m/^  ((?:[A-Z]+ )?KEY .*)$/gm ) {

      next KEY if $key =~ m/FOREIGN/;

      my $key_ddl = $key;
      MKDEBUG && _d('Parsed key:', $key_ddl);

      if ( $engine !~ m/MEMORY|HEAP/ ) {
         $key =~ s/USING HASH/USING BTREE/;
      }

      my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
      my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
      $type = $type || $special || 'BTREE';
      if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
         && $engine =~ m/HEAP|MEMORY/i )
      {
         $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
      }

      my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
      my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
      my @cols;
      my @col_prefixes;
      foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) {
         my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/;
         push @cols, $name;
         push @col_prefixes, $prefix;
      }
      $name =~ s/`//g;

      MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols));

      $keys->{$name} = {
         name         => $name,
         type         => $type,
         colnames     => $cols,
         cols         => \@cols,
         col_prefixes => \@col_prefixes,
         is_unique    => $unique,
         is_nullable  => scalar(grep { $is_nullable->{$_} } @cols),
         is_col       => { map { $_ => 1 } @cols },
         ddl          => $key_ddl,
      };

      if ( $engine =~ m/InnoDB/i && !$clustered_key ) {
         my $this_key = $keys->{$name};
         if ( $this_key->{name} eq 'PRIMARY' ) {
            $clustered_key = 'PRIMARY';
         }
         elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) {
            $clustered_key = $this_key->{name};
         }
         MKDEBUG && $clustered_key && _d('This key is the clustered key');
      }
   }

   return $keys, $clustered_key;
}

sub get_fks {
   my ( $self, $ddl, $opts ) = @_;
   my $q   = $self->{Quoter};
   my $fks = {};

   foreach my $fk (
      $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg )
   {
      my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/;
      my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/;
      my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/;

      my ($db, $tbl) = $q->split_unquote($parent, $opts->{database});
      my %parent_tbl = (tbl => $tbl);
      $parent_tbl{db} = $db if $db;

      if ( $parent !~ m/\./ && $opts->{database} ) {
         $parent = $q->quote($opts->{database}) . ".$parent";
      }

      $fks->{$name} = {
         name           => $name,
         colnames       => $cols,
         cols           => [ map { s/[ `]+//g; $_; } split(',', $cols) ],
         parent_tbl     => \%parent_tbl,
         parent_tblname => $parent,
         parent_cols    => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ],
         parent_colnames=> $parent_cols,
         ddl            => $fk,
      };
   }

   return $fks;
}

sub remove_auto_increment {
   my ( $self, $ddl ) = @_;
   $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m;
   return $ddl;
}

sub get_table_status {
   my ( $self, $dbh, $db, $like ) = @_;
   my $q = $self->{Quoter};
   my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db);
   my @params;
   if ( $like ) {
      $sql .= ' LIKE ?';
      push @params, $like;
   }
   MKDEBUG && _d($sql, @params);
   my $sth = $dbh->prepare($sql);
   eval { $sth->execute(@params); };
   if ($EVAL_ERROR) {
      MKDEBUG && _d($EVAL_ERROR);
      return;
   }
   my @tables = @{$sth->fetchall_arrayref({})};
   @tables = map {
      my %tbl; # Make a copy with lowercased keys
      @tbl{ map { lc $_ } keys %$_ } = values %$_;
      $tbl{engine} ||= $tbl{type} || $tbl{comment};
      delete $tbl{type};
      \%tbl;
   } @tables;
   return @tables;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End TableParser package
# ###########################################################################

# ###########################################################################
# TableNibbler package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/TableNibbler.pm
#   t/lib/TableNibbler.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package TableNibbler;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(TableParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $self = { %args };
   return bless $self, $class;
}

sub generate_asc_stmt {
   my ( $self, %args ) = @_;
   my @required_args = qw(tbl_struct index);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   my ($tbl_struct, $index) = @args{@required_args};
   my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}};
   my $q    = $self->{Quoter};

   die "Index '$index' does not exist in table"
      unless exists $tbl_struct->{keys}->{$index};
   MKDEBUG && _d('Will ascend index', $index);  

   my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}};
   if ( $args{asc_first} ) {
      @asc_cols = $asc_cols[0];
      MKDEBUG && _d('Ascending only first column');
   }
   MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols));

   my @asc_slice;
   my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };
   foreach my $col ( @asc_cols ) {
      if ( !exists $col_posn{$col} ) {
         push @cols, $col;
         $col_posn{$col} = $#cols;
      }
      push @asc_slice, $col_posn{$col};
   }
   MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice));

   my $asc_stmt = {
      cols  => \@cols,
      index => $index,
      where => '',
      slice => [],
      scols => [],
   };

   if ( @asc_slice ) {
      my $cmp_where;
      foreach my $cmp ( qw(< <= >= >) ) {
         $cmp_where = $self->generate_cmp_where(
            type        => $cmp,
            slice       => \@asc_slice,
            cols        => \@cols,
            quoter      => $q,
            is_nullable => $tbl_struct->{is_nullable},
         );
         $asc_stmt->{boundaries}->{$cmp} = $cmp_where->{where};
      }
      my $cmp = $args{asc_only} ? '>' : '>=';
      $asc_stmt->{where} = $asc_stmt->{boundaries}->{$cmp};
      $asc_stmt->{slice} = $cmp_where->{slice};
      $asc_stmt->{scols} = $cmp_where->{scols};
   }

   return $asc_stmt;
}

sub generate_cmp_where {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(type slice cols is_nullable) ) {
      die "I need a $arg arg" unless defined $args{$arg};
   }
   my @slice       = @{$args{slice}};
   my @cols        = @{$args{cols}};
   my $is_nullable = $args{is_nullable};
   my $type        = $args{type};
   my $q           = $self->{Quoter};

   (my $cmp = $type) =~ s/=//;

   my @r_slice;    # Resulting slice columns, by ordinal
   my @r_scols;    # Ditto, by name

   my @clauses;
   foreach my $i ( 0 .. $#slice ) {
      my @clause;

      foreach my $j ( 0 .. $i - 1 ) {
         my $ord = $slice[$j];
         my $col = $cols[$ord];
         my $quo = $q->quote($col);
         if ( $is_nullable->{$col} ) {
            push @clause, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))";
            push @r_slice, $ord, $ord;
            push @r_scols, $col, $col;
         }
         else {
            push @clause, "$quo = ?";
            push @r_slice, $ord;
            push @r_scols, $col;
         }
      }

      my $ord = $slice[$i];
      my $col = $cols[$ord];
      my $quo = $q->quote($col);
      my $end = $i == $#slice; # Last clause of the whole group.
      if ( $is_nullable->{$col} ) {
         if ( $type =~ m/=/ && $end ) {
            push @clause, "(? IS NULL OR $quo $type ?)";
         }
         elsif ( $type =~ m/>/ ) {
            push @clause, "((? IS NULL AND $quo IS NOT NULL) OR ($quo $cmp ?))";
         }
         else { # If $type =~ m/</ ) {
            push @clause, "((? IS NOT NULL AND $quo IS NULL) OR ($quo $cmp ?))";
         }
         push @r_slice, $ord, $ord;
         push @r_scols, $col, $col;
      }
      else {
         push @r_slice, $ord;
         push @r_scols, $col;
         push @clause, ($type =~ m/=/ && $end ? "$quo $type ?" : "$quo $cmp ?");
      }

      push @clauses, '(' . join(' AND ', @clause) . ')';
   }
   my $result = '(' . join(' OR ', @clauses) . ')';
   my $where = {
      slice => \@r_slice,
      scols => \@r_scols,
      where => $result,
   };
   return $where;
}

sub generate_del_stmt {
   my ( $self, %args ) = @_;

   my $tbl  = $args{tbl_struct};
   my @cols = $args{cols} ? @{$args{cols}} : ();
   my $tp   = $self->{TableParser};
   my $q    = $self->{Quoter};

   my @del_cols;
   my @del_slice;

   my $index = $tp->find_best_index($tbl, $args{index});
   die "Cannot find an ascendable index in table" unless $index;

   if ( $index ) {
      @del_cols = @{$tbl->{keys}->{$index}->{cols}};
   }
   else {
      @del_cols = @{$tbl->{cols}};
   }
   MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols));

   my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };
   foreach my $col ( @del_cols ) {
      if ( !exists $col_posn{$col} ) {
         push @cols, $col;
         $col_posn{$col} = $#cols;
      }
      push @del_slice, $col_posn{$col};
   }
   MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice));

   my $del_stmt = {
      cols  => \@cols,
      index => $index,
      where => '',
      slice => [],
      scols => [],
   };

   my @clauses;
   foreach my $i ( 0 .. $#del_slice ) {
      my $ord = $del_slice[$i];
      my $col = $cols[$ord];
      my $quo = $q->quote($col);
      if ( $tbl->{is_nullable}->{$col} ) {
         push @clauses, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))";
         push @{$del_stmt->{slice}}, $ord, $ord;
         push @{$del_stmt->{scols}}, $col, $col;
      }
      else {
         push @clauses, "$quo = ?";
         push @{$del_stmt->{slice}}, $ord;
         push @{$del_stmt->{scols}}, $col;
      }
   }

   $del_stmt->{where} = '(' . join(' AND ', @clauses) . ')';

   return $del_stmt;
}

sub generate_ins_stmt {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(ins_tbl sel_cols) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $ins_tbl  = $args{ins_tbl};
   my @sel_cols = @{$args{sel_cols}};

   die "You didn't specify any SELECT columns" unless @sel_cols;

   my @ins_cols;
   my @ins_slice;
   for my $i ( 0..$#sel_cols ) {
      next unless $ins_tbl->{is_col}->{$sel_cols[$i]};
      push @ins_cols, $sel_cols[$i];
      push @ins_slice, $i;
   }

   return {
      cols  => \@ins_cols,
      slice => \@ins_slice,
   };
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End TableNibbler package
# ###########################################################################

# ###########################################################################
# MasterSlave package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/MasterSlave.pm
#   t/lib/MasterSlave.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package MasterSlave;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   my $self = {
      %args,
      replication_thread => {},
   };
   return bless $self, $class;
}

sub get_slaves {
   my ($self, %args) = @_;
   my @required_args = qw(make_cxn OptionParser DSNParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($make_cxn, $o, $dp) = @args{@required_args};

   my $slaves = [];
   my $method = $o->get('recursion-method');
   MKDEBUG && _d('Slave recursion method:', $method);
   if ( !$method || $method =~ m/proocesslist|hosts/i ) {
      my @required_args = qw(dbh dsn);
      foreach my $arg ( @required_args ) {
         die "I need a $arg argument" unless $args{$arg};
      }
      my ($dbh, $dsn) = @args{@required_args};
      $self->recurse_to_slaves(
         {  dbh        => $dbh,
            dsn        => $dsn,
            dsn_parser => $dp,
            recurse    => $o->get('recurse'),
            method     => $o->get('recursion-method'),
            callback   => sub {
               my ( $dsn, $dbh, $level, $parent ) = @_;
               return unless $level;
               MKDEBUG && _d('Found slave:', $dp->as_string($dsn));
               push @$slaves, $make_cxn->(dsn => $dsn, dbh => $dbh);
               return;
            },
         }
      );
   }
   elsif ( $method =~ m/^dsn=/i ) {
      my ($dsn_table_dsn) = $method =~ m/^dsn=(.+)/i;
      $slaves = $self->get_cxn_from_dsn_table(
         %args,
         dsn_table_dsn => $dsn_table_dsn,
      );
   }
   else {
      die "Invalid --recusion-method: $method.  Valid values are: "
        . "dsn=DSN, hosts, or processlist.\n";
   }

   return $slaves;
}

sub recurse_to_slaves {
   my ( $self, $args, $level ) = @_;
   $level ||= 0;
   my $dp   = $args->{dsn_parser};
   my $dsn  = $args->{dsn};

   my $dbh;
   eval {
      $dbh = $args->{dbh} || $dp->get_dbh(
         $dp->get_cxn_params($dsn), { AutoCommit => 1 });
      MKDEBUG && _d('Connected to', $dp->as_string($dsn));
   };
   if ( $EVAL_ERROR ) {
      print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n"
         or die "Cannot print: $OS_ERROR";
      return;
   }

   my $sql  = 'SELECT @@SERVER_ID';
   MKDEBUG && _d($sql);
   my ($id) = $dbh->selectrow_array($sql);
   MKDEBUG && _d('Working on server ID', $id);
   my $master_thinks_i_am = $dsn->{server_id};
   if ( !defined $id
       || ( defined $master_thinks_i_am && $master_thinks_i_am != $id )
       || $args->{server_ids_seen}->{$id}++
   ) {
      MKDEBUG && _d('Server ID seen, or not what master said');
      if ( $args->{skip_callback} ) {
         $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent});
      }
      return;
   }

   $args->{callback}->($dsn, $dbh, $level, $args->{parent});

   if ( !defined $args->{recurse} || $level < $args->{recurse} ) {

      my @slaves =
         grep { !$_->{master_id} || $_->{master_id} == $id } # Only my slaves.
         $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method});

      foreach my $slave ( @slaves ) {
         MKDEBUG && _d('Recursing from',
            $dp->as_string($dsn), 'to', $dp->as_string($slave));
         $self->recurse_to_slaves(
            { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 );
      }
   }
}

sub find_slave_hosts {
   my ( $self, $dsn_parser, $dbh, $dsn, $method ) = @_;

   my @methods = qw(processlist hosts);
   if ( $method ) {
      @methods = grep { $_ ne $method } @methods;
      unshift @methods, $method;
   }
   else {
      if ( ($dsn->{P} || 3306) != 3306 ) {
         MKDEBUG && _d('Port number is non-standard; using only hosts method');
         @methods = qw(hosts);
      }
   }
   MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn),
      'using methods', @methods);

   my @slaves;
   METHOD:
   foreach my $method ( @methods ) {
      my $find_slaves = "_find_slaves_by_$method";
      MKDEBUG && _d('Finding slaves with', $find_slaves);
      @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn);
      last METHOD if @slaves;
   }

   MKDEBUG && _d('Found', scalar(@slaves), 'slaves');
   return @slaves;
}

sub _find_slaves_by_processlist {
   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;

   my @slaves = map  {
      my $slave        = $dsn_parser->parse("h=$_", $dsn);
      $slave->{source} = 'processlist';
      $slave;
   }
   grep { $_ }
   map  {
      my ( $host ) = $_->{host} =~ m/^([^:]+):/;
      if ( $host eq 'localhost' ) {
         $host = '127.0.0.1'; # Replication never uses sockets.
      }
      $host;
   } $self->get_connected_slaves($dbh);

   return @slaves;
}

sub _find_slaves_by_hosts {
   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;

   my @slaves;
   my $sql = 'SHOW SLAVE HOSTS';
   MKDEBUG && _d($dbh, $sql);
   @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })};

   if ( @slaves ) {
      MKDEBUG && _d('Found some SHOW SLAVE HOSTS info');
      @slaves = map {
         my %hash;
         @hash{ map { lc $_ } keys %$_ } = values %$_;
         my $spec = "h=$hash{host},P=$hash{port}"
            . ( $hash{user} ? ",u=$hash{user}" : '')
            . ( $hash{password} ? ",p=$hash{password}" : '');
         my $dsn           = $dsn_parser->parse($spec, $dsn);
         $dsn->{server_id} = $hash{server_id};
         $dsn->{master_id} = $hash{master_id};
         $dsn->{source}    = 'hosts';
         $dsn;
      } @slaves;
   }

   return @slaves;
}

sub get_connected_slaves {
   my ( $self, $dbh ) = @_;

   my $show = "SHOW GRANTS FOR ";
   my $user = 'CURRENT_USER()';
   my $vp   = $self->{VersionParser};
   if ( $vp && !$vp->version_ge($dbh, '4.1.2') ) {
      $user = $dbh->selectrow_arrayref('SELECT USER()')->[0];
      $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/;
   }
   my $sql = $show . $user;
   MKDEBUG && _d($dbh, $sql);

   my $proc;
   eval {
      $proc = grep {
         m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
      } @{$dbh->selectcol_arrayref($sql)};
   };
   if ( $EVAL_ERROR ) {

      if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) {
         MKDEBUG && _d('Retrying SHOW GRANTS without host; error:',
            $EVAL_ERROR);
         ($user) = split('@', $user);
         $sql    = $show . $user;
         MKDEBUG && _d($sql);
         eval {
            $proc = grep {
               m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
            } @{$dbh->selectcol_arrayref($sql)};
         };
      }

      die "Failed to $sql: $EVAL_ERROR" if $EVAL_ERROR;
   }
   if ( !$proc ) {
      die "You do not have the PROCESS privilege";
   }

   $sql = 'SHOW PROCESSLIST';
   MKDEBUG && _d($dbh, $sql);
   grep { $_->{command} =~ m/Binlog Dump/i }
   map  { # Lowercase the column names
      my %hash;
      @hash{ map { lc $_ } keys %$_ } = values %$_;
      \%hash;
   }
   @{$dbh->selectall_arrayref($sql, { Slice => {} })};
}

sub is_master_of {
   my ( $self, $master, $slave ) = @_;
   my $master_status = $self->get_master_status($master)
      or die "The server specified as a master is not a master";
   my $slave_status  = $self->get_slave_status($slave)
      or die "The server specified as a slave is not a slave";
   my @connected     = $self->get_connected_slaves($master)
      or die "The server specified as a master has no connected slaves";
   my (undef, $port) = $master->selectrow_array('SHOW VARIABLES LIKE "port"');

   if ( $port != $slave_status->{master_port} ) {
      die "The slave is connected to $slave_status->{master_port} "
         . "but the master's port is $port";
   }

   if ( !grep { $slave_status->{master_user} eq $_->{user} } @connected ) {
      die "I don't see any slave I/O thread connected with user "
         . $slave_status->{master_user};
   }

   if ( ($slave_status->{slave_io_state} || '')
      eq 'Waiting for master to send event' )
   {
      my ( $master_log_name, $master_log_num )
         = $master_status->{file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
      my ( $slave_log_name, $slave_log_num )
         = $slave_status->{master_log_file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
      if ( $master_log_name ne $slave_log_name
         || abs($master_log_num - $slave_log_num) > 1 )
      {
         die "The slave thinks it is reading from "
            . "$slave_status->{master_log_file},  but the "
            . "master is writing to $master_status->{file}";
      }
   }
   return 1;
}

sub get_master_dsn {
   my ( $self, $dbh, $dsn, $dsn_parser ) = @_;
   my $master = $self->get_slave_status($dbh) or return undef;
   my $spec   = "h=$master->{master_host},P=$master->{master_port}";
   return       $dsn_parser->parse($spec, $dsn);
}

sub get_slave_status {
   my ( $self, $dbh ) = @_;
   if ( !$self->{not_a_slave}->{$dbh} ) {
      my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS}
            ||= $dbh->prepare('SHOW SLAVE STATUS');
      MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS');
      $sth->execute();
      my ($ss) = @{$sth->fetchall_arrayref({})};

      if ( $ss && %$ss ) {
         $ss = { map { lc($_) => $ss->{$_} } keys %$ss }; # lowercase the keys
         return $ss;
      }

      MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS');
      $self->{not_a_slave}->{$dbh}++;
   }
}

sub get_master_status {
   my ( $self, $dbh ) = @_;

   if ( $self->{not_a_master}->{$dbh} ) {
      MKDEBUG && _d('Server on dbh', $dbh, 'is not a master');
      return;
   }

   my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS}
         ||= $dbh->prepare('SHOW MASTER STATUS');
   MKDEBUG && _d($dbh, 'SHOW MASTER STATUS');
   $sth->execute();
   my ($ms) = @{$sth->fetchall_arrayref({})};
   MKDEBUG && _d(
      $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
          : '');

   if ( !$ms || scalar keys %$ms < 2 ) {
      MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master');
      $self->{not_a_master}->{$dbh}++;
   }

  return { map { lc($_) => $ms->{$_} } keys %$ms }; # lowercase the keys
}

sub wait_for_master {
   my ( $self, %args ) = @_;
   my @required_args = qw(master_status slave_dbh);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($master_status, $slave_dbh) = @args{@required_args};
   my $timeout       = $args{timeout} || 60;

   my $result;
   my $waited;
   if ( $master_status ) {
      my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', "
              . "$master_status->{position}, $timeout)";
      MKDEBUG && _d($slave_dbh, $sql);
      my $start = time;
      ($result) = $slave_dbh->selectrow_array($sql);

      $waited = time - $start;

      MKDEBUG && _d('Result of waiting:', $result);
      MKDEBUG && _d("Waited", $waited, "seconds");
   }
   else {
      MKDEBUG && _d('Not waiting: this server is not a master');
   }

   return {
      result => $result,
      waited => $waited,
   };
}

sub stop_slave {
   my ( $self, $dbh ) = @_;
   my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE}
         ||= $dbh->prepare('STOP SLAVE');
   MKDEBUG && _d($dbh, $sth->{Statement});
   $sth->execute();
}

sub start_slave {
   my ( $self, $dbh, $pos ) = @_;
   if ( $pos ) {
      my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', "
              . "MASTER_LOG_POS=$pos->{position}";
      MKDEBUG && _d($dbh, $sql);
      $dbh->do($sql);
   }
   else {
      my $sth = $self->{sths}->{$dbh}->{START_SLAVE}
            ||= $dbh->prepare('START SLAVE');
      MKDEBUG && _d($dbh, $sth->{Statement});
      $sth->execute();
   }
}

sub catchup_to_master {
   my ( $self, $slave, $master, $timeout ) = @_;
   $self->stop_slave($master);
   $self->stop_slave($slave);
   my $slave_status  = $self->get_slave_status($slave);
   my $slave_pos     = $self->repl_posn($slave_status);
   my $master_status = $self->get_master_status($master);
   my $master_pos    = $self->repl_posn($master_status);
   MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos),
      'Slave position:', $self->pos_to_string($slave_pos));

   my $result;
   if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) {
      MKDEBUG && _d('Waiting for slave to catch up to master');
      $self->start_slave($slave, $master_pos);

      $result = $self->wait_for_master(
            master_status => $master_status,
            slave_dbh     => $slave,
            timeout       => $timeout,
            master_status => $master_status
      );
      if ( !defined $result->{result} ) {
         $slave_status = $self->get_slave_status($slave);
         if ( !$self->slave_is_running($slave_status) ) {
            MKDEBUG && _d('Master position:',
               $self->pos_to_string($master_pos),
               'Slave position:', $self->pos_to_string($slave_pos));
            $slave_pos = $self->repl_posn($slave_status);
            if ( $self->pos_cmp($slave_pos, $master_pos) != 0 ) {
               die "MASTER_POS_WAIT() returned NULL but slave has not "
                  . "caught up to master";
            }
            MKDEBUG && _d('Slave is caught up to master and stopped');
         }
         else {
            die "Slave has not caught up to master and it is still running";
         }
      }
   }
   else {
      MKDEBUG && _d("Slave is already caught up to master");
   }

   return $result;
}

sub catchup_to_same_pos {
   my ( $self, $s1_dbh, $s2_dbh ) = @_;
   $self->stop_slave($s1_dbh);
   $self->stop_slave($s2_dbh);
   my $s1_status = $self->get_slave_status($s1_dbh);
   my $s2_status = $self->get_slave_status($s2_dbh);
   my $s1_pos    = $self->repl_posn($s1_status);
   my $s2_pos    = $self->repl_posn($s2_status);
   if ( $self->pos_cmp($s1_pos, $s2_pos) < 0 ) {
      $self->start_slave($s1_dbh, $s2_pos);
   }
   elsif ( $self->pos_cmp($s2_pos, $s1_pos) < 0 ) {
      $self->start_slave($s2_dbh, $s1_pos);
   }

   $s1_status = $self->get_slave_status($s1_dbh);
   $s2_status = $self->get_slave_status($s2_dbh);
   $s1_pos    = $self->repl_posn($s1_status);
   $s2_pos    = $self->repl_posn($s2_status);

   if ( $self->slave_is_running($s1_status)
     || $self->slave_is_running($s2_status)
     || $self->pos_cmp($s1_pos, $s2_pos) != 0)
   {
      die "The servers aren't both stopped at the same position";
   }

}

sub slave_is_running {
   my ( $self, $slave_status ) = @_;
   return ($slave_status->{slave_sql_running} || 'No') eq 'Yes';
}

sub has_slave_updates {
   my ( $self, $dbh ) = @_;
   my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'};
   MKDEBUG && _d($dbh, $sql);
   my ($name, $value) = $dbh->selectrow_array($sql);
   return $value && $value =~ m/^(1|ON)$/;
}

sub repl_posn {
   my ( $self, $status ) = @_;
   if ( exists $status->{file} && exists $status->{position} ) {
      return {
         file     => $status->{file},
         position => $status->{position},
      };
   }
   else {
      return {
         file     => $status->{relay_master_log_file},
         position => $status->{exec_master_log_pos},
      };
   }
}

sub get_slave_lag {
   my ( $self, $dbh ) = @_;
   my $stat = $self->get_slave_status($dbh);
   return unless $stat;  # server is not a slave
   return $stat->{seconds_behind_master};
}

sub pos_cmp {
   my ( $self, $a, $b ) = @_;
   return $self->pos_to_string($a) cmp $self->pos_to_string($b);
}

sub short_host {
   my ( $self, $dsn ) = @_;
   my ($host, $port);
   if ( $dsn->{master_host} ) {
      $host = $dsn->{master_host};
      $port = $dsn->{master_port};
   }
   else {
      $host = $dsn->{h};
      $port = $dsn->{P};
   }
   return ($host || '[default]') . ( ($port || 3306) == 3306 ? '' : ":$port" );
}

sub is_replication_thread {
   my ( $self, $query, %args ) = @_; 
   return unless $query;

   my $type = lc($args{type} || 'all');
   die "Invalid type: $type"
      unless $type =~ m/^binlog_dump|slave_io|slave_sql|all$/i;

   my $match = 0;
   if ( $type =~ m/binlog_dump|all/i ) {
      $match = 1
         if ($query->{Command} || $query->{command} || '') eq "Binlog Dump";
   }
   if ( !$match ) {
      if ( ($query->{User} || $query->{user} || '') eq "system user" ) {
         MKDEBUG && _d("Slave replication thread");
         if ( $type ne 'all' ) { 
            my $state = $query->{State} || $query->{state} || '';

            if ( $state =~ m/^init|end$/ ) {
               MKDEBUG && _d("Special state:", $state);
               $match = 1;
            }
            else {
               my ($slave_sql) = $state =~ m/
                  ^(Waiting\sfor\sthe\snext\sevent
                   |Reading\sevent\sfrom\sthe\srelay\slog
                   |Has\sread\sall\srelay\slog;\swaiting
                   |Making\stemp\sfile
                   |Waiting\sfor\sslave\smutex\son\sexit)/xi; 

               $match = $type eq 'slave_sql' &&  $slave_sql ? 1
                      : $type eq 'slave_io'  && !$slave_sql ? 1
                      :                                       0;
            }
         }
         else {
            $match = 1;
         }
      }
      else {
         MKDEBUG && _d('Not system user');
      }

      if ( !defined $args{check_known_ids} || $args{check_known_ids} ) {
         my $id = $query->{Id} || $query->{id};
         if ( $match ) {
            $self->{replication_thread}->{$id} = 1;
         }
         else {
            if ( $self->{replication_thread}->{$id} ) {
               MKDEBUG && _d("Thread ID is a known replication thread ID");
               $match = 1;
            }
         }
      }
   }

   MKDEBUG && _d('Matches', $type, 'replication thread:',
      ($match ? 'yes' : 'no'), '; match:', $match);

   return $match;
}


sub get_replication_filters {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh) = @args{@required_args};

   my %filters = ();

   my $status = $self->get_master_status($dbh);
   if ( $status ) {
      map { $filters{$_} = $status->{$_} }
      grep { defined $status->{$_} && $status->{$_} ne '' }
      qw(
         binlog_do_db
         binlog_ignore_db
      );
   }

   $status = $self->get_slave_status($dbh);
   if ( $status ) {
      map { $filters{$_} = $status->{$_} }
      grep { defined $status->{$_} && $status->{$_} ne '' }
      qw(
         replicate_do_db
         replicate_ignore_db
         replicate_do_table
         replicate_ignore_table 
         replicate_wild_do_table
         replicate_wild_ignore_table
      );

      my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'";
      MKDEBUG && _d($dbh, $sql);
      my $row = $dbh->selectrow_arrayref($sql);
      $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF';
   }

   return \%filters; 
}


sub pos_to_string {
   my ( $self, $pos ) = @_;
   my $fmt  = '%s/%020d';
   return sprintf($fmt, @{$pos}{qw(file position)});
}

sub reset_known_replication_threads {
   my ( $self ) = @_;
   $self->{replication_thread} = {};
   return;
}

sub get_cxn_from_dsn_table {
   my ($self, %args) = @_;
   my @required_args = qw(dsn_table_dsn make_cxn DSNParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dsn_table_dsn, $make_cxn, $dp, $q) = @args{@required_args};
   MKDEBUG && _d('DSN table DSN:', $dsn_table_dsn);

   my $dsn = $dp->parse($dsn_table_dsn);
   my $dsn_table;
   if ( $dsn->{D} && $dsn->{t} ) {
      $dsn_table = $q->quote($dsn->{D}, $dsn->{t});
   }
   elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) {
      $dsn_table = $q->quote($q->split_unquote($dsn->{t}));
   }
   else {
      die "DSN table DSN does not specify a database (D) "
        . "or a database-qualified table (t)";
   }

   my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
   my $dbh         = $dsn_tbl_cxn->connect();
   my $sql         = "SELECT dsn FROM $dsn_table ORDER BY id";
   MKDEBUG && _d($sql);
   my $dsn_strings = $dbh->selectcol_arrayref($sql);
   my @cxn;
   if ( $dsn_strings ) {
      foreach my $dsn_string ( @$dsn_strings ) {
         MKDEBUG && _d('DSN from DSN table:', $dsn_string);
         push @cxn, $make_cxn->(dsn_string => $dsn_string);
      }
   }
   return \@cxn;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End MasterSlave package
# ###########################################################################

# ###########################################################################
# RowChecksum package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/RowChecksum.pm
#   t/lib/RowChecksum.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package RowChecksum;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use List::Util qw(max);
use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Quotekeys = 0;

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(OptionParser Quoter) ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   my $self = { %args };
   return bless $self, $class;
}

sub make_row_checksum {
   my ( $self, %args ) = @_;
   my @required_args = qw(tbl);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($tbl) = @args{@required_args};

   my $o          = $self->{OptionParser};
   my $q          = $self->{Quoter};
   my $tbl_struct = $tbl->{tbl_struct};
   my $func       = $args{func} || uc($o->get('function'));
   my $cols       = $self->get_checksum_columns(%args);

   my $query;
   if ( !$args{no_cols} ) {
      $query = join(', ',
                  map { 
                     my $col = $_;
                     if ( $col =~ m/\+ 0/ ) {
                        my ($real_col) = /^(\S+)/;
                        $col .= " AS $real_col";
                     }
                     elsif ( $col =~ m/TRIM/ ) {
                        my ($real_col) = m/TRIM\(([^\)]+)\)/;
                        $col .= " AS $real_col";
                     }
                     $col;
                  } @{$cols->{select}})
             . ', ';
   }

   if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) {
      my $sep = $o->get('separator') || '#';
      $sep    =~ s/'//g;
      $sep  ||= '#';

      my @nulls = grep { $cols->{allowed}->{$_} } @{$tbl_struct->{null_cols}};
      if ( @nulls ) {
         my $bitmap = "CONCAT("
            . join(', ', map { 'ISNULL(' . $q->quote($_) . ')' } @nulls)
            . ")";
         push @{$cols->{select}}, $bitmap;
      }

      $query .= @{$cols->{select}} > 1
              ? "$func(CONCAT_WS('$sep', " . join(', ', @{$cols->{select}}) . '))'
              : "$func($cols->{select}->[0])";
   }
   else {
      my $fnv_func = uc $func;
      $query .= "$fnv_func(" . join(', ', @{$cols->{select}}) . ')';
   }

   MKDEBUG && _d('Row checksum:', $query);
   return $query;
}

sub make_chunk_checksum {
   my ( $self, %args ) = @_;
   my @required_args = qw(tbl);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   if ( !$args{dbh} && !($args{func} && $args{crc_width} && $args{crc_type}) ) {
      die "I need a dbh argument"
   }
   my ($tbl) = @args{@required_args};
   my $o     = $self->{OptionParser};
   my $q     = $self->{Quoter};

   my %crc_args = $self->get_crc_args(%args);
   MKDEBUG && _d("Checksum strat:", Dumper(\%crc_args));

   my $row_checksum = $self->make_row_checksum(
      %args,
      %crc_args,
      no_cols => 1
   );
   my $crc;
   if ( $crc_args{crc_type} =~ m/int$/ ) {
      $crc = "COALESCE(LOWER(CONV(BIT_XOR(CAST($row_checksum AS UNSIGNED)), "
           . "10, 16)), 0)";
   }
   else {
      my $slices = $self->_make_xor_slices(
         row_checksum => $row_checksum,
         %crc_args,
      );
      $crc = "COALESCE(LOWER(CONCAT($slices)), 0)";
   }

   my $select = "COUNT(*) AS cnt, $crc AS crc";
   MKDEBUG && _d('Chunk checksum:', $select);
   return $select;
}

sub get_checksum_columns {
   my ($self, %args) = @_;
   my @required_args = qw(tbl);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($tbl) = @args{@required_args};
   my $o     = $self->{OptionParser};
   my $q     = $self->{Quoter};

   my $trim            = $o->get('trim');
   my $float_precision = $o->get('float-precision');

   my $tbl_struct = $tbl->{tbl_struct};
   my $ignore_col = $o->get('ignore-columns') || {};
   my $all_cols   = $o->get('columns') || $tbl_struct->{cols};
   my %cols       = map { lc($_) => 1 } grep { !$ignore_col->{$_} } @$all_cols;
   my %seen;
   my @cols =
      map {
         my $type   = $tbl_struct->{type_for}->{$_};
         my $result = $q->quote($_);
         if ( $type eq 'timestamp' ) {
            $result .= ' + 0';
         }
         elsif ( $float_precision && $type =~ m/float|double/ ) {
            $result = "ROUND($result, $float_precision)";
         }
         elsif ( $trim && $type =~ m/varchar/ ) {
            $result = "TRIM($result)";
         }
         $result;
      }
      grep {
         $cols{$_} && !$seen{$_}++
      }
      @{$tbl_struct->{cols}};

   return {
      select  => \@cols,
      allowed => \%cols,
   };
}

sub get_crc_args {
   my ($self, %args) = @_;
   my $func      = $args{func}     || $self->_get_hash_func(%args);
   my $crc_width = $args{crc_width}|| $self->_get_crc_width(%args, func=>$func);
   my $crc_type  = $args{crc_type} || $self->_get_crc_type(%args, func=>$func);
   my $opt_slice; 
   if ( $args{dbh} && $crc_type !~ m/int$/ ) {
      $opt_slice = $self->_optimize_xor(%args, func=>$func);
   }

   return (
      func      => $func,
      crc_width => $crc_width,
      crc_type  => $crc_type,
      opt_slice => $opt_slice,
   );
}

sub _get_hash_func {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh) = @args{@required_args};
   my $o     = $self->{OptionParser};
   my @funcs = qw(CRC32 FNV1A_64 FNV_64 MD5 SHA1);

   if ( my $func = $o->get('function') ) {
      unshift @funcs, $func;
   }

   my ($result, $error);
   foreach my $func ( @funcs ) {
      eval {
         my $sql = "SELECT $func('test-string')";
         MKDEBUG && _d($sql);
         $args{dbh}->do($sql);
      };
      if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) {
         $error .= qq{$func cannot be used because "$1"\n};
         MKDEBUG && _d($func, 'cannot be used because', $1);
      }
      MKDEBUG && _d('Chosen hash func:', $result);
      return $func;
   }
   die $error || 'No hash functions (CRC32, MD5, etc.) are available';
}

sub _get_crc_width {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh func);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $func) = @args{@required_args};

   my $crc_width = 16;
   if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) {
      eval {
         my ($val) = $dbh->selectrow_array("SELECT $func('a')");
         $crc_width = max(16, length($val));
      };
   }
   return $crc_width;
}

sub _get_crc_type {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh func);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $func) = @args{@required_args};

   my $type   = '';
   my $length = 0;
   my $sql    = "SELECT $func('a')";
   my $sth    = $dbh->prepare($sql);
   eval {
      $sth->execute();
      $type   = $sth->{mysql_type_name}->[0];
      $length = $sth->{mysql_length}->[0];
      MKDEBUG && _d($sql, $type, $length);
      if ( $type eq 'bigint' && $length < 20 ) {
         $type = 'int';
      }
   };
   $sth->finish;
   MKDEBUG && _d('crc_type:', $type, 'length:', $length);
   return $type;
}

sub _optimize_xor {
   my ( $self, %args ) = @_;
   my @required_args = qw(dbh func);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $func) = @args{@required_args};

   die "$func never needs BIT_XOR optimization"
      if $func =~ m/^(?:FNV1A_64|FNV_64|CRC32)$/i;

   my $opt_slice = 0;
   my $unsliced  = uc $dbh->selectall_arrayref("SELECT $func('a')")->[0]->[0];
   my $sliced    = '';
   my $start     = 1;
   my $crc_width = length($unsliced) < 16 ? 16 : length($unsliced);

   do { # Try different positions till sliced result equals non-sliced.
      MKDEBUG && _d('Trying slice', $opt_slice);
      $dbh->do('SET @crc := "", @cnt := 0');
      my $slices = $self->_make_xor_slices(
         row_checksum => "\@crc := $func('a')",
         crc_width    => $crc_width,
         opt_slice    => $opt_slice,
      );

      my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x";
      $sliced = ($dbh->selectrow_array($sql))[0];
      if ( $sliced ne $unsliced ) {
         MKDEBUG && _d('Slice', $opt_slice, 'does not work');
         $start += 16;
         ++$opt_slice;
      }
   } while ( $start < $crc_width && $sliced ne $unsliced );

   if ( $sliced eq $unsliced ) {
      MKDEBUG && _d('Slice', $opt_slice, 'works');
      return $opt_slice;
   }
   else {
      MKDEBUG && _d('No slice works');
      return undef;
   }
}

sub _make_xor_slices {
   my ( $self, %args ) = @_;
   my @required_args = qw(row_checksum crc_width);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($row_checksum, $crc_width) = @args{@required_args};
   my ($opt_slice) = $args{opt_slice};

   my @slices;
   for ( my $start = 1; $start <= $crc_width; $start += 16 ) {
      my $len = $crc_width - $start + 1;
      if ( $len > 16 ) {
         $len = 16;
      }
      push @slices,
         "LPAD(CONV(BIT_XOR("
         . "CAST(CONV(SUBSTRING(\@crc, $start, $len), 16, 10) AS UNSIGNED))"
         . ", 10, 16), $len, '0')";
   }

   if ( defined $opt_slice && $opt_slice < @slices ) {
      $slices[$opt_slice] =~ s/\@crc/\@crc := $row_checksum/;
   }
   else {
      map { s/\@crc/$row_checksum/ } @slices;
   }

   return join(', ', @slices);
}

sub find_replication_differences {
   my ($self, %args) = @_;
   my @required_args = qw(dbh repl_table);
   foreach my $arg( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $repl_table) = @args{@required_args};

   my $sql
      = "SELECT CONCAT(db, '.', tbl) AS `table`, "
      . "chunk, chunk_index, lower_boundary, upper_boundary, "
      . "COALESCE(this_cnt-master_cnt, 0) AS cnt_diff, "
      . "COALESCE("
      .   "this_crc <> master_crc OR ISNULL(master_crc) <> ISNULL(this_crc), 0"
      . ") AS crc_diff, this_cnt, master_cnt, this_crc, master_crc "
      . "FROM $repl_table "
      . "WHERE (master_cnt <> this_cnt OR master_crc <> this_crc "
      .        "OR ISNULL(master_crc) <> ISNULL(this_crc))"
      . ($args{where} ? " AND ($args{where})" : "");
   MKDEBUG && _d($sql);
   my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} });
   return $diffs;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End RowChecksum package
# ###########################################################################

# ###########################################################################
# NibbleIterator package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/NibbleIterator.pm
#   t/lib/NibbleIterator.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package NibbleIterator;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Quotekeys = 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(Cxn tbl chunk_size OptionParser Quoter TableNibbler TableParser);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($cxn, $tbl, $chunk_size, $o, $q) = @args{@required_args};

   my ($row_est, $mysql_index) = _get_row_estimate(%args);
   my $one_nibble = !defined $args{one_nibble} || $args{one_nibble}
                  ? $row_est <= $chunk_size * $o->get('chunk-size-limit')
                  : 0;
   MKDEBUG && _d('One nibble:', $one_nibble ? 'yes' : 'no');

   my $index = _find_best_index(%args, mysql_index => $mysql_index);
   if ( !$index && !$one_nibble ) {
      die "There is no good index and the table is oversized.";
   }

   my $tbl_struct = $tbl->{tbl_struct};
   my $ignore_col = $o->get('ignore-columns') || {};
   my $all_cols   = $o->get('columns') || $tbl_struct->{cols};
   my @cols       = grep { !$ignore_col->{$_} } @$all_cols;
   my $where      = $o->get('where');
   my $self;
   if ( $one_nibble ) {
      my $nibble_sql
         = ($args{dms} ? "$args{dms} " : "SELECT ")
         . ($args{select} ? $args{select}
                          : join(', ', map { $q->quote($_) } @cols))
         . " FROM " . $q->quote(@{$tbl}{qw(db tbl)})
         . ($where ? " AND ($where)" : '')
         . " /*checksum table*/";
      MKDEBUG && _d('One nibble statement:', $nibble_sql);

      my $explain_nibble_sql
         = "EXPLAIN SELECT "
         . ($args{select} ? $args{select}
                          : join(', ', map { $q->quote($_) } @cols))
         . " FROM " . $q->quote(@{$tbl}{qw(db tbl)})
         . ($where ? " AND ($where)" : '')
         . " /*explain checksum table*/";
      MKDEBUG && _d('Explain one nibble statement:', $explain_nibble_sql);

      $self = {
         %args,
         one_nibble         => 1,
         limit              => 0,
         nibble_sql         => $nibble_sql,
         explain_nibble_sql => $explain_nibble_sql,
      };
   }
   else {
      my $index_cols = $tbl->{tbl_struct}->{keys}->{$index}->{cols};

      my $asc = $args{TableNibbler}->generate_asc_stmt(
         %args,
         tbl_struct => $tbl->{tbl_struct},
         index      => $index,
         cols       => \@cols,
         asc_only   => 1,
      );
      MKDEBUG && _d('Ascend params:', Dumper($asc));

      my $from     = $q->quote(@{$tbl}{qw(db tbl)}) . " FORCE INDEX(`$index`)";
      my $order_by = join(', ', map {$q->quote($_)} @{$index_cols});

      my $first_lb_sql
         = "SELECT /*!40001 SQL_NO_CACHE */ "
         . join(', ', map { $q->quote($_) } @{$asc->{scols}})
         . " FROM $from"
         . ($where ? " WHERE $where" : '')
         . " ORDER BY $order_by"
         . " LIMIT 1"
         . " /*first lower boundary*/";
      MKDEBUG && _d('First lower boundary statement:', $first_lb_sql);

      my $last_ub_sql
         = "SELECT /*!40001 SQL_NO_CACHE */ "
         . join(', ', map { $q->quote($_) } @{$asc->{scols}})
         . " FROM $from"
         . ($where ? " WHERE $where" : '')
         . " ORDER BY "
         . join(' DESC, ', map {$q->quote($_)} @{$index_cols}) . ' DESC'
         . " LIMIT 1"
         . " /*last upper boundary*/";
      MKDEBUG && _d('Last upper boundary statement:', $last_ub_sql);

      my $ub_sql
         = "SELECT /*!40001 SQL_NO_CACHE */ "
         . join(', ', map { $q->quote($_) } @{$asc->{scols}})
         . " FROM $from"
         . " WHERE " . $asc->{boundaries}->{'>='}
                     . ($where ? " AND ($where)" : '')
         . " ORDER BY $order_by"
         . " LIMIT ?, 2"
         . " /*next chunk boundary*/";
      MKDEBUG && _d('Upper boundary statement:', $ub_sql);

      my $nibble_sql
         = ($args{dms} ? "$args{dms} " : "SELECT ")
         . ($args{select} ? $args{select}
                          : join(', ', map { $q->quote($_) } @{$asc->{cols}}))
         . " FROM $from"
         . " WHERE " . $asc->{boundaries}->{'>='}  # lower boundary
         . " AND "   . $asc->{boundaries}->{'<='}  # upper boundary
         . ($where ? " AND ($where)" : '')
         . " ORDER BY $order_by"
         . " /*checksum chunk*/";
      MKDEBUG && _d('Nibble statement:', $nibble_sql);

      my $explain_nibble_sql 
         = "EXPLAIN SELECT "
         . ($args{select} ? $args{select}
                          : join(', ', map { $q->quote($_) } @{$asc->{cols}}))
         . " FROM $from"
         . " WHERE " . $asc->{boundaries}->{'>='}  # lower boundary
         . " AND "   . $asc->{boundaries}->{'<='}  # upper boundary
         . ($where ? " AND ($where)" : '')
         . " ORDER BY $order_by"
         . " /*explain checksum chunk*/";
      MKDEBUG && _d('Explain nibble statement:', $explain_nibble_sql);

      my $limit = $chunk_size - 1;
      MKDEBUG && _d('Initial chunk size (LIMIT):', $limit);

      $self = {
         %args,
         index              => $index,
         limit              => $limit,
         first_lb_sql       => $first_lb_sql,
         last_ub_sql        => $last_ub_sql,
         ub_sql             => $ub_sql,
         nibble_sql         => $nibble_sql,
         explain_ub_sql     => "EXPLAIN $ub_sql",
         explain_nibble_sql => $explain_nibble_sql,
         sql                => {
            columns    => $asc->{scols},
            from       => $from,
            where      => $where,
            boundaries => $asc->{boundaries},
            order_by   => $order_by,
         },
      };
   }

   $self->{row_est}    = $row_est;
   $self->{nibbleno}   = 0;
   $self->{have_rows}  = 0;
   $self->{rowno}      = 0;
   $self->{oktonibble} = 1;

   return bless $self, $class;
}

sub next {
   my ($self) = @_;

   if ( !$self->{oktonibble} ) {
      MKDEBUG && _d('Not ok to nibble');
      return;
   }

   my %callback_args = (
      Cxn            => $self->{Cxn},
      tbl            => $self->{tbl},
      NibbleIterator => $self,
   );

   if ($self->{nibbleno} == 0) {
      $self->_prepare_sths();
      $self->_get_bounds();
      if ( my $callback = $self->{callbacks}->{init} ) {
         $self->{oktonibble} = $callback->(%callback_args);
         MKDEBUG && _d('init callback returned', $self->{oktonibble});
         if ( !$self->{oktonibble} ) {
            $self->{no_more_boundaries} = 1;
            return;
         }
      }
   }

   NIBBLE:
   while ( $self->{have_rows} || $self->_next_boundaries() ) {
      if ( !$self->{have_rows} ) {
         $self->{nibbleno}++;
         MKDEBUG && _d($self->{nibble_sth}->{Statement}, 'params:',
            join(', ', (@{$self->{lower}}, @{$self->{upper}})));
         if ( my $callback = $self->{callbacks}->{exec_nibble} ) {
            $self->{have_rows} = $callback->(%callback_args);
         }
         else {
            $self->{nibble_sth}->execute(@{$self->{lower}}, @{$self->{upper}});
            $self->{have_rows} = $self->{nibble_sth}->rows();
         }
         MKDEBUG && _d($self->{have_rows}, 'rows in nibble', $self->{nibbleno});
      }

      if ( $self->{have_rows} ) {
         my $row = $self->{nibble_sth}->fetchrow_arrayref();
         if ( $row ) {
            $self->{rowno}++;
            MKDEBUG && _d('Row', $self->{rowno}, 'in nibble',$self->{nibbleno});
            return [ @$row ];
         }
      }

      MKDEBUG && _d('No rows in nibble or nibble skipped');
      if ( my $callback = $self->{callbacks}->{after_nibble} ) {
         $callback->(%callback_args);
      }
      $self->{rowno}     = 0;
      $self->{have_rows} = 0;
   }

   MKDEBUG && _d('Done nibbling');
   if ( my $callback = $self->{callbacks}->{done} ) {
      $callback->(%callback_args);
   }

   return;
}

sub nibble_number {
   my ($self) = @_;
   return $self->{nibbleno};
}

sub set_nibble_number {
   my ($self, $n) = @_;
   die "I need a number" unless $n;
   $self->{nibbleno} = $n;
   MKDEBUG && _d('Set new nibble number:', $n);
   return;
}

sub nibble_index {
   my ($self) = @_;
   return $self->{index};
}

sub statements {
   my ($self) = @_;
   return {
      nibble                 => $self->{nibble_sth},
      explain_nibble         => $self->{explain_nibble_sth},
      upper_boundary         => $self->{ub_sth},
      explain_upper_boundary => $self->{explain_ub_sth},
   }
}

sub boundaries {
   my ($self) = @_;
   return {
      lower       => $self->{lower},
      upper       => $self->{upper},
      next_lower  => $self->{next_lower},
      last_upper  => $self->{last_upper},
   };
}

sub set_boundary {
   my ($self, $boundary, $values) = @_;
   die "I need a boundary parameter"
      unless $boundary;
   die "Invalid boundary: $boundary"
      unless $boundary =~ m/^(?:lower|upper|next_lower|last_upper)$/;
   die "I need a values arrayref parameter"
      unless $values && ref $values eq 'ARRAY';
   $self->{$boundary} = $values;
   MKDEBUG && _d('Set new', $boundary, 'boundary:', Dumper($values));
   return;
}

sub one_nibble {
   my ($self) = @_;
   return $self->{one_nibble};
}

sub chunk_size {
   my ($self) = @_;
   return $self->{limit} + 1;
}

sub set_chunk_size {
   my ($self, $limit) = @_;
   return if $self->{one_nibble};
   die "Chunk size must be > 0" unless $limit;
   $self->{limit} = $limit - 1;
   MKDEBUG && _d('Set new chunk size (LIMIT):', $limit);
   return;
}

sub sql {
   my ($self) = @_;
   return $self->{sql};
}

sub more_boundaries {
   my ($self) = @_;
   return !$self->{no_more_boundaries};
}

sub row_estimate {
   my ($self) = @_;
   return $self->{row_est};
}

sub _find_best_index {
   my (%args) = @_;
   my @required_args = qw(Cxn tbl TableParser);
   my ($cxn, $tbl, $tp) = @args{@required_args};
   my $tbl_struct = $tbl->{tbl_struct};
   my $indexes    = $tbl_struct->{keys};

   my $want_index = $args{chunk_index};
   if ( $want_index ) {
      MKDEBUG && _d('User wants to use index', $want_index);
      if ( !exists $indexes->{$want_index} ) {
         MKDEBUG && _d('Cannot use user index because it does not exist');
         $want_index = undef;
      }
   }

   if ( !$want_index && $args{mysql_index} ) {
      MKDEBUG && _d('MySQL wants to use index', $args{mysql_index});
      $want_index = $args{mysql_index};
   }

   my $best_index;
   my @possible_indexes;
   if ( $want_index ) {
      if ( $indexes->{$want_index}->{is_unique} ) {
         MKDEBUG && _d('Will use wanted index');
         $best_index = $want_index;
      }
      else {
         MKDEBUG && _d('Wanted index is a possible index');
         push @possible_indexes, $want_index;
      }
   }
   else {
      MKDEBUG && _d('Auto-selecting best index');
      foreach my $index ( $tp->sort_indexes($tbl_struct) ) {
         if ( $index eq 'PRIMARY' || $indexes->{$index}->{is_unique} ) {
            $best_index = $index;
            last;
         }
         else {
            push @possible_indexes, $index;
         }
      }
   }

   if ( !$best_index && @possible_indexes ) {
      MKDEBUG && _d('No PRIMARY or unique indexes;',
         'will use index with highest cardinality');
      foreach my $index ( @possible_indexes ) {
         $indexes->{$index}->{cardinality} = _get_index_cardinality(
            %args,
            index => $index,
         );
      }
      @possible_indexes = sort {
         my $cmp
            = $indexes->{$b}->{cardinality} <=> $indexes->{$b}->{cardinality};
         if ( $cmp == 0 ) {
            $cmp = scalar @{$indexes->{$b}->{cols}}
               <=> scalar @{$indexes->{$a}->{cols}};
         }
         $cmp;
      } @possible_indexes;
      $best_index = $possible_indexes[0];
   }

   MKDEBUG && _d('Best index:', $best_index);
   return $best_index;
}

sub _get_index_cardinality {
   my (%args) = @_;
   my @required_args = qw(Cxn tbl index Quoter);
   my ($cxn, $tbl, $index, $q) = @args{@required_args};

   my $sql = "SHOW INDEXES FROM " . $q->quote(@{$tbl}{qw(db tbl)})
           . " WHERE Key_name = '$index'";
   MKDEBUG && _d($sql);
   my $cardinality = 1;
   my $rows = $cxn->dbh()->selectall_hashref($sql, 'key_name');
   foreach my $row ( values %$rows ) {
      $cardinality *= $row->{cardinality} if $row->{cardinality};
   }
   MKDEBUG && _d('Index', $index, 'cardinality:', $cardinality);
   return $cardinality;
}

sub _get_row_estimate {
   my (%args) = @_;
   my @required_args = qw(Cxn tbl OptionParser TableParser Quoter);
   my ($cxn, $tbl, $o, $tp, $q) = @args{@required_args};

   if ( my $where = $o->get('where') ) {
      MKDEBUG && _d('WHERE clause, using explain plan for row estimate');
      my $table = $q->quote(@{$tbl}{qw(db tbl)});
      my $sql   = "EXPLAIN SELECT COUNT(*) FROM $table WHERE $where";
      MKDEBUG && _d($sql);
      my $expl = $cxn->dbh()->selectrow_hashref($sql);
      MKDEBUG && _d(Dumper($expl));
      return ($expl->{rows} || 0), $expl->{key};
   }
   else {
      MKDEBUG && _d('No WHERE clause, using table status for row estimate');
      return $tbl->{tbl_status}->{rows} || 0;
   }
}

sub _prepare_sths {
   my ($self) = @_;
   MKDEBUG && _d('Preparing statement handles');

   my $dbh = $self->{Cxn}->dbh();

   $self->{nibble_sth}         = $dbh->prepare($self->{nibble_sql});
   $self->{explain_nibble_sth} = $dbh->prepare($self->{explain_nibble_sql});

   if ( !$self->{one_nibble} ) {
      $self->{ub_sth} = $dbh->prepare($self->{ub_sql});
      $self->{explain_ub_sth} = $dbh->prepare($self->{explain_ub_sql});
   }

   return;
}

sub _get_bounds { 
   my ($self) = @_;
   return if $self->{one_nibble};

   my $dbh = $self->{Cxn}->dbh();

   $self->{next_lower} = $dbh->selectrow_arrayref($self->{first_lb_sql});
   MKDEBUG && _d('First lower boundary:', Dumper($self->{next_lower}));

   $self->{last_upper} = $dbh->selectrow_arrayref($self->{last_ub_sql});
   MKDEBUG && _d('Last upper boundary:', Dumper($self->{last_upper}));

   return;
}

sub _next_boundaries {
   my ($self) = @_;

   if ( $self->{no_more_boundaries} ) {
      MKDEBUG && _d('No more boundaries');
      return; # stop nibbling
   }

   if ( $self->{one_nibble} ) {
      $self->{lower} = $self->{upper} = [];
      $self->{no_more_boundaries} = 1;  # for next call
      return 1; # continue nibbling
   }

   if ( $self->identical_boundaries($self->{lower}, $self->{next_lower}) ) {
      MKDEBUG && _d('Infinite loop detected');
      my $tbl     = $self->{tbl};
      my $index   = $tbl->{tbl_struct}->{keys}->{$self->{index}};
      my $n_cols  = scalar @{$index->{cols}};
      my $chunkno = $self->{nibbleno};
      die "Possible infinite loop detected!  "
         . "The lower boundary for chunk $chunkno is "
         . "<" . join(', ', @{$self->{lower}}) . "> and the lower "
         . "boundary for chunk " . ($chunkno + 1) . " is also "
         . "<" . join(', ', @{$self->{next_lower}}) . ">.  "
         . "This usually happens when using a non-unique single "
         . "column index.  The current chunk index for table "
         . "$tbl->{db}.$tbl->{tbl} is $self->{index} which is"
         . ($index->{is_unique} ? '' : ' not') . " unique and covers "
         . ($n_cols > 1 ? "$n_cols columns" : "1 column") . ".\n";
   }
   $self->{lower} = $self->{next_lower};

   if ( my $callback = $self->{callbacks}->{next_boundaries} ) {
      my $oktonibble = $callback->(
         Cxn            => $self->{Cxn},
         tbl            => $self->{tbl},
         NibbleIterator => $self,
      );
      MKDEBUG && _d('next_boundaries callback returned', $oktonibble);
      if ( !$oktonibble ) {
         $self->{no_more_boundaries} = 1;
         return; # stop nibbling
      }
   }

   MKDEBUG && _d($self->{ub_sth}->{Statement}, 'params:',
      join(', ', @{$self->{lower}}), $self->{limit});
   $self->{ub_sth}->execute(@{$self->{lower}}, $self->{limit});
   my $boundary = $self->{ub_sth}->fetchall_arrayref();
   MKDEBUG && _d('Next boundary:', Dumper($boundary));
   if ( $boundary && @$boundary ) {
      $self->{upper} = $boundary->[0]; # this nibble
      if ( $boundary->[1] ) {
         $self->{next_lower} = $boundary->[1]; # next nibble
      }
      else {
         $self->{no_more_boundaries} = 1;  # for next call
         MKDEBUG && _d('Last upper boundary:', Dumper($boundary->[0]));
      }
   }
   else {
      $self->{no_more_boundaries} = 1;  # for next call
      $self->{upper} = $self->{last_upper};
      MKDEBUG && _d('Last upper boundary:', Dumper($self->{upper}));
   }
   $self->{ub_sth}->finish();

   return 1; # continue nibbling
}

sub identical_boundaries {
   my ($self, $b1, $b2) = @_;

   return 0 if ($b1 && !$b2) || (!$b1 && $b2);

   return 1 if !$b1 && !$b2;

   die "Boundaries have different numbers of values"
      if scalar @$b1 != scalar @$b2;  # shouldn't happen
   my $n_vals = scalar @$b1;
   for my $i ( 0..($n_vals-1) ) {
      return 0 if $b1->[$i] ne $b2->[$i]; # diff
   }
   return 1;
}

sub DESTROY {
   my ( $self ) = @_;
   foreach my $key ( keys %$self ) {
      if ( $key =~ m/_sth$/ ) {
         $self->{$key}->finish();
      }
   }
   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End NibbleIterator package
# ###########################################################################

# ###########################################################################
# Daemon package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Daemon.pm
#   t/lib/Daemon.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Daemon;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use POSIX qw(setsid);

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(o) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $o = $args{o};
   my $self = {
      o        => $o,
      log_file => $o->has('log') ? $o->get('log') : undef,
      PID_file => $o->has('pid') ? $o->get('pid') : undef,
   };

   check_PID_file(undef, $self->{PID_file});

   MKDEBUG && _d('Daemonized child will log to', $self->{log_file});
   return bless $self, $class;
}

sub daemonize {
   my ( $self ) = @_;

   MKDEBUG && _d('About to fork and daemonize');
   defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR";
   if ( $pid ) {
      MKDEBUG && _d('I am the parent and now I die');
      exit;
   }

   $self->{PID_owner} = $PID;
   $self->{child}     = 1;

   POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
   chdir '/'       or die "Cannot chdir to /: $OS_ERROR";

   $self->_make_PID_file();

   $OUTPUT_AUTOFLUSH = 1;

   if ( -t STDIN ) {
      close STDIN;
      open  STDIN, '/dev/null'
         or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
   }

   if ( $self->{log_file} ) {
      close STDOUT;
      open  STDOUT, '>>', $self->{log_file}
         or die "Cannot open log file $self->{log_file}: $OS_ERROR";

      close STDERR;
      open  STDERR, ">&STDOUT"
         or die "Cannot dupe STDERR to STDOUT: $OS_ERROR"; 
   }
   else {
      if ( -t STDOUT ) {
         close STDOUT;
         open  STDOUT, '>', '/dev/null'
            or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
      }
      if ( -t STDERR ) {
         close STDERR;
         open  STDERR, '>', '/dev/null'
            or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
      }
   }

   MKDEBUG && _d('I am the child and now I live daemonized');
   return;
}

sub check_PID_file {
   my ( $self, $file ) = @_;
   my $PID_file = $self ? $self->{PID_file} : $file;
   MKDEBUG && _d('Checking PID file', $PID_file);
   if ( $PID_file && -f $PID_file ) {
      my $pid;
      eval { chomp($pid = `cat $PID_file`); };
      die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR;
      MKDEBUG && _d('PID file exists; it contains PID', $pid);
      if ( $pid ) {
         my $pid_is_alive = kill 0, $pid;
         if ( $pid_is_alive ) {
            die "The PID file $PID_file already exists "
               . " and the PID that it contains, $pid, is running";
         }
         else {
            warn "Overwriting PID file $PID_file because the PID that it "
               . "contains, $pid, is not running";
         }
      }
      else {
         die "The PID file $PID_file already exists but it does not "
            . "contain a PID";
      }
   }
   else {
      MKDEBUG && _d('No PID file');
   }
   return;
}

sub make_PID_file {
   my ( $self ) = @_;
   if ( exists $self->{child} ) {
      die "Do not call Daemon::make_PID_file() for daemonized scripts";
   }
   $self->_make_PID_file();
   $self->{PID_owner} = $PID;
   return;
}

sub _make_PID_file {
   my ( $self ) = @_;

   my $PID_file = $self->{PID_file};
   if ( !$PID_file ) {
      MKDEBUG && _d('No PID file to create');
      return;
   }

   $self->check_PID_file();

   open my $PID_FH, '>', $PID_file
      or die "Cannot open PID file $PID_file: $OS_ERROR";
   print $PID_FH $PID
      or die "Cannot print to PID file $PID_file: $OS_ERROR";
   close $PID_FH
      or die "Cannot close PID file $PID_file: $OS_ERROR";

   MKDEBUG && _d('Created PID file:', $self->{PID_file});
   return;
}

sub _remove_PID_file {
   my ( $self ) = @_;
   if ( $self->{PID_file} && -f $self->{PID_file} ) {
      unlink $self->{PID_file}
         or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR";
      MKDEBUG && _d('Removed PID file');
   }
   else {
      MKDEBUG && _d('No PID to remove');
   }
   return;
}

sub DESTROY {
   my ( $self ) = @_;

   $self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID;

   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End Daemon package
# ###########################################################################

# ###########################################################################
# SchemaIterator package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/SchemaIterator.pm
#   t/lib/SchemaIterator.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package SchemaIterator;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Quotekeys = 0;

my $open_comment = qr{/\*!\d{5} };
my $tbl_name     = qr{
   CREATE\s+
   (?:TEMPORARY\s+)?
   TABLE\s+
   (?:IF NOT EXISTS\s+)?
   ([^\(]+)
}x;


sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(OptionParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }

   my ($file_itr, $dbh) = @args{qw(file_itr dbh)};
   die "I need either a dbh or file_itr argument"
      if (!$dbh && !$file_itr) || ($dbh && $file_itr);

   my %resume;
   if ( my $table = $args{resume} ) {
      MKDEBUG && _d('Will resume from', $table);
      my ($db, $tbl) = $args{Quoter}->split_unquote($table);
      $resume{db}  = $db;
      $resume{tbl} = $tbl;
   }

   my $self = {
      %args,
      resume  => \%resume,
      filters => _make_filters(%args),
   };

   return bless $self, $class;
}

sub _make_filters {
   my ( %args ) = @_;
   my @required_args = qw(OptionParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($o, $q) = @args{@required_args};

   my %filters;


   my @simple_filters = qw(
      databases         tables         engines
      ignore-databases  ignore-tables  ignore-engines);
   FILTER:
   foreach my $filter ( @simple_filters ) {
      if ( $o->has($filter) ) {
         my $objs = $o->get($filter);
         next FILTER unless $objs && scalar keys %$objs;
         my $is_table = $filter =~ m/table/ ? 1 : 0;
         foreach my $obj ( keys %$objs ) {
            die "Undefined value for --$filter" unless $obj;
            $obj = lc $obj;
            if ( $is_table ) {
               my ($db, $tbl) = $q->split_unquote($obj);
               $db ||= '*';
               MKDEBUG && _d('Filter', $filter, 'value:', $db, $tbl);
               $filters{$filter}->{$tbl} = $db;
            }
            else { # database
               MKDEBUG && _d('Filter', $filter, 'value:', $obj);
               $filters{$filter}->{$obj} = 1;
            }
         }
      }
   }

   my @regex_filters = qw(
      databases-regex         tables-regex
      ignore-databases-regex  ignore-tables-regex);
   REGEX_FILTER:
   foreach my $filter ( @regex_filters ) {
      if ( $o->has($filter) ) {
         my $pat = $o->get($filter);
         next REGEX_FILTER unless $pat;
         $filters{$filter} = qr/$pat/;
         MKDEBUG && _d('Filter', $filter, 'value:', $filters{$filter});
      }
   }

   MKDEBUG && _d('Schema object filters:', Dumper(\%filters));
   return \%filters;
}

sub next {
   my ( $self ) = @_;

   my $schema_obj;
   if ( $self->{file_itr} ) {
      $schema_obj= $self->_iterate_files();
   }
   else { # dbh
      $schema_obj= $self->_iterate_dbh();
   }

   if ( $schema_obj ) {
      if ( $schema_obj->{ddl} && $self->{TableParser} ) {
         $schema_obj->{tbl_struct}
            = $self->{TableParser}->parse($schema_obj->{ddl});
      }

      delete $schema_obj->{ddl} unless $self->{keep_ddl};
      delete $schema_obj->{tbl_status} unless $self->{keep_tbl_status};

      if ( my $schema = $self->{Schema} ) {
         $schema->add_schema_object($schema_obj);
      }
      MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl});
   }

   return $schema_obj;
}

sub _iterate_files {
   my ( $self ) = @_;

   if ( !$self->{fh} ) {
      my ($fh, $file) = $self->{file_itr}->();
      if ( !$fh ) {
         MKDEBUG && _d('No more files to iterate');
         return;
      }
      $self->{fh}   = $fh;
      $self->{file} = $file;
   }
   my $fh = $self->{fh};
   MKDEBUG && _d('Getting next schema object from', $self->{file});

   local $INPUT_RECORD_SEPARATOR = '';
   CHUNK:
   while (defined(my $chunk = <$fh>)) {
      if ($chunk =~ m/Database: (\S+)/) {
         my $db = $1; # XXX
         $db =~ s/^`//;  # strip leading `
         $db =~ s/`$//;  # and trailing `
         if ( $self->database_is_allowed($db)
              && $self->_resume_from_database($db) ) {
            $self->{db} = $db;
         }
      }
      elsif ($self->{db} && $chunk =~ m/CREATE TABLE/) {
         if ($chunk =~ m/DROP VIEW IF EXISTS/) {
            MKDEBUG && _d('Table is a VIEW, skipping');
            next CHUNK;
         }

         my ($tbl) = $chunk =~ m/$tbl_name/;
         $tbl      =~ s/^\s*`//;
         $tbl      =~ s/`\s*$//;
         if ( $self->table_is_allowed($self->{db}, $tbl)
              && $self->_resume_from_table($tbl) ) {
            my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms;
            if ( !$ddl ) {
               warn "Failed to parse CREATE TABLE from\n" . $chunk;
               next CHUNK;
            }
            $ddl =~ s/ \*\/;\Z/;/;  # remove end of version comment

            my ($engine) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/;   

            if ( !$engine || $self->engine_is_allowed($engine) ) {
               return {
                  db  => $self->{db},
                  tbl => $tbl,
                  ddl => $ddl,
               };
            }
         }
      }
   }  # CHUNK

   MKDEBUG && _d('No more schema objects in', $self->{file});
   close $self->{fh};
   $self->{fh} = undef;

   return $self->_iterate_files();
}

sub _iterate_dbh {
   my ( $self ) = @_;
   my $q   = $self->{Quoter};
   my $dbh = $self->{dbh};
   MKDEBUG && _d('Getting next schema object from dbh', $dbh);

   if ( !defined $self->{dbs} ) {
      my $sql = 'SHOW DATABASES';
      MKDEBUG && _d($sql);
      my @dbs = grep { $self->database_is_allowed($_) }
                @{$dbh->selectcol_arrayref($sql)};
      MKDEBUG && _d('Found', scalar @dbs, 'databases');
      $self->{dbs} = \@dbs;
   }

   if ( !$self->{db} ) {
      do {
         $self->{db} = shift @{$self->{dbs}};
      } until $self->_resume_from_database($self->{db});
      MKDEBUG && _d('Next database:', $self->{db});
      return unless $self->{db};
   }

   if ( !defined $self->{tbls} ) {
      my $sql = 'SHOW /*!50002 FULL*/ TABLES FROM ' . $q->quote($self->{db});
      MKDEBUG && _d($sql);
      my @tbls = map {
         $_->[0];  # (tbl, type)
      }
      grep {
         my ($tbl, $type) = @$_;
         $self->table_is_allowed($self->{db}, $tbl)
            && (!$type || ($type ne 'VIEW'));
      }
      @{$dbh->selectall_arrayref($sql)};
      MKDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db});
      $self->{tbls} = \@tbls;
   }

   while ( my $tbl = shift @{$self->{tbls}} ) {
      next unless $self->_resume_from_table($tbl);

      my $tbl_status;
      if ( $self->{filters}->{'engines'}
           || $self->{filters}->{'ignore-engines'}
           || $self->{keep_tbl_status} )
      {
         my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db})
                 . " LIKE \'$tbl\'";
         MKDEBUG && _d($sql);
         $tbl_status = $dbh->selectrow_hashref($sql);
         MKDEBUG && _d(Dumper($tbl_status));
      }

      if ( !$tbl_status
           || $self->engine_is_allowed($tbl_status->{engine}) ) {
         my $ddl;
         if ( my $tp = $self->{TableParser} ) {
            $ddl = $tp->get_create_table($dbh, $self->{db}, $tbl);
         }

         return {
            db         => $self->{db},
            tbl        => $tbl,
            ddl        => $ddl,
            tbl_status => $tbl_status,
         };
      }
   }

   MKDEBUG && _d('No more tables in database', $self->{db});
   $self->{db}   = undef;
   $self->{tbls} = undef;

   return $self->_iterate_dbh();
}

sub database_is_allowed {
   my ( $self, $db ) = @_;
   die "I need a db argument" unless $db;

   $db = lc $db;

   my $filter = $self->{filters};

   if ( $db =~ m/information_schema|performance_schema|lost\+found/ ) {
      MKDEBUG && _d('Database', $db, 'is a system database, ignoring');
      return 0;
   }

   if ( $self->{filters}->{'ignore-databases'}->{$db} ) {
      MKDEBUG && _d('Database', $db, 'is in --ignore-databases list');
      return 0;
   }

   if ( $filter->{'ignore-databases-regex'}
        && $db =~ $filter->{'ignore-databases-regex'} ) {
      MKDEBUG && _d('Database', $db, 'matches --ignore-databases-regex');
      return 0;
   }

   if ( $filter->{'databases'}
        && !$filter->{'databases'}->{$db} ) {
      MKDEBUG && _d('Database', $db, 'is not in --databases list, ignoring');
      return 0;
   }

   if ( $filter->{'databases-regex'}
        && $db !~ $filter->{'databases-regex'} ) {
      MKDEBUG && _d('Database', $db, 'does not match --databases-regex, ignoring');
      return 0;
   }

   return 1;
}

sub table_is_allowed {
   my ( $self, $db, $tbl ) = @_;
   die "I need a db argument"  unless $db;
   die "I need a tbl argument" unless $tbl;

   $db  = lc $db;
   $tbl = lc $tbl;

   my $filter = $self->{filters};

   if ( $db eq 'mysql' && ($tbl eq 'general_log' || $tbl eq 'slow_log') ) {
      return 0;
   }

   if ( $filter->{'ignore-tables'}->{$tbl}
        && ($filter->{'ignore-tables'}->{$tbl} eq '*'
            || $filter->{'ignore-tables'}->{$tbl} eq $db) ) {
      MKDEBUG && _d('Table', $tbl, 'is in --ignore-tables list');
      return 0;
   }

   if ( $filter->{'ignore-tables-regex'}
        && $tbl =~ $filter->{'ignore-tables-regex'} ) {
      MKDEBUG && _d('Table', $tbl, 'matches --ignore-tables-regex');
      return 0;
   }

   if ( $filter->{'tables'}
        && !$filter->{'tables'}->{$tbl} ) { 
      MKDEBUG && _d('Table', $tbl, 'is not in --tables list, ignoring');
      return 0;
   }

   if ( $filter->{'tables-regex'}
        && $tbl !~ $filter->{'tables-regex'} ) {
      MKDEBUG && _d('Table', $tbl, 'does not match --tables-regex, ignoring');
      return 0;
   }

   if ( $filter->{'tables'}
        && $filter->{'tables'}->{$tbl}
        && $filter->{'tables'}->{$tbl} ne '*'
        && $filter->{'tables'}->{$tbl} ne $db ) {
      MKDEBUG && _d('Table', $tbl, 'is only allowed in database',
         $filter->{'tables'}->{$tbl});
      return 0;
   }

   return 1;
}

sub engine_is_allowed {
   my ( $self, $engine ) = @_;
   die "I need an engine argument" unless $engine;

   $engine = lc $engine;

   my $filter = $self->{filters};

   if ( $filter->{'ignore-engines'}->{$engine} ) {
      MKDEBUG && _d('Engine', $engine, 'is in --ignore-databases list');
      return 0;
   }

   if ( $filter->{'engines'}
        && !$filter->{'engines'}->{$engine} ) {
      MKDEBUG && _d('Engine', $engine, 'is not in --engines list, ignoring');
      return 0;
   }

   return 1;
}

sub _resume_from_database {
   my ($self, $db) = @_;

   return 1 unless $self->{resume}->{db};

   if ( $db eq $self->{resume}->{db} ) {
      MKDEBUG && _d('At resume db', $db);
      delete $self->{resume}->{db};
      return 1;
   }

   return 0;
}

sub _resume_from_table {
   my ($self, $tbl) = @_;

   return 1 unless $self->{resume}->{tbl};

   if ( $tbl eq $self->{resume}->{tbl} ) {
      MKDEBUG && _d('At resume table', $tbl);
      delete $self->{resume}->{tbl};
      return 1;
   }

   return 0;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End SchemaIterator package
# ###########################################################################

# ###########################################################################
# Retry package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Retry.pm
#   t/lib/Retry.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Retry;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   my $self = {
      %args,
   };
   return bless $self, $class;
}

sub retry {
   my ( $self, %args ) = @_;
   my @required_args = qw(try fail final_fail);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   };
   my ($try, $fail, $final_fail) = @args{@required_args};
   my $wait  = $args{wait}  || sub { sleep 1; };
   my $tries = $args{tries} || 3;

   my $last_error;
   my $tryno = 0;
   TRY:
   while ( ++$tryno <= $tries ) {
      MKDEBUG && _d("Try", $tryno, "of", $tries);
      my $result;
      eval {
         $result = $try->(tryno=>$tryno);
      };
      if ( $EVAL_ERROR ) {
         MKDEBUG && _d("Try code failed:", $EVAL_ERROR);
         $last_error = $EVAL_ERROR;

         if ( $tryno < $tries ) {   # more retries
            my $retry = $fail->(tryno=>$tryno, error=>$last_error);
            last TRY unless $retry;
            MKDEBUG && _d("Calling wait code");
            $wait->(tryno=>$tryno);
         }
      }
      else {
         MKDEBUG && _d("Try code succeeded");
         return $result;
      }
   }

   MKDEBUG && _d('Try code did not succeed');
   return $final_fail->(error=>$last_error);
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End Retry package
# ###########################################################################

# ###########################################################################
# Transformers package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Transformers.pm
#   t/lib/Transformers.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Transformers;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);

require Exporter;
our @ISA         = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT      = ();
our @EXPORT_OK   = qw(
   micro_t
   percentage_of
   secs_to_time
   time_to_secs
   shorten
   ts
   parse_timestamp
   unix_timestamp
   any_unix_timestamp
   make_checksum
   crc32
);

our $mysql_ts  = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;
our $n_ts      = qr/(\d{1,5})([shmd]?)/; # Limit \d{1,5} because \d{6} looks

sub micro_t {
   my ( $t, %args ) = @_;
   my $p_ms = defined $args{p_ms} ? $args{p_ms} : 0;  # precision for ms vals
   my $p_s  = defined $args{p_s}  ? $args{p_s}  : 0;  # precision for s vals
   my $f;

   $t = 0 if $t < 0;

   $t = sprintf('%.17f', $t) if $t =~ /e/;

   $t =~ s/\.(\d{1,6})\d*/\.$1/;

   if ($t > 0 && $t <= 0.000999) {
      $f = ($t * 1000000) . 'us';
   }
   elsif ($t >= 0.001000 && $t <= 0.999999) {
      $f = sprintf("%.${p_ms}f", $t * 1000);
      $f = ($f * 1) . 'ms'; # * 1 to remove insignificant zeros
   }
   elsif ($t >= 1) {
      $f = sprintf("%.${p_s}f", $t);
      $f = ($f * 1) . 's'; # * 1 to remove insignificant zeros
   }
   else {
      $f = 0;  # $t should = 0 at this point
   }

   return $f;
}

sub percentage_of {
   my ( $is, $of, %args ) = @_;
   my $p   = $args{p} || 0; # float precision
   my $fmt = $p ? "%.${p}f" : "%d";
   return sprintf $fmt, ($is * 100) / ($of ||= 1);
}

sub secs_to_time {
   my ( $secs, $fmt ) = @_;
   $secs ||= 0;
   return '00:00' unless $secs;

   $fmt ||= $secs >= 86_400 ? 'd'
          : $secs >= 3_600  ? 'h'
          :                   'm';

   return
      $fmt eq 'd' ? sprintf(
         "%d+%02d:%02d:%02d",
         int($secs / 86_400),
         int(($secs % 86_400) / 3_600),
         int(($secs % 3_600) / 60),
         $secs % 60)
      : $fmt eq 'h' ? sprintf(
         "%02d:%02d:%02d",
         int(($secs % 86_400) / 3_600),
         int(($secs % 3_600) / 60),
         $secs % 60)
      : sprintf(
         "%02d:%02d",
         int(($secs % 3_600) / 60),
         $secs % 60);
}

sub time_to_secs {
   my ( $val, $default_suffix ) = @_;
   die "I need a val argument" unless defined $val;
   my $t = 0;
   my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
   $suffix = $suffix || $default_suffix || 's';
   if ( $suffix =~ m/[smhd]/ ) {
      $t = $suffix eq 's' ? $num * 1        # Seconds
         : $suffix eq 'm' ? $num * 60       # Minutes
         : $suffix eq 'h' ? $num * 3600     # Hours
         :                  $num * 86400;   # Days

      $t *= -1 if $prefix && $prefix eq '-';
   }
   else {
      die "Invalid suffix for $val: $suffix";
   }
   return $t;
}

sub shorten {
   my ( $num, %args ) = @_;
   my $p = defined $args{p} ? $args{p} : 2;     # float precision
   my $d = defined $args{d} ? $args{d} : 1_024; # divisor
   my $n = 0;
   my @units = ('', qw(k M G T P E Z Y));
   while ( $num >= $d && $n < @units - 1 ) {
      $num /= $d;
      ++$n;
   }
   return sprintf(
      $num =~ m/\./ || $n
         ? "%.${p}f%s"
         : '%d',
      $num, $units[$n]);
}

sub ts {
   my ( $time, $gmt ) = @_;
   my ( $sec, $min, $hour, $mday, $mon, $year )
      = $gmt ? gmtime($time) : localtime($time);
   $mon  += 1;
   $year += 1900;
   my $val = sprintf("%d-%02d-%02dT%02d:%02d:%02d",
      $year, $mon, $mday, $hour, $min, $sec);
   if ( my ($us) = $time =~ m/(\.\d+)$/ ) {
      $us = sprintf("%.6f", $us);
      $us =~ s/^0\././;
      $val .= $us;
   }
   return $val;
}

sub parse_timestamp {
   my ( $val ) = @_;
   if ( my($y, $m, $d, $h, $i, $s, $f)
         = $val =~ m/^$mysql_ts$/ )
   {
      return sprintf "%d-%02d-%02d %02d:%02d:"
                     . (defined $f ? '%09.6f' : '%02d'),
                     $y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s);
   }
   return $val;
}

sub unix_timestamp {
   my ( $val, $gmt ) = @_;
   if ( my($y, $m, $d, $h, $i, $s, $us) = $val =~ m/^$proper_ts$/ ) {
      $val = $gmt
         ? timegm($s, $i, $h, $d, $m - 1, $y)
         : timelocal($s, $i, $h, $d, $m - 1, $y);
      if ( defined $us ) {
         $us = sprintf('%.6f', $us);
         $us =~ s/^0\././;
         $val .= $us;
      }
   }
   return $val;
}

sub any_unix_timestamp {
   my ( $val, $callback ) = @_;

   if ( my ($n, $suffix) = $val =~ m/^$n_ts$/ ) {
      $n = $suffix eq 's' ? $n            # Seconds
         : $suffix eq 'm' ? $n * 60       # Minutes
         : $suffix eq 'h' ? $n * 3600     # Hours
         : $suffix eq 'd' ? $n * 86400    # Days
         :                  $n;           # default: Seconds
      MKDEBUG && _d('ts is now - N[shmd]:', $n);
      return time - $n;
   }
   elsif ( $val =~ m/^\d{9,}/ ) {
      MKDEBUG && _d('ts is already a unix timestamp');
      return $val;
   }
   elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) {
      MKDEBUG && _d('ts is MySQL slow log timestamp');
      $val .= ' 00:00:00' unless $hms;
      return unix_timestamp(parse_timestamp($val));
   }
   elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) {
      MKDEBUG && _d('ts is properly formatted timestamp');
      $val .= ' 00:00:00' unless $hms;
      return unix_timestamp($val);
   }
   else {
      MKDEBUG && _d('ts is MySQL expression');
      return $callback->($val) if $callback && ref $callback eq 'CODE';
   }

   MKDEBUG && _d('Unknown ts type:', $val);
   return;
}

sub make_checksum {
   my ( $val ) = @_;
   my $checksum = uc substr(md5_hex($val), -16);
   MKDEBUG && _d($checksum, 'checksum for', $val);
   return $checksum;
}

sub crc32 {
   my ( $string ) = @_;
   return unless $string;
   my $poly = 0xEDB88320;
   my $crc  = 0xFFFFFFFF;
   foreach my $char ( split(//, $string) ) {
      my $comp = ($crc ^ ord($char)) & 0xFF;
      for ( 1 .. 8 ) {
         $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1;
      }
      $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp;
   }
   return $crc ^ 0xFFFFFFFF;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End Transformers package
# ###########################################################################

# ###########################################################################
# Progress package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/Progress.pm
#   t/lib/Progress.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package Progress;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg (qw(jobsize)) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   if ( (!$args{report} || !$args{interval}) ) {
      if ( $args{spec} && @{$args{spec}} == 2 ) {
         @args{qw(report interval)} = @{$args{spec}};
      }
      else {
         die "I need either report and interval arguments, or a spec";
      }
   }

   my $name  = $args{name} || "Progress";
   $args{start} ||= time();
   my $self;
   $self = {
      last_reported => $args{start},
      fraction      => 0,       # How complete the job is
      callback      => sub {
         my ($fraction, $elapsed, $remaining, $eta) = @_;
         printf STDERR "$name: %3d%% %s remain\n",
            $fraction * 100,
            Transformers::secs_to_time($remaining),
            Transformers::ts($eta);
      },
      %args,
   };
   return bless $self, $class;
}

sub validate_spec {
   shift @_ if $_[0] eq 'Progress'; # Permit calling as Progress-> or Progress::
   my ( $spec ) = @_;
   if ( @$spec != 2 ) {
      die "spec array requires a two-part argument\n";
   }
   if ( $spec->[0] !~ m/^(?:percentage|time|iterations)$/ ) {
      die "spec array's first element must be one of "
        . "percentage,time,iterations\n";
   }
   if ( $spec->[1] !~ m/^\d+$/ ) {
      die "spec array's second element must be an integer\n";
   }
}

sub set_callback {
   my ( $self, $callback ) = @_;
   $self->{callback} = $callback;
}

sub start {
   my ( $self, $start ) = @_;
   $self->{start} = $self->{last_reported} = $start || time();
   $self->{first_report} = 0;
}

sub update {
   my ( $self, $callback, %args ) = @_;
   my $jobsize   = $self->{jobsize};
   my $now    ||= $args{now} || time;

   $self->{iterations}++; # How many updates have happened;

   if ( !$self->{first_report} && $args{first_report} ) {
      $args{first_report}->();
      $self->{first_report} = 1;
   }

   if ( $self->{report} eq 'time'
         && $self->{interval} > $now - $self->{last_reported}
   ) {
      return;
   }
   elsif ( $self->{report} eq 'iterations'
         && ($self->{iterations} - 1) % $self->{interval} > 0
   ) {
      return;
   }
   $self->{last_reported} = $now;

   my $completed = $callback->();
   $self->{updates}++; # How many times we have run the update callback

   return if $completed > $jobsize;

   my $fraction = $completed > 0 ? $completed / $jobsize : 0;

   if ( $self->{report} eq 'percentage'
         && $self->fraction_modulo($self->{fraction})
            >= $self->fraction_modulo($fraction)
   ) {
      $self->{fraction} = $fraction;
      return;
   }
   $self->{fraction} = $fraction;

   my $elapsed   = $now - $self->{start};
   my $remaining = 0;
   my $eta       = $now;
   if ( $completed > 0 && $completed <= $jobsize && $elapsed > 0 ) {
      my $rate = $completed / $elapsed;
      if ( $rate > 0 ) {
         $remaining = ($jobsize - $completed) / $rate;
         $eta       = $now + int($remaining);
      }
   }
   $self->{callback}->($fraction, $elapsed, $remaining, $eta, $completed);
}

sub fraction_modulo {
   my ( $self, $num ) = @_;
   $num *= 100; # Convert from fraction to percentage
   return sprintf('%d',
      sprintf('%d', $num / $self->{interval}) * $self->{interval});
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End Progress package
# ###########################################################################

# ###########################################################################
# ReplicaLagWaiter package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/ReplicaLagWaiter.pm
#   t/lib/ReplicaLagWaiter.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package ReplicaLagWaiter;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use Time::HiRes qw(sleep time);
use Data::Dumper;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(oktorun get_lag sleep max_lag slaves);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   my $self = {
      %args,
   };

   return bless $self, $class;
}

sub wait {
   my ( $self, %args ) = @_;
   my @required_args = qw();
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $pr = $args{Progress};

   my $oktorun = $self->{oktorun};
   my $get_lag = $self->{get_lag};
   my $sleep   = $self->{sleep};
   my $slaves  = $self->{slaves};
   my $max_lag = $self->{max_lag};

   my $worst;  # most lagging slave
   my $pr_callback;
   my $pr_first_report;
   if ( $pr ) {
      $pr_callback = sub {
         my ($fraction, $elapsed, $remaining, $eta, $completed) = @_;
         my $dsn_name = $worst->{cxn}->name();
         if ( defined $worst->{lag} ) {
            print STDERR "Replica lag is " . ($worst->{lag} || '?')
               . " seconds on $dsn_name.  Waiting.\n";
         }
         else {
            print STDERR "Replica $dsn_name is stopped.  Waiting.\n";
         }
         return;
      };
      $pr->set_callback($pr_callback);

      $pr_first_report = sub {
         my $dsn_name = $worst->{cxn}->name();
         if ( !defined $worst->{lag} ) {
            print STDERR "Replica $dsn_name is stopped.  Waiting.\n";
         }
         return;
      };
   }

   my @lagged_slaves = map { {cxn=>$_, lag=>undef} } @$slaves;  
   while ( $oktorun->() && @lagged_slaves ) {
      MKDEBUG && _d('Checking slave lag');
      for my $i ( 0..$#lagged_slaves ) {
         my $lag = $get_lag->($lagged_slaves[$i]->{cxn});
         MKDEBUG && _d($lagged_slaves[$i]->{cxn}->name(),
            'slave lag:', $lag);
         if ( !defined $lag || $lag > $max_lag ) {
            $lagged_slaves[$i]->{lag} = $lag;
         }
         else {
            delete $lagged_slaves[$i];
         }
      }

      @lagged_slaves = grep { defined $_ } @lagged_slaves;
      if ( @lagged_slaves ) {
         @lagged_slaves = reverse sort {
              defined $a->{lag} && defined $b->{lag} ? $a->{lag} <=> $b->{lag}
            : defined $a->{lag}                      ? -1
            :                                           1;
         } @lagged_slaves;
         $worst = $lagged_slaves[0];
         MKDEBUG && _d(scalar @lagged_slaves, 'slaves are lagging, worst:',
            $worst->{lag}, 'on', Dumper($worst->{cxn}->dsn()));

         if ( $pr ) {
            $pr->update(
               sub { return 0; },
               first_report => $pr_first_report,
            );
         }

         MKDEBUG && _d('Calling sleep callback');
         $sleep->($worst->{cxn}, $worst->{lag});
      }
   }

   MKDEBUG && _d('All slaves caught up');
   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End ReplicaLagWaiter package
# ###########################################################################

# ###########################################################################
# MySQLStatusWaiter package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/MySQLStatusWaiter.pm
#   t/lib/MySQLStatusWaiter.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package MySQLStatusWaiter;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(spec get_status sleep oktorun);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   my $max_val_for = _parse_spec(%args);

   my $self = {
      get_status  => $args{get_status},
      sleep       => $args{sleep},
      oktorun     => $args{oktorun},
      max_val_for => $max_val_for,
   };

   return bless $self, $class;
}

sub _parse_spec {
   my ( %args ) = @_;
   my @required_args = qw(spec get_status);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   my ($spec, $get_status) = @args{@required_args};

   if ( !@$spec ) {
      MKDEBUG && _d('No spec, disabling status var waits');
      return;
   }

   my %max_val_for;
   foreach my $var_val ( @$spec ) {
      my ($var, $val) = split /[:=]/, $var_val;
      die "Invalid spec: $var_val" unless $var;
      if ( !$val ) {
         my $init_val = $get_status->($var);
         MKDEBUG && _d('Initial', $var, 'value:', $init_val);
         $val = int(($init_val * .20) + $init_val);
      }
      MKDEBUG && _d('Wait if', $var, '>=', $val);
      $max_val_for{$var} = $val;
   }

   return \%max_val_for; 
}

sub max_values {
   my ($self) = @_;
   return $self->{max_val_for};
}

sub wait {
   my ( $self, %args ) = @_;

   return unless $self->{max_val_for};

   my $pr = $args{Progress}; # optional

   my $oktorun    = $self->{oktorun};
   my $get_status = $self->{get_status};
   my $sleep      = $self->{sleep};
   
   my %vals_too_high = %{$self->{max_val_for}};
   my $pr_callback;
   if ( $pr ) {
      $pr_callback = sub {
         print STDERR "Pausing because "
            . join(', ',
                 map {
                    "$_="
                    . (defined $vals_too_high{$_} ? $vals_too_high{$_}
                                                  : 'unknown')
                 } sort keys %vals_too_high
              )
            . ".\n";
         return;
      };
      $pr->set_callback($pr_callback);
   }

   while ( $oktorun->() ) {
      MKDEBUG && _d('Checking status variables');
      foreach my $var ( sort keys %vals_too_high ) {
         my $val = $get_status->($var);
         MKDEBUG && _d($var, '=', $val);
         if ( !$val || $val >= $self->{max_val_for}->{$var} ) {
            $vals_too_high{$var} = $val;
         }
         else {
            delete $vals_too_high{$var};
         }
      }

      last unless scalar keys %vals_too_high;

      MKDEBUG && _d(scalar keys %vals_too_high, 'values are too high:',
         %vals_too_high);
      if ( $pr ) {
         $pr->update(sub { return 0; });
      }
      MKDEBUG && _d('Calling sleep callback');
      $sleep->();
      %vals_too_high = %{$self->{max_val_for}}; # recheck all vars
   }

   MKDEBUG && _d('All var vals are low enough');
   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End MySQLStatusWaiter package
# ###########################################################################

# ###########################################################################
# WeightedAvgRate package
# This package is a copy without comments from the original.  The original
# with comments and its test file can be found in the Bazaar repository at,
#   lib/WeightedAvgRate.pm
#   t/lib/WeightedAvgRate.t
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package WeightedAvgRate;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

sub new {
   my ( $class, %args ) = @_;
   my @required_args = qw(target_t);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   my $self = {
      %args,
      avg_n  => 0,
      avg_t  => 0,
      weight => $args{weight} || 0.75,
   };

   return bless $self, $class;
}

sub update {
   my ($self, $n, $t) = @_;
   MKDEBUG && _d('Master op time:', $n, 'n /', $t, 's');

   if ( $self->{avg_n} && $self->{avg_t} ) {
      $self->{avg_n}    = ($self->{avg_n} * $self->{weight}) + $n;
      $self->{avg_t}    = ($self->{avg_t} * $self->{weight}) + $t;
      $self->{avg_rate} = $self->{avg_n}  / $self->{avg_t};
      MKDEBUG && _d('Weighted avg rate:', $self->{avg_rate}, 'n/s');
   }
   else {
      $self->{avg_n}    = $n;
      $self->{avg_t}    = $t;
      $self->{avg_rate} = $self->{avg_n}  / $self->{avg_t};
      MKDEBUG && _d('Initial avg rate:', $self->{avg_rate}, 'n/s');
   }

   my $new_n = int($self->{avg_rate} * $self->{target_t});
   MKDEBUG && _d('Adjust n to', $new_n);
   return $new_n;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

1;
}
# ###########################################################################
# End WeightedAvgRate package
# ###########################################################################

# ###########################################################################
# This is a combination of modules and programs in one -- a runnable module.
# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
#
# Check at the end of this package for the call to main() which actually runs
# the program.
# ###########################################################################
package pt_table_checksum;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;

use POSIX qw(signal_h);
use List::Util qw(max);
use Time::HiRes qw(sleep time);
use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Quotekeys = 0;

use sigtrap 'handler', \&sig_int, 'normal-signals';

my $oktorun      = 1;
my $print_header = 1;

sub main {
   # Reset global vars else tests will fail in strange ways.
   @ARGV         = @_;
   $oktorun      = 1;  
   $print_header = 1;

   my $exit_status = 0;

   # ########################################################################
   # Get configuration information.
   # ########################################################################
   my $o = new OptionParser();
   $o->get_specs();
   $o->get_opts();

   my $dp = $o->DSNParser();
   $dp->prop('set-vars', $o->get('set-vars'));

   # Add the --replicate table to --ignore-tables.
   my %ignore_tables = (
      %{$o->get('ignore-tables')},
      $o->get('replicate') => 1,
   );
   $o->set('ignore-tables', \%ignore_tables);

   if ( !$o->get('help') ) {
      if ( @ARGV > 1 ) {
         $o->save_error("More than one host specified; only one allowed");
      }

      if ( ($o->get('replicate') || '') !~ m/[\w`]\.[\w`]/ ) {
         $o->save_error('The --replicate table must be database-qualified');
      }

      if ( my $limit = $o->get('chunk-size-limit') ) {
         if ( $limit < 0 || ($limit > 0 && $limit < 1) ) {
            $o->save_error('--chunk-size-limit must be >= 1 or 0 to disable');
         }
      }

      if ( $o->get('progress') ) {
         eval { Progress->validate_spec($o->get('progress')) };
         if ( $EVAL_ERROR ) {
            chomp $EVAL_ERROR;
            $o->save_error("--progress $EVAL_ERROR");
         }
      }
   }

   $o->usage_or_errors();

   # ########################################################################
   # If --pid, check it first since we'll die if it already exists.
   # ########################################################################
   my $daemon;
   if ( $o->get('pid') ) {
      # We're not daemoninzing, it just handles PID stuff.  Keep $daemon
      # in the the scope of main() because when it's destroyed it automatically
      # removes the PID file.
      $daemon = new Daemon(o=>$o);
      $daemon->make_PID_file();
   }

   # ########################################################################
   # Connect to the master.
   # ########################################################################
   my $set_on_connect = sub {
      my ($dbh) = @_;

      return if $o->get('explain');

      my $sql = 'SET /*!50108 @@binlog_format := "STATEMENT"*/';
      MKDEBUG && _d($dbh, $sql);
      $dbh->do($sql);

      # Set transaction isolation level. We set binlog_format to STATEMENT,
      # but if the transaction isolation level is set to READ COMMITTED and the
      # --replicate table is in InnoDB format, the tool fails with the following
      # message:
      #
      # Binary logging not possible. Message: Transaction level 'READ-COMMITTED'
      # in InnoDB is not safe for binlog mode 'STATEMENT'
      #
      # See also http://code.google.com/p/maatkit/issues/detail?id=720
      $sql = 'SET SESSION TRANSACTION ISOLATION LEVEL REPEATABLE READ';
      eval {
         MKDEBUG && _d($dbh, $sql);
         $dbh->do($sql);
      };
      if ( $EVAL_ERROR ) {
         die "Failed to $sql: $EVAL_ERROR\n"
            . "If the --replicate table is InnoDB and the default server "
            . "transaction isolation level is not REPEATABLE-READ then "
            . "checksumming may fail with errors such as \"Binary logging not "
            . "possible. Message: Transaction level 'READ-COMMITTED' in "
            . "InnoDB is not safe for binlog mode 'STATEMENT'\".  In that "
            . "case you will need to manually set the transaction isolation "
            . "level to REPEATABLE-READ.\n";
      }

      # We set innodb_lock_wait_timeout=1 so that if this tool happens to cause
      # some locking, it will be more likely to be the victim than other
      # connections to the server, and thus disrupt the server less.
      $sql = 'SHOW SESSION VARIABLES LIKE "innodb_lock_wait_timeout"';
      MKDEBUG && _d($dbh, $sql);
      my (undef, $lock_wait_timeout) = $dbh->selectrow_array($sql);
      MKDEBUG && _d('innodb_lock_wait_timeout', $lock_wait_timeout);
      if ( ($lock_wait_timeout || 0) > $o->get('lock-wait-timeout') ) {
         $sql = 'SET SESSION innodb_lock_wait_timeout=1';
         eval {
            MKDEBUG && _d($dbh, $sql);
            $dbh->do($sql);
         };
         if ( $EVAL_ERROR ) {
            warn "Failed to $sql: $EVAL_ERROR\n"
               . "The current innodb_lock_wait_timeout value "
               . "$lock_wait_timeout is higher than the --lock-wait-timeout "
               . "value " . $o->get('lock-wait-timeout') . " and the variable "
               . "cannot be changed.  innodb_lock_wait_timeout is only dynamic "
               . "when using the InnoDB plugin.  To prevent this warning, either "
               . "specify --lock-wait-time=$lock_wait_timeout, or manually "
               . "set innodb_lock_wait_timeout to a value less than or equal "
               . "to " . $o->get('lock-wait-timeout') . " and restart MySQL.\n";
         }
      }
   };

   # Do not call "new Cxn(" directly; use this sub so that set_on_connect
   # is applied to every cxn.
   # TODO: maybe this stuff only needs to be set on master cxn?
   my $make_cxn = sub {
      my (%args) = @_;
      my $cxn = new Cxn(
         %args,
         DSNParser    => $dp,
         OptionParser => $o,
         set          => $args{set_vars} ? $set_on_connect : undef,
      );
      eval { $cxn->connect() };  # connect or die trying
      if ( $EVAL_ERROR ) {
         die ts($EVAL_ERROR);
      }
      return $cxn;
   };

   # The dbh and dsn can be used before checksumming starts, but once
   # inside the main TABLE loop, only use the master cxn because its
   # dbh may be recreated.
   my $master_cxn = $make_cxn->(set_vars => 1, dsn_string => shift @ARGV);
   my $master_dbh = $master_cxn->dbh();  # just for brevity
   my $master_dsn = $master_cxn->dsn();  # just for brevity

   # ########################################################################
   # If this is not a dry run (--explain was not specified), then we're
   # going to checksum the tables, so do the necessary preparations and
   # checks.  Else, this all can be skipped because all we need for a
   # dry run is a connection to the master.
   # ########################################################################
   my $q  = new Quoter();
   my $tp = new TableParser(Quoter => $q);
   my $rc = new RowChecksum(Quoter=> $q, OptionParser => $o);
   my $vp = new VersionParser();
   my $ms = new MasterSlave(VersionParser => $vp);

   my $slaves;         # all slaves (that we can find)
   my $slave_lag_cxns; # slaves whose lag we'll check
   
   my $replica_lag;    # ReplicaLagWaiter object
   my $replica_lag_pr; # Progress for ReplicaLagWaiter
   my $sys_load;       # MySQLStatusWaiter object
   my $sys_load_pr;    # Progress for MySQLStatusWaiter object

   my $repl_table = $q->quote($q->split_unquote($o->get('replicate')));
   my $fetch_sth;  # fetch chunk from repl table
   my $update_sth; # update master_cnt and master_cnt in repl table
   my $delete_sth; # delete checksums for one db.tbl from repl table

   if ( !$o->get('explain') ) {
      # #####################################################################
      # Find and connect to slaves.
      # #####################################################################
      $slaves = $ms->get_slaves(
         dbh          => $master_dbh,
         dsn          => $master_dsn,
         OptionParser => $o,
         DSNParser    => $dp,
         Quoter       => $q,
         make_cxn     => sub {
            return $make_cxn->(@_, prev_dsn => $master_cxn->dsn());
         },
      );
      MKDEBUG && _d(scalar @$slaves, 'slaves found');

      if ( $o->get('check-slave-lag') ) {
         MKDEBUG && _d('Will use --check-slave-lag to check for slave lag');
         my $cxn = $make_cxn->(
            dsn_string => $o->get('check-slave-lag'),
            prev_dsn   => $master_cxn->dsn(),
         );
         $slave_lag_cxns = [ $cxn ];
      }
      else {
         MKDEBUG && _d('Will check slave lag on all slaves');
         $slave_lag_cxns = $slaves;
      }

      # #####################################################################
      # Check replication slaves and possibly exit.
      # #####################################################################
      if ( $o->get('replicate-check') && !$o->get('recheck') ) {
         MKDEBUG && _d('Will --replicate-check and exit');

         foreach my $slave ( @$slaves ) {
            my $diffs = $rc->find_replication_differences(
               dbh        => $slave->dbh(),
               repl_table => $repl_table,
            );
            MKDEBUG && _d(scalar @$diffs, 'checksum diffs on',
               $slave->name());
            if ( @$diffs ) {
               $exit_status |= 1;
               if ( $o->get('quiet') < 2 ) { 
                  print_checksum_diffs(
                     cxn   => $slave,
                     diffs => $diffs,
                  );
               }
            }
         }

         MKDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun);
         return $exit_status;
      }

      # #####################################################################
      # Check for replication filters.
      # #####################################################################
      if ( $o->get('check-replication-filters') ) {
         MKDEBUG && _d("Checking slave replication filters");
         my @all_repl_filters;
         foreach my $slave ( @$slaves ) {
            my $repl_filters = $ms->get_replication_filters(
               dbh => $slave->dbh(),
            );
            if ( keys %$repl_filters ) {
               push @all_repl_filters,
                  { name    => $slave->name(),
                    filters => $repl_filters,
                  };
            }
         }
         if ( @all_repl_filters ) {
            my $msg = "Replication filters are set on these hosts:\n";
            foreach my $host ( @all_repl_filters ) {
               my $filters = $host->{filters};
               $msg .= "  $host->{name}\n"
                     . join("\n", map { "    $_ = $host->{filters}->{$_}" }
                            keys %{$host->{filters}})
                     . "\n";
            }
            $msg .= "Please read the --check-replication-filters documentation "
                  . "to learn how to solve this problem.";
            die ts($msg);
         }
      }

      # #####################################################################
      # Check that the replication table exists, or possibly create it.
      # #####################################################################
      eval {
         check_repl_table(
            dbh          => $master_dbh,
            repl_table   => $repl_table,
            OptionParser => $o,
            TableParser  => $tp,
            Quoter       => $q,
         );
      };
      if ( $EVAL_ERROR ) {
         die ts($EVAL_ERROR);
      }

      # #####################################################################
      # Make a ReplicaLagWaiter to help wait for slaves after each chunk.
      # #####################################################################
      my $sleep = sub {
         # Don't let the master dbh die while waiting for slaves because we
         # may wait a very long time for slaves.

         # This is called from within the main TABLE loop, so use the
         # master cxn; do not use $master_dbh.
         my $dbh = $master_cxn->dbh();
         if ( !$dbh || !$dbh->ping() ) {
            MKDEBUG && _d('Lost connection to master while waiting for slave lag');
            eval { $dbh = $master_cxn->connect() };  # connect or die trying
            if ( $EVAL_ERROR ) {
               $oktorun = 0;  # Fatal error
               chomp $EVAL_ERROR;
               die "Lost connection to master while waiting for replica lag "
                  . "($EVAL_ERROR)";
            }
         }
         $dbh->do("SELECT 'pt-table-checksum keepalive'");
         sleep $o->get('check-interval');
         return;
      };

      my $get_lag = sub {
         my ($cxn) = @_;
         my $dbh = $cxn->dbh();
         if ( !$dbh || !$dbh->ping() ) {
            MKDEBUG && _d('Lost connection to slave', $cxn->name(),
               'while waiting for slave lag');
            eval { $dbh = $cxn->connect() };  # connect or die trying
            if ( $EVAL_ERROR ) {
               $oktorun = 0;  # Fatal error
               chomp $EVAL_ERROR;
               die "Lost connection to replica " . $cxn->name()
                  . " while attempting to get its lag ($EVAL_ERROR)";
            }
         }
         return $ms->get_slave_lag($dbh);
      };

      $replica_lag = new ReplicaLagWaiter(
         slaves   => $slave_lag_cxns,
         max_lag  => $o->get('max-lag'),
         oktorun  => sub { return $oktorun },
         get_lag  => $get_lag,
         sleep    => $sleep,
      );

      my $get_status;
      {
         my $sql = "SHOW GLOBAL STATUS LIKE ?";
         my $sth = $master_cxn->dbh()->prepare($sql);

         $get_status = sub {
            my ($var) = @_;
            MKDEBUG && _d($sth->{Statement}, $var);
            $sth->execute($var);
            my (undef, $val) = $sth->fetchrow_array();
            return $val;
         };
      }

      $sys_load = new MySQLStatusWaiter(
         spec       => $o->get('max-load'),
         get_status => $get_status,
         oktorun    => sub { return $oktorun },
         sleep      => $sleep,
      );
      
      if ( $o->get('progress') ) {
         $replica_lag_pr = new Progress(
            jobsize => scalar @$slaves,
            spec    => $o->get('progress'),
            name    => "Waiting for replicas to catch up",  # not used
         );

         $sys_load_pr = new Progress(
            jobsize => scalar @{$o->get('max-load')},
            spec    => $o->get('progress'),
            name    => "Waiting for --max-load", # not used
         );
      }

      # #####################################################################
      # Prepare statement handles to update the repl table on the master.
      # #####################################################################
      $fetch_sth = $master_dbh->prepare(
         "SELECT this_crc, this_cnt FROM $repl_table "
         . "WHERE db = ? AND tbl = ? AND chunk = ?");
      $update_sth = $master_dbh->prepare(
         "UPDATE $repl_table SET chunk_time = ?, master_crc = ?, master_cnt = ? "
         . "WHERE db = ? AND tbl = ? AND chunk = ?");
      $delete_sth = $master_dbh->prepare(
         "DELETE FROM $repl_table WHERE db = ? AND tbl = ?");
   } # !$o->get('explain')

   # ########################################################################
   # Checksum args and the DMS part of the checksum query for each table.
   # ########################################################################
   my %crc_args     = $rc->get_crc_args(dbh => $master_dbh);
   my $checksum_dms = "REPLACE INTO $repl_table "
                   . "(db, tbl, chunk, chunk_index,"
                   . " lower_boundary, upper_boundary, this_cnt, this_crc) "
                   . "SELECT ?, ?, ?, ?, ?, ?,";

   # ########################################################################
   # Get last chunk for --resume.
   # ########################################################################
   my $last_chunk;
   if ( $o->get('resume') ) {
      $last_chunk = last_chunk(
         dbh        => $master_dbh,
         repl_table => $repl_table,
      );
   }

   # ########################################################################
   # Various variables and modules for checksumming the tables.
   # ########################################################################
   my $total_rows = 0;
   my $total_time = 0;
   my $total_rate = 0;
   my $limit      = $o->get('chunk-size-limit');
   my $tn         = new TableNibbler(TableParser => $tp, Quoter => $q);
   my $retry      = new Retry();

   # ########################################################################
   # Callbacks for each table's nibble iterator.  All checksum work is done
   # in these callbacks and the subs that they call.
   # ########################################################################
   my $callbacks = {
      init => sub {
         my (%args) = @_;
         my $tbl         = $args{tbl};
         my $nibble_iter = $args{NibbleIterator};
         my $oktonibble  = 1;

         if ( $o->get('explain') ) {
            # --explain level 1: print the checksum and next boundary
            # statements.
            print "--\n",
                  "-- $tbl->{db}.$tbl->{tbl}\n",
                  "--\n\n";
            my $statements = $nibble_iter->statements();
            foreach my $sth ( sort keys %$statements ) {
               next if $sth =~ m/^explain/;
               if ( $statements->{$sth} ) {
                  print $statements->{$sth}->{Statement}, "\n\n";
               }
            }

            if ( $o->get('explain') < 2 ) {
               $oktonibble = 0; # don't nibble table; next table
            }
         }
         elsif ( $last_chunk ) { # resuming
            my $next_lb = next_lower_boundary(
               %args,
               last_chunk => $last_chunk,
               Quoter     => $q,
            );
            if ( !$next_lb ) {
               # This can happen if the tool stops after the last checksum
               # of a table.  So we just start with the next table.
               MKDEBUG && _d('Resuming from last chunk in table;',
                  'getting next table');
               $oktonibble = 0; # don't nibbling table; next table
            }
            else {
               $nibble_iter->set_nibble_number($last_chunk->{chunk});
               $nibble_iter->set_boundary('next_lower', $next_lb);
               MKDEBUG && _d('Resuming from', $last_chunk->{chunk},
                  'at', $last_chunk->{ts});
               if ( !$o->get('quiet') ) {
                  print "Resuming from $tbl->{db}.$tbl->{tbl} chunk "
                     . "$last_chunk->{chunk}, timestamp $last_chunk->{ts}\n";
               }
            }

            # Just need to call us once to kick-start the resume process.
            $last_chunk = undef;
         }
         elsif ( $o->get('empty-replicate-table') ) {
            use_repl_db(
               dbh          => $master_cxn->dbh(),
               repl_table   => $repl_table,
               OptionParser => $o,
               Quoter       => $q,
            );
            MKDEBUG && _d($delete_sth->{Statement});
            $delete_sth->execute($tbl->{db}, $tbl->{tbl});
         }

         # USE the correct db while checksumming this table.  The "correct"
         # db is a complicated subject; see sub for comments.
         use_repl_db(
            dbh          => $master_cxn->dbh(),
            tbl          => $tbl, # XXX working on this table
            repl_table   => $repl_table,
            OptionParser => $o,
            Quoter       => $q,
         );
         # #########################################################
         # XXX DO NOT CHANGE THE DB UNTIL THIS TABLE IS FINISHED XXX
         # #########################################################

         return $oktonibble; # continue nibbling table?
      },
      next_boundaries => sub {
         my (%args) = @_;
         my $tbl         = $args{tbl};
         my $nibble_iter = $args{NibbleIterator};
         my $sth         = $nibble_iter->statements();
         my $boundary    = $nibble_iter->boundaries();

         return 1 if $nibble_iter->one_nibble();

         # Check that MySQL will use the nibble index for the next upper
         # boundary sql.  This check applies to the next nibble.  So if
         # the current nibble number is 5, then nibble 5 is already done
         # and we're checking nibble number 6.
         my $expl = explain_statement(
            tbl  => $tbl,
            sth  => $sth->{explain_upper_boundary},
            vals => [ @{$boundary->{lower}}, $nibble_iter->chunk_size() ],
         );
         if ( ($expl->{key} || '') ne $nibble_iter->nibble_index() ) {
            MKDEBUG && _d('Cannot nibble next chunk, aborting table');
            if ( $o->get('quiet') < 2 ) {
               warn ts("Aborting $tbl->{db}.$tbl->{tbl} because "
                  . ($nibble_iter->nibble_number() + 1)
                  . " cannot be nibbled safely.\n");
            }
            $tbl->{checksum_results}->{errors}++;
            return 0; # stop nibbling table
         }

         # Once nibbling begins for a table, control does not return to this
         # tool until nibbling is done because, as noted above, all work is
         # done in these callbacks.  This callback is the only place where we
         # can prematurely stop nibbling by returning false.  This allows
         # Ctrl-C to stop the tool between nibbles instead of between tables.
         return $oktorun; # continue nibbling table?
      },
      exec_nibble => sub {
         my (%args) = @_;
         my $tbl         = $args{tbl};
         my $nibble_iter = $args{NibbleIterator};
         my $sth         = $nibble_iter->statements();
         my $boundary    = $nibble_iter->boundaries();

         # Count every chunk, even if it's ultimately skipped, etc.
         $tbl->{checksum_results}->{n_chunks}++;

         # --explain level 2: print chunk,lower boundary values,upper
         # boundary values.
         if ( $o->get('explain') > 1 ) {
            my $lb_quoted = join(',', @{$boundary->{lower}});
            my $ub_quoted = join(',', @{$boundary->{upper}});
            my $chunk     = $nibble_iter->nibble_number();
            printf "%d %s %s\n",
               $chunk,
               (defined $lb_quoted ? $lb_quoted : '1=1'),
               (defined $ub_quoted ? $ub_quoted : '1=1');
            if ( !$nibble_iter->more_boundaries() ) {
               print "\n"; # blank line between this table and the next table
            }
            return 0;  # next boundary
         }

         # If the table is being chunk (i.e., it's not small enough to be
         # consumed by one nibble), then check index usage and chunk size.
         if ( !$nibble_iter->one_nibble() ) {
            my $expl = explain_statement(
               tbl  => $tbl,
               sth  => $sth->{explain_nibble},
               vals => [ @{$boundary->{lower}}, @{$boundary->{upper}} ],
            );
            my $oversize_chunk
               = $limit ? ($expl->{rows} || 0) >= $tbl->{chunk_size} * $limit
               :          0;

            # Ensure that MySQL is using the chunk index.
            if ( ($expl->{key} || '') ne $nibble_iter->nibble_index() ) {
               MKDEBUG && _d('Chunk', $args{nibbleno}, 'of table',
                  "$tbl->{db}.$tbl->{tbl} not using chunk index, skipping");
               return 0;  # next boundary
            }

            # Check chunk size limit if the upper boundary and next lower
            # boundary are identical.
            if ( $limit ) {
               my $boundary = $nibble_iter->boundaries(); 
               if ( $nibble_iter->identical_boundaries(
                       $boundary->{upper}, $boundary->{next_lower})
                    && $oversize_chunk ) {
                  MKDEBUG && _d('Chunk', $args{nibbleno}, 'of table',
                     "$tbl->{db}.$tbl->{tbl} is too large, skipping");
                  return 0;  # next boundary
               }
            }
         }

         # Exec and time the chunk checksum query.
         $tbl->{nibble_time} = exec_nibble(
            %args,
            Retry        => $retry,
            Quoter       => $q,
            OptionParser => $o,
         );
         MKDEBUG && _d('Nibble time:', $tbl->{nibble_time});

         # We're executing REPLACE queries which don't return rows.
         # Returning 0 from this callback causes the nibble iter to
         # get the next boundaries/nibble.
         return 0;
      },
      after_nibble => sub {
         my (%args) = @_;
         my $tbl         = $args{tbl};
         my $nibble_iter = $args{NibbleIterator};
         
         # Don't need to do anything here if we're just --explain'ing.
         return if $o->get('explain');

         # Chunk/nibble number that we just inserted or skipped.
         my $chunk = $nibble_iter->nibble_number();

         # Nibble time will be zero if the chunk was skipped.
         if ( !defined $tbl->{nibble_time} ) {
            MKDEBUG && _d('Skipping chunk', $chunk);
            $tbl->{checksum_results}->{skipped}++;
            return;
         }

         # Max chunk number that worked.  This may be less than the total
         # number of chunks if, for example, chunk 16 of 16 times out, but
         # chunk 15 worked.  The max chunk is used for checking for diffs
         # on the slaves, in the done callback.
         $tbl->{max_chunk} = $chunk;

         # Fetch the checksum that we just executed from the replicate table.
         $fetch_sth->execute(@{$tbl}{qw(db tbl)}, $chunk);
         my ($crc, $cnt) = $fetch_sth->fetchrow_array();

         $tbl->{checksum_results}->{n_rows} += $cnt || 0;

         # We're working on the master, so update the checksum's master_cnt
         # and master_crc.
         $update_sth->execute(
            # UPDATE repl_table SET
            sprintf('%.6f', $tbl->{nibble_time}), # chunk_time
            $crc,                                 # master_crc
            $cnt,                                 # master_cnt
            # WHERE
            $tbl->{db},
            $tbl->{tbl},
            $chunk,
         );

         # Should be done automatically, but I like to be explicit.
         $fetch_sth->finish();
         $update_sth->finish();

         # Update rate, chunk size, and progress if the nibble actually
         # selected some rows.
         if ( ($cnt || 0) > 0 ) {
            # Update the rate of rows per second for the entire server.
            # This is used for the initial chunk size of the next table.
            $total_rows += $cnt;
            $total_time += $tbl->{nibble_time};
            $total_rate  = int($total_rows / $total_time);
            MKDEBUG && _d('Total avg rate:', $total_rate);

            # Adjust chunk size.  This affects the next chunk.
            if ( $o->get('chunk-time') ) {
               $tbl->{chunk_size}
                  = $tbl->{rate}->update($cnt, $tbl->{nibble_time});

               if ( $tbl->{chunk_size} < 1 ) {
                  # This shouldn't happen.  WeightedAvgRate::update() may return
                  # a value < 1, but minimum chunk size is 1.
                  $tbl->{chunk_size} = 1;

                  # This warning is printed once per table.
                  if ( !$tbl->{warned_slow} && $o->get('quiet') < 2 ) {
                     warn ts("Checksum queries for table "
                        . "$tbl->{db}.$tbl->{tbl} are executing very slowly.  "
                        . "--chunk-size has been automatically reduced to 1.  "
                        . "Check that the server is not being overloaded, "
                        . "or increase --chunk-time.  The last chunk, number "
                        . "$chunk of table $tbl->{db}.$tbl->{tbl}, "
                        . "selected $cnt rows and took "
                        . sprintf('%.3f', $tbl->{nibble_time})
                        . " seconds to execute.\n");
                     $tbl->{warned_slow} = 1;
                  }
               }

               # Update chunk-size based on rows/s checksum rate.
               $nibble_iter->set_chunk_size($tbl->{chunk_size});
            }

            # Every table should have a Progress obj; update it.
            if ( my $tbl_pr = $tbl->{progress} ) {
               $tbl_pr->update(sub {return $tbl->{checksum_results}->{n_rows}});
            }
         }

         # Wait forever for slaves to catch up.
         $replica_lag_pr->start() if $replica_lag_pr;
         $replica_lag->wait(Progress => $replica_lag_pr);

         # Wait forever for system load to abate.
         $sys_load_pr->start() if $sys_load_pr;
         $sys_load->wait(Progress => $sys_load_pr);

         return;
      },
      done => sub { # done nibbling table
         my (%args) = @_;
         my $tbl         = $args{tbl};
         my $nibble_iter = $args{NibbleIterator};
         my $max_chunk   = $tbl->{max_chunk};

         # Don't need to do anything here if we're just --explain'ing.
         return if $o->get('explain');

         # Wait for all slaves to run all checksum chunks,
         # then check for differences.
         if ( $max_chunk && $o->get('replicate-check') && scalar @$slaves ) {
            MKDEBUG && _d('Checking slave diffs');

            my $check_pr;
            if ( $o->get('progress') ) {
               $check_pr = new Progress(
                  jobsize => $max_chunk,
                  spec    => $o->get('progress'),
                  name    => "Waiting to check replicas for differences",
               );
            }

            # Requiring "AND master_crc IS NOT NULL" avoids a race condition
            # when the system is fast but replication is slow.  In such cases,
            # we can select on the slave before the update for $update_sth
            # replicates; this causes a false-positive diff.
            my $sql = "SELECT MAX(chunk) FROM $repl_table "
                    . "WHERE db='$tbl->{db}' AND tbl='$tbl->{tbl}' "
                    . "AND master_crc IS NOT NULL";
            MKDEBUG && _d($sql);

            my $sleep_time = 0;
            my $n_slaves   = scalar @$slaves - 1;
            my @chunks     = (0);
            while ( $oktorun && ($chunks[0] < $max_chunk) ) {
               for my $i ( 0..$n_slaves ) {
                  my $slave = $slaves->[$i];
                  my ($chunk) = $slave->dbh()->selectrow_array($sql);
                  MKDEBUG && _d($slave->name(), 'max chunk:', $chunk);
                  $chunks[$i] = $chunk || 0;
               }
               @chunks = sort { $a <=> $b } @chunks;
               if ( $chunks[0] < $max_chunk ) {
                  if ( $check_pr ) {
                     $check_pr->update(sub { return $chunks[0]; });
                  }

                  # We shouldn't have to wait long here because we already
                  # waited for all slaves to catchup at least until --max-lag.
                  $sleep_time += 0.25 if $sleep_time <= $o->get('max-lag');
                  MKDEBUG && _d('Sleeping', $sleep_time, 'to wait for chunks');
                  sleep $sleep_time;
               }
            }

            foreach my $slave ( @$slaves ) {
               my $diffs = $rc->find_replication_differences(
                  dbh        => $slave->dbh(),
                  repl_table => $repl_table,
                  where      => "db='$tbl->{db}' AND tbl='$tbl->{tbl}'",
               );
               MKDEBUG && _d(scalar @$diffs, 'checksum diffs on',
                  $slave->name());
               if ( @$diffs ) {
                  $tbl->{checksum_results}->{diffs} = scalar @$diffs;
               }
            }
         }

         # Print table's checksum results if we're not being quiet,
         # else print if table has diffs and we're not being completely
         # quiet.
         if ( !$o->get('quiet')
              || $o->get('quiet') < 2 &&  $tbl->{checksum_results}->{diffs} ) {
            print_checksum_results(tbl => $tbl);
         }

         return;
      },
   };

   # ########################################################################
   # Checksum each table.
   # ########################################################################
   my $schema_iter = new SchemaIterator(
      dbh             => $master_dbh,
      resume          => $last_chunk ? $q->quote(@{$last_chunk}{qw(db tbl)})
                                     : "",
      keep_tbl_status => 1,
      OptionParser    => $o,
      TableParser     => $tp,
      Quoter          => $q,
   );

   TABLE:
   while ( $oktorun &&  (my $tbl = $schema_iter->next()) ) {
      eval {
         # Results, stats, and info related to checksuming this table can
         # be saved here.  print_checksum_results() uses this info.
         $tbl->{checksum_results} = {};

         # Set table's initial chunk size.  If this is the first table,
         # then total rate will be zero, so use --chunk-size.  Or, if
         # --chunk-time=0, then only use --chunk-size for every table.
         # Else, the initial chunk size is based on the total rates of
         # rows/s from all previous tables.  If --chunk-time is really
         # small, like 0.001, then Perl int() will probably round the
         # chunk size to zero, which is invalid, so we default to 1.
         my $chunk_time = $o->get('chunk-time');
         my $chunk_size = $chunk_time && $total_rate
                        ? int($total_rate * $chunk_time) || 1
                        : $o->get('chunk-size');
         $tbl->{chunk_size} = $chunk_size;

         # Make a nibble iterator for this table.  This should only fail
         # if the table has no indexes and is too large to checksum in
         # one chunk.
         my $checksum_cols = $rc->make_chunk_checksum(
            dbh => $master_cxn->dbh(),
            tbl => $tbl,
            %crc_args
         );
         my $nibble_iter;
         eval {
            $nibble_iter = new NibbleIterator(
               Cxn          => $master_cxn,
               tbl          => $tbl,
               chunk_size   => $tbl->{chunk_size},
               chunk_index  => $o->get('chunk-index'),
               dms          => $checksum_dms,
               select       => $checksum_cols,
               callbacks    => $callbacks,
               OptionParser => $o,
               Quoter       => $q,
               TableNibbler => $tn,
               TableParser  => $tp,
               RowChecksum  => $rc,
            );
         };
         if ( $EVAL_ERROR ) {
            if ( $o->get('quiet') < 2 ) {
               warn ts("Cannot checksum table $tbl->{db}.$tbl->{tbl}: "
                  . "$EVAL_ERROR\n");
            }
            $tbl->{checksum_results}->{errors}++;
         }
         else {
            # Init a new weighted avg rate calculator for the table.
            $tbl->{rate} = new WeightedAvgRate(target_t => $chunk_time);

            # Make a Progress obj for this table.  It may not be used;
            # depends on how many rows, chunk size, how fast the server
            # is, etc.  But just in case, all tables have a Progress obj.
            if ( $o->get('progress')
                 && !$nibble_iter->one_nibble()
                 &&  $nibble_iter->row_estimate() )
            {
               $tbl->{progress} = new Progress(
                  jobsize => $nibble_iter->row_estimate(),
                  spec    => $o->get('progress'),
                  name    => "Checksumming $tbl->{db}.$tbl->{tbl}",
               );
            }

            # Finally, checksum the table.
            # The "1 while" loop is necessary because we're executing REPLACE
            # statements which don't return rows and NibbleIterator only
            # returns if it has rows to return.  So all the work is done via
            # the callbacks. -- print_checksum_results(), which is called
            # from the done callback, uses this start time.
            $tbl->{checksum_results}->{start_time} = time;
            1 while $nibble_iter->next();
         }
      };
      if ( $EVAL_ERROR ) {
         # This should not happen.  If it does, it's probably some bug
         # or error that we're not catching.
         warn ts(($oktorun ? "Error " : "Fatal error ")
            . "checksumming table $tbl->{db}.$tbl->{tbl}: "
            . "$EVAL_ERROR\n");
         $tbl->{checksum_results}->{errors}++;

         # Print whatever checksums results we got before dying, regardless
         # of --quiet because at this point we need all the info we can get.
         print_checksum_results(tbl => $tbl);
      }

      # Update the tool's exit status.
      if ( $tbl->{checksum_results}->{errors}
           || $tbl->{checksum_results}->{diffs} ) {
         $exit_status |= 1;
      }
   }

   MKDEBUG && _d('Exit status', $exit_status, 'oktorun', $oktorun);
   return $exit_status;
}

# ############################################################################
# Subroutines
# ############################################################################
sub ts {
   my ($msg) = @_;
   my ($s, $m, $h, $d, $M) = localtime;
   my $ts = sprintf('%02d-%02dT%02d:%02d:%02d', $M+1, $d, $h, $m, $s);
   return $msg ? "$ts $msg" : $ts;
}

{
# Completely ignore these error codes.
my %ignore_code = (
   # Error: 1592 SQLSTATE: HY000  (ER_BINLOG_UNSAFE_STATEMENT)
   # Message: Statement may not be safe to log in statement format. 
   # Ignore this warning because we have purposely set statement-based
   # replication.
   1592 => 1,
);

# Warn once per-table for these error codes if the error message
# matches the pattern.
my %warn_code = (
   # Error: 1265 SQLSTATE: 01000 (WARN_DATA_TRUNCATED)
   # Message: Data truncated for column '%s' at row %ld
   1265 => {
      # any pattern
      # use MySQL's message for this warning
   },
);

sub exec_nibble {
   my (%args) = @_;
   my @required_args = qw(Cxn tbl NibbleIterator Retry Quoter OptionParser);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($cxn, $tbl, $nibble_iter, $retry, $q, $o)= @args{@required_args};

   my $dbh         = $cxn->dbh();
   my $sth         = $nibble_iter->statements();
   my $boundary    = $nibble_iter->boundaries();
   my $lb_quoted   = join(',', @{$boundary->{lower}});
   my $ub_quoted   = join(',', @{$boundary->{upper}});
   my $chunk       = $nibble_iter->nibble_number();
   my $chunk_index = $nibble_iter->nibble_index();

   return $retry->retry(
      tries => $o->get('retries'),
      wait  => sub { return; },
      try   => sub {
         # ###################################################################
         # Start timing the checksum query.
         # ###################################################################
         my $t_start = time;        

         # Reset the BIT_XOR user vars.
         my $sql = 'SET @crc := "", @cnt := 0';
         MKDEBUG && _d($sql);
         $dbh->do($sql);

         # Execute the REPLACE...SELECT checksum query.
         MKDEBUG && _d($sth->{nibble}->{Statement},
            'lower boundary:', @{$boundary->{lower}},
            'upper boundary:', @{$boundary->{upper}});
         $sth->{nibble}->execute(
            # REPLACE INTO repl_table SELECT
            $tbl->{db},             # db
            $tbl->{tbl},            # tbl
            $chunk,                 # chunk (number)
            $chunk_index,           # chunk_index
            $lb_quoted || undef,    # lower_boundary
            $ub_quoted || undef,    # upper_boundary
            # this_cnt, this_crc WHERE
            @{$boundary->{lower}},  # upper boundary values
            @{$boundary->{upper}},  # lower boundary values
         );

         my $t_end = time;
         # ###################################################################
         # End timing the checksum query.
         # ###################################################################

         # Check if checksum query caused any warnings.
         my $sql_warn = 'SHOW WARNINGS';
         MKDEBUG && _d($sql_warn);
         my $warnings = $dbh->selectall_arrayref($sql_warn, { Slice => {} } );
         foreach my $warning ( @$warnings ) {
            my $code    = ($warning->{code} || 0);
            my $message = $warning->{message};
            if ( $ignore_code{$code} ) {
               MKDEBUG && _d('Ignoring warning:', $code, $message);
               next;
            }
            elsif ( $warn_code{$code}
                    && (!$warn_code{$code}->{pattern}
                        || $message =~ m/$warn_code{$code}->{pattern}/) )
            {
               if ( !$tbl->{"warned_code_$code"} ) {  # warn once per table
                  if ( $o->get('quiet') < 2 ) {
                     warn ts("Checksum query for table $tbl->{db}.$tbl->{tbl} "
                        . "caused MySQL error $code: "
                        . ($warn_code{$code}->{message}
                           ? $warn_code{$code}->{message}
                           : $message)
                        . "\n");
                  }
                  $tbl->{"warned_code_$code"} = 1;
                  $tbl->{checksum_results}->{errors}++;
               }
            }
            else {
               # This die will propagate to fail which will return 0
               # and propagate it to final_fail which will die with
               # this error message.  (So don't wrap it in ts().)
               die "Checksum query for table $tbl->{db}.$tbl->{tbl} "
                  . "caused MySQL error $code:\n"
                  . "    Level: " . ($warning->{level}   || '') . "\n"
                  . "     Code: " . ($warning->{code}    || '') . "\n"
                  . "  Message: " . ($warning->{message} || '') . "\n"
                  . "    Query: " . $sth->{nibble}->{Statement} . "\n";
            }
         }

         # Success: no warnings, no errors.  Return nibble time.
         return $t_end - $t_start;
      },
      fail => sub {
         my (%args) = @_;
         my $error = $args{error};

         if (   $error =~ m/Lock wait timeout exceeded/
             || $error =~ m/Query execution was interrupted/
         ) {
            # These errors/warnings can be retried, so don't print
            # a warning yet; do that in final_fail.
            return 1;
         }
         elsif (   $error =~ m/MySQL server has gone away/
                || $error =~ m/Lost connection to MySQL server/
         ) {
            # The 2nd pattern means that MySQL itself died or was stopped.
            # The 3rd pattern means that our cxn was killed (KILL <id>).
            eval { $dbh = $cxn->connect(); };
            return 1 unless $EVAL_ERROR; # reconnected, retry checksum query
            $oktorun = 0;                # failed to reconnect, exit tool
         }

         # At this point, either the error/warning cannot be retried,
         # or we failed to reconnect.  So stop trying and call final_fail.
         return 0;
      },
      final_fail => sub {
         my (%args) = @_;
         my $error = $args{error};

         if (   $error =~ /Lock wait timeout exceeded/
             || $error =~ /Query execution was interrupted/
         ) {
            # These errors/warnings are not fatal but only cause this
            # nibble to be skipped.
            if ( $o->get('quiet') < 2 ) {
               warn "$error\n";
            }
            return;  # skip this nibble
         }

         # This die will be caught by the eval inside the TABLE loop.
         # Checksumming for this table will stop, which is probably
         # good because by this point the error or warning indicates
         # that something fundamental is broken or wrong.  Checksumming
         # will continue with the next table, unless the fail code set
         # oktorun=0, in which case the error/warning is fatal.
         die "Error executing checksum query: $args{error}\n";
      }
   );
}
}

{
my $line_fmt = "%14s %6s %6s %8s %7s %7s %7s %-s\n";
my @headers  =  qw(TS ERRORS DIFFS ROWS CHUNKS SKIPPED TIME TABLE);

sub print_checksum_results {
   my (%args) = @_;
   my @required_args = qw(tbl);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($tbl) = @args{@required_args};

   if ($print_header) {
      printf $line_fmt, @headers;
      $print_header = 0;
   }

   my $res = $tbl->{checksum_results};
   printf $line_fmt,
      ts(),
      $res->{errors}   || 0,
      $res->{diffs}    || 0,
      $res->{n_rows}   || 0,
      $res->{n_chunks} || 0,
      $res->{skipped}  || 0,
      sprintf('%.3f', $res->{start_time} ? time - $res->{start_time} : 0),
      "$tbl->{db}.$tbl->{tbl}";

   return;
}
}

{
my @headers = qw(table chunk cnt_diff crc_diff chunk_index lower_boundary upper_boundary);

sub print_checksum_diffs {
   my ( %args ) = @_;
   my @required_args = qw(cxn diffs);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($cxn, $diffs) = @args{@required_args};

   print "Differences on ", $cxn->name(), "\n";
   print join(' ', map { uc $_ } @headers), "\n";
   foreach my $diff ( @$diffs ) {
      print join(' ', map { defined $_ ? $_ : '' } @{$diff}{@headers}), "\n";
   }
   print "\n";

   return;
}
}

sub check_repl_table {
   my ( %args ) = @_;
   my @required_args = qw(dbh repl_table OptionParser TableParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $repl_table, $o, $tp, $q) = @args{@required_args};
   MKDEBUG && _d('Checking --replicate table', $repl_table);

   # If the repl db doesn't exit, auto-create it, maybe.
   my ($db, $tbl) = $q->split_unquote($repl_table);
   my $sql = "SHOW DATABASES LIKE '$db'";
   MKDEBUG && _d($sql);
   my @db_exists = $dbh->selectrow_array($sql);
   if ( !@db_exists && $o->get('create-replicate-table') ) {
      $sql = "CREATE DATABASE " . $q->quote($db) . " /* pt-table-checksum */";
      eval {
         $dbh->do($sql);
      };
      if ( $EVAL_ERROR ) {
         die "--replicate database $db does not exist and it cannot be "
            . "created automatically.  You need to create the database.\n";
      }
   }

   # USE the correct db (probably the repl db, but maybe --replicate-database).
   use_repl_db(%args);

   # Check if the repl table exists; if not, create it, maybe.
   my $tbl_exists = $tp->check_table(
      dbh => $dbh,
      db  => $db,
      tbl => $tbl,
   );
   if ( !$tbl_exists ) {
      if ( $o->get('create-replicate-table') ) {
         create_repl_table(%args)
      }
      else {
         die "--replicate table $repl_table does not exist; "
            . "read the documentation or use --create-replicate-table "
            . "to create it.\n";
      }
   }
   else {
      MKDEBUG && _d('--replicate table', $repl_table, 'already exists');
      # Check it again but this time check the privs.
      my $have_tbl_privs = $tp->check_table(
         dbh       => $dbh,
         db        => $db,
         tbl       => $tbl,
         all_privs => 1,
      );
      die "User does not have all privileges on --replicate table "
         . "$repl_table.\n" unless $have_tbl_privs;
   }

   return;  # success, repl table is ready to go
}

# Sub: use_repl_db
#   USE the correct database for the --replicate table.
#   This sub must be called before any work is done with the --replicatte
#   table because replication filters can really complicate replicating the
#   checksums.  The originally issue is,
#   http://code.google.com/p/maatkit/issues/detail?id=982,
#   but here's what you need to know:
#   - If there is no active DB, then if there's any do-db or ignore-db
#     settings, the checksums will get filtered out of replication. So we
#     have to have some DB be the current one.
#   - Other places in the code may change the DB and we might not know it.
#     Opportunity for bugs.  The SHOW CREATE TABLE, for example. In the
#     end, a bunch of USE statements isn't a big deal, it just looks noisy
#     when you analyze the logs this tool creates. But it's better to just
#     have them even if they're no-op.
#   - We need to always let the user specify, because there are so many
#     possibilities that the tool can't guess the right thing in all of
#     them.
#   - The right default behavior, which the user can override, is:
#       * When running queries on the --replicate table itself, such as
#         emptying it, USE that table's database.
#       * When running checksum queries, USE the database of the table that's
#         being checksummed.
#       * When the user specifies --replicate-database, in contrast, always
#         USE that database.
#   - This behavior is the best compromise by default, because users who
#     explicitly replicate some databases and filter out others will be
#     very likely to run pt-table-checksum and limit its checksumming to
#     only the databases that are replicated. I've seen people do this,
#     including Peter. In this case, the tool will work okay even without
#     an explicit --replicate-database setting.
#
# Required Arguments:
#   dbh          - dbh
#   repl_table   - Full quoted --replicate table name
#   OptionParser - <OptionParser>
#   Quoter       - <Quoter>
#
# Optional Arguments:
#   tbl - Standard tbl hashref of table being checksummed
#
# Returns:
#   Nothing or dies on error
sub use_repl_db {
   my ( %args ) = @_;
   my @required_args = qw(dbh repl_table OptionParser Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $repl_table, $o, $q) = @args{@required_args};
   MKDEBUG && _d('use_repl_db');

   my ($db, $tbl) = $q->split_unquote($repl_table);
   if ( my $tbl = $args{tbl} ) {
      # If there's a tbl arg then its db will be used unless
      # --replicate-database was specified.  A tbl arg means
      # we're checksumming that table.  Other callers won't
      # pass a tbl arg when they're just doing something to
      # the --replicate table.
      $db = $o->get('replicate-database') ? $o->get('replicate-database')
          :                                 $tbl->{db};
   }
   else {
      # Caller is doing something just to the --replicate table.
      # Use the db from --replicate db.tbl (gotten earlier) unless
      # --replicate-database is in effect.
      $db = $o->get('replicate-database') if $o->get('replicate-database');
   }

   eval {
      my $sql = "USE " . $q->quote($db);
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   };
   if ( $EVAL_ERROR ) {
      # Report which option db really came from.
      my $opt = $o->get('replicate-database') ? "--replicate-database"
              :                                 "--replicate database";
      if ( $EVAL_ERROR =~ m/unknown database/i ) {
         die "$opt $db does not exist.  You need to create the "
            . "database or specify a database for $opt that exists.\n";
      }
      else {
         die "Error using $opt $db: $EVAL_ERROR\n";
      }
   }

   return;
}

sub create_repl_table {
   my ( %args ) = @_;
   my @required_args = qw(dbh repl_table OptionParser);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $repl_table, $o) = @args{@required_args};
   MKDEBUG && _d('Creating --replicate table', $repl_table); 
   my $sql = $o->read_para_after(__FILE__, qr/MAGIC_create_replicate/);
   $sql =~ s/CREATE TABLE checksums/CREATE TABLE $repl_table/;
   $sql =~ s/;$//;
   MKDEBUG && _d($dbh, $sql);
   eval {
      $dbh->do($sql);
   };
   if ( $EVAL_ERROR ) {
      die ts("--create-replicate-table failed: $EVAL_ERROR");
   }

   return;
}

# Sub: explain_statement
#   EXPLAIN a statement.
#
# Required Arguments:
#   * tbl  - Standard tbl hashref
#   * sth  - Sth with EXLAIN <statement>
#   * vals - Values for sth, if any
#
# Returns:
#   Hashref with EXPLAIN plan
sub explain_statement {
   my ( %args ) = @_;
   my @required_args = qw(tbl sth vals);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   my ($tbl, $sth, $vals) = @args{@required_args};

   my $expl;
   eval {
      MKDEBUG && _d($sth->{Statement}, 'params:', @$vals);
      $sth->execute(@$vals);
      $expl = $sth->fetchrow_hashref();
      $sth->finish();
   };
   if ( $EVAL_ERROR ) {
      # This shouldn't happen.
      warn ts("Error executing " . $sth->{Statement} . ": $EVAL_ERROR\n");
      $tbl->{checksum_results}->{errors}++;
   }
   MKDEBUG && _d('EXPLAIN plan:', Dumper($expl));
   return $expl;
}

sub last_chunk {
   my (%args) = @_;
   my @required_args = qw(dbh repl_table);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($dbh, $repl_table, $q) = @args{@required_args};

   my $sql = "SELECT MAX(ts) FROM $repl_table";
   MKDEBUG && _d($sql);
   my ($max_ts) = $dbh->selectrow_array($sql);
   if ( !$max_ts ) {
      MKDEBUG && _d('Replicate table is empty; will not resume');
      return;
   }

   $sql = "SELECT * FROM $repl_table "
        . "WHERE ts='$max_ts' "
        . "ORDER BY db DESC, tbl DESC, chunk DESC LIMIT 1";
   MKDEBUG && _d($sql);
   my $last_chunk = $dbh->selectrow_hashref($sql);
   MKDEBUG && _d('Last chunk:', Dumper($last_chunk));

   $sql = "SELECT MAX(chunk) FROM $repl_table "
        . "WHERE db='$last_chunk->{db}' AND tbl='$last_chunk->{tbl}'";
   MKDEBUG && _d($sql);
   my ($max_chunk) = $dbh->selectrow_array($sql);
   MKDEBUG && _d('Max chunk:', $max_chunk);
   if ( ($last_chunk->{chunk} || 0) ne ($max_chunk || 0) ) {
      warn ts("Not resuming from max chunk ("
         . ($last_chunk->{chunk} || 0)
         . " != "
         . ($max_chunk || 0)
         . "); resuming may not work correctly.\n");
   }

   return $last_chunk;
}

sub next_lower_boundary {
   my (%args) = @_;
   my @required_args = qw(Cxn tbl last_chunk NibbleIterator Quoter);
   foreach my $arg ( @required_args ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($cxn, $tbl, $last_chunk, $nibble_iter, $q) = @args{@required_args};

   # If the last chunk (which should be the max chunk) is 1 and there
   # was no chunk index, then the table was checksummed in a single chunk.
   if (  $last_chunk->{chunk} == 1
         && !$last_chunk->{chunk_index}
         && !$nibble_iter->nibble_index() ) {
      return;
   }

   my $chunk_index = $nibble_iter->nibble_index() || '';
   if (    ($last_chunk->{chunk_index}   || '')
        ne ($nibble_iter->nibble_index() || '') ) {
      warn ts("Cannot resume from table $tbl->{db}.$tbl->{tbl} chunk "
         . "$last_chunk->{chunk} because the chunk indexes are different: "
         . ($last_chunk->{chunk_index} ? $last_chunk->{chunk_index} 
                                       : "no index")
         . " was used originally but "
         . ($nibble_iter->nibble_index() ? $nibble_iter->nibble_index()
                                         : "no index")
         . " is used now.  If the table has not changed significantly, "
         . "this may be caused by running the tool with different command "
         . "line options.  This table will be skipped and checksumming "
         . "will resume with the next table.\n");
      $tbl->{checksum_results}->{errors}++;
      return;
   }

   my $sql = $nibble_iter->sql();
   my $next_lb_sql
      = "SELECT /*!40001 SQL_NO_CACHE */ "
      . join(', ', map { $q->quote($_) } @{$sql->{columns}})
      . " FROM $sql->{from}"
      . " WHERE " . $sql->{boundaries}->{'>'}
                  . ($sql->{where} ? " AND ($sql->{where})" : '')
      . " ORDER BY $sql->{order_by}"
      . " LIMIT 1"
      . " /*resume next chunk boundary*/";
   MKDEBUG && _d($next_lb_sql);
   my $sth = $cxn->dbh()->prepare($next_lb_sql);

   my @ub = split ',', $last_chunk->{upper_boundary};
   MKDEBUG && _d($sth->{Statement}, 'params:', @ub);
   $sth->execute(@ub);
   my $next_lb = $sth->fetchrow_arrayref();
   $sth->finish();
   return $next_lb;
}

# Catches signals so we can exit gracefully.
sub sig_int {
   my ( $signal ) = @_;
   if ( $oktorun ) {
      print STDERR "# Caught SIG$signal.\n";
      $oktorun = 0;
   }
   else {
      print STDERR "# Exiting on SIG$signal.\n";
      exit 1;
   }
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

# ############################################################################
# Run the program.
# ############################################################################
if ( !caller ) { exit main(@ARGV); }

1; # Because this is a module as well as a script.

# ############################################################################
# Documentation
# ############################################################################
=pod

=head1 NAME

pt-table-checksum - Verify MySQL replication integrity.

=head1 SYNOPSIS

Usage: pt-table-checksum [OPTION...] [DSN]

pt-table-checksum performs an online replication consistency check by executing
checksum queries on the master.  The checksum queries replicate and re-execute
on replicas, where they produce different results if the replicas have
different data from the master.  The C<DSN>, if specified, must be the master
host.  The tool exits non-zero if any differences are found, or if any warnings
or errors occur.

The following command will connect to the replication master on localhost,
checksum every table, and report the results on every detected replica:

   pt-table-checksum

This tool is focused on finding data differences efficiently.  If any data is
different, you can resolve the problem with pt-table-sync.

=head1 RISKS

The following section is included to inform users about the potential risks,
whether known or unknown, of using this tool.  The two main categories of risks
are those created by the nature of the tool (e.g. read-only tools vs. read-write
tools) and those created by bugs.

pt-table-checksum executes queries that cause the MySQL server to checksum its
data.  This can cause significant server load.  The tool also inserts a small
amount of data into the L<"--replicate"> table.

At the time of this release, we know of no bugs that could cause serious harm to
users.

The authoritative source for updated information is always the online issue
tracking system.  Issues that affect this tool will be marked as such.  You can
see a list of such issues at the following URL:
L<http://www.percona.com/bugs/pt-table-checksum>.

See also L<"BUGS"> for more information on filing bugs and getting help.

=head1 DESCRIPTION

pt-table-checksum is designed to do the right thing by default in almost every
case.  When in doubt, use L<"--explain"> to see how the tool will checksum a
table.  The following is a high-level overview of how the tool functions.

In contrast to older versions of pt-table-checksum, this version of the tool
does not have the ability to connect to and checksum many servers in parallel
using multi-processing.  It executes checksum queries on only one server, and
these flow through replication to re-execute on replicas.  If you need the older
behavior for any reason, you can simply download Percona Toolkit version 1.0 and
use it.

pt-table-checksum connects to the server you specify, and finds databases and
tables that match the filters you specify (if any).  It works one table at a
time, so it does not accumulate large amounts of memory and do a lot of work
before beginning to checksum.  This makes it usable on very large servers. We
have used it on servers with hundreds of thousands of databases and tables, and
trillions of rows.  No matter how large the server is, pt-table-checksum works
equally well.

Part of the reason it can work on very large tables is that it divides each
table into chunks of rows, and checksums each chunk with a single
REPLACE..SELECT query.  It varies the chunk size to make the checksum queries
run in the desired amount of time.  The goal of chunking the tables, instead of
doing each table with a single big query, is to ensure that checksums are
unintrusive and don't cause too much replication lag or load on the server.
That's why the target time for each chunk is half a second by default.  The tool
keeps track of how quickly the server is able to execute the queries, and
adjusts the chunks as it learns more about the server's performance.  It uses an
exponentially decaying weighted average to make the chunk size stable, yet
responsive if the server's performance changes during checksumming for any
reason.

Chunking is accomplished by a technique that we used to call "nibbling" in other
tools in Percona Toolkit.  It is the same technique used for pt-archiver, for
example.  The legacy chunking algorithms used in older versions of
pt-table-checksum are removed, because they did not result in predictably sized
chunks, and didn't work well on many tables.  All that is required to divide a
table into chunks is an index of some sort (preferably a primary key or unique
index).  If there is no index, and the table contains a suitably small number of
rows, the tool will checksum the table in a single chunk.

One of the most important goals for pt-table-checksum is to ensure that it does
not interfere with any server's operation.  This includes replicas.  To
accomplish this, pt-table-checksum tries to automatically detect replicas and
connect to them.  (If this fails, you can give it a hint with the
--recursion-method option.)  pt-table-checksum monitors replicas continually as
it progresses.  If any replica falls too far behind in replication,
pt-table-checksum pauses to allow it to catch up.  If any replica has an error,
or replication stops for any reason, pt-table-checksum pauses and waits.  In
addition, pt-table-checksum looks for some common causes of problems, such as
replication filters, and refuses to operate unless you force it to.  Replication
filters are dangerous, because the queries that pt-table-checksum executes could
potentially conflict with them and cause replication to fail.

There are also several other safeguards. For example, pt-table-checksum sets its
session-level innodb_lock_wait_timeout to 1 second, so that if there is a lock
wait, it will be the victim instead of causing other queries to time out.
Another important safeguard is checking for too much load on the database
server. There is no single right answer for how to do this, but by default
pt-table-checksum will check after every chunk to ensure that there are not more
than 25 concurrently executing queries; if there are, it will wait until the
concurrency decreases.  You should probably set a sane value for your server if
this is important to you.  You can use the L<"--max-load"> option for this.

In addition to trying to avoid interference, pt-table-checksum is designed to
tolerate and recover from many error conditions.  The assumption is that
checksumming is a low-priority task that should yield to other work on the
server. However, it is our experience that a tool that must be restarted
constantly is difficult to use.  Thus, we tried to make pt-table-checksum
resilient to errors and exceptions.  For example, if the database administrator
needs to kill pt-table-checksum's queries for any reason, that is not a fatal
error (the authors often run pt-kill on servers while we checksum them,
configured to kill any long-running checksum queries). The tool will simply
retry that query once, and if it fails again, it will move on to the next chunk
of that table.  The same behavior applies if there is a lock wait timeout.  The
tool will print a warning if such an error happens, but only once per table, to
avoid printing too many warnings and making the output unreadable.  Similarly,
if any connection to any server fails for some reason, pt-table-checksum will
attempt to reconnect and continue working.

If pt-table-checksum encounters a condition that causes it to stop completely,
it is easy to resume it with the --resume option. It will detect the last chunk
of the last table that it processed, and begin again from there.  You can also
safely stop the tool with CTRL-C.  It will finish the chunk it is currently
processing, and then exit.  You can resume it as usual afterwards.

After pt-table-checksum finishes checksumming all of the chunks in a table, it
pauses and waits for all detected replicas to finish executing the checksum
queries.  Once that is finished, it checks all of the replicas to see if they
have the same data as the master, and then prints a line of output with the
results.  You can see a sample of its output later in this documentation.

If you wish, you can query the checksum tables manually to get a report on which
tables and chunks have differences from the master.  The following query will
report every database and table with differences, along with a summary of the
number of chunks and rows possibly affected:

  SELECT db, tbl, SUM(this_cnt) AS total_rows, COUNT(*) AS chunks
  FROM percona.checksums
  WHERE (
   master_cnt <> this_cnt
   OR master_crc <> this_crc
   OR ISNULL(master_crc) <> ISNULL(this_crc))
  GROUP BY db, tbl;

The table referenced in that query is the checksum table, where the checksums
are stored.  Each row in the table contains the checksum of one chunk of data
from some table in the server.

At the time of writing, pt-table-checksum's checksum table format has been
improved in a way that is not backwards compatible with pt-table-sync, which has
not yet been updated to match.  In some cases this is not a serious problem.
Adding a "boundaries" column to the table, and then updating it with a manually
generated WHERE clause, may suffice to let pt-table-sync interoperate with
pt-table-checksum's table.  Assuming an integer primary key named 'id', You can
try something like the following:

  ALTER TABLE checksums ADD boundaries VARCHAR(500);
  UPDATE checksums
   SET boundaries = COALESCE(CONCAT('id BETWEEN ', lower_boundary,
      ' AND ', upper_boundary), '1=1');

The tool prints progress indicators during several of its time-consuming
operations.  It prints a progress indicator as each table is checksummed.  The
progress is computed by the estimated number of rows in the table. It will also
print a progress report when it pauses to wait for replication to catch up, and
when it is waiting to check replicas for differences from the master.  You can
make the output less verbose with the --quiet option.

=head1 OUTPUT

The tool prints tabular results, one line per table:

              TS ERRORS  DIFFS     ROWS  CHUNKS SKIPPED    TIME TABLE
  10-20T08:36:50      0      0      200       1       0   0.005 sakila.actor
  10-20T08:36:50      0      0      603       7       0   0.035 sakila.address
  10-20T08:36:50      0      0       16       1       0   0.003 sakila.category
  10-20T08:36:50      0      0      600       6       0   0.024 sakila.city

Each table's results are printed when the tool finishes checksumming the table.
The columns are as follows:

=over

=item TS

The timestamp (without the year) when the tool finished checksumming the table.

=item ERRORS

The number of errors and warnings that occurred while checksumming the table.
Errors and warnings are printed to standard error while the table is in
progress.

=item DIFFS

The number of chunks that differ from the master on one or more replicas.  If
C<--no-replicate-check> is specified, this column will always have zero values.
If C<--no-recheck> is specified, then only tables with differences are printed.

=item ROWS

The number of rows selected and checksummed from the table.  It might be
different from the number of rows in the table if you use the --where option.

=item CHUNKS

The number of chunks into which the table was divided.

=item SKIPPED

The number of chunks that were skipped due to errors or warnings, or because
they were oversized.

=item TIME

The time elapsed while checksumming the table.

=item TABLE

The database and table that was checksummed.

=back

Errors, warnings, and progress reports are printed to standard error.  See also
L<"--quiet">.

=head1 EXIT STATUS

A non-zero exit status indicates one or more error, warning, or checksum
difference.

=head1 OPTIONS

This tool accepts additional command-line arguments.  Refer to the
L<"SYNOPSIS"> and usage information for details.

=over

=item --ask-pass

group: Connection

Prompt for a password when connecting to MySQL.

=item --check-interval

type: time; default: 1; group: Throttle

Sleep time between checks for L<"--max-lag">.

=item --[no]check-replication-filters

default: yes; group: Safety

Do not checksum if any replication filters are set on any replicas.
The tool looks for options that filter replication, such as
binlog_ignore_db and replicate_do_db.  If it finds any such filters,
it aborts with an error.

Replication filtering makes it impossible to be sure that the checksum queries
won't break replication (or simply fail to replicate).  If you are sure that
it's OK to run the checksum queries, you can negate this option to disable the
checks.  See also L<"--replicate-database">.

=item --check-slave-lag

type: string; group: Throttle

Pause checksumming until this replica's lag is less than L<"--max-lag">.  The
value is a DSN that inherits properties from the master host and the connection
options (L<"--port">, L<"--user">, etc.).

=item --chunk-index

type: string

Prefer this index for chunking tables.  By default, pt-table-checksum chooses
an appropriate index for chunking.  This option lets you specify the index
that you prefer.  If the index doesn't exist, then pt-table-checksum will fall
back to its default behavior.  pt-table-checksum adds the index to the checksum
SQL statements in a C<FORCE INDEX> clause.  Be careful when using this option;
a poor choice of index could cause bad performance.  This is probably best to
use when you are checksumming only a single table, not an entire server.

=item --chunk-size

type: size; default: 1000

Number of rows to select for each checksum query.  Allowable suffixes are
k, M, G.

The chunk size is automatically adjusted to satisfy L<"--chunk-time"> when
that option is not zero (and it's not by default).

In general, the chunk size limits how many rows the tool selects for
each checksum query.  If a table's rows are large, this prevents overloading
MySQL with trying to checksum too much data.

If a table does not have any unique indexes, the chunk size may be inaccurate,
in which case L<"--chunk-size-limit"> can help prevent overloading MySQL.

=item --chunk-size-limit

type: float; default: 2.0; group: Safety

Do not checksum chunks with this many times more rows than L<"--chunk-size">.

When a table has no unique indexes, chunking may result in inaccurate
chunk sizes.  This option specifies an upper limit to the inaccuracy.
C<EXPLAIN> is used to get an estimate of how many rows are in the chunk.
If that estimate exceeds the limit, the chunk is skipped.  Since
L<"--chunk-size"> is adjust automatically (unless L<"--chunk-time"> is zero),
the limit varies.

The minimum value for this option is 1 which means that no chunk can be any
larger than L<"--chunk-size">.  You probably don't want to specify 1 because
rows reported by EXPLAIN are estimates which can be greater than or less than
the real number of rows in the chunk.  If too many chunks are skipped because
they are oversize, you might want to specify a value larger than 2.

You can disable oversize chunk checking by specifying a value of 0.

=item --chunk-time

type: float; default: 0.5

Adjust L<"--chunk-size"> so each checksum query takes this long to execute.

The tool tracks the checksum rate (rows/second) for all tables and each
table individually.  These rates are used to adjust L<"--chunk-size">
after each checksum query so that the next checksum query takes this amount
of time (in seconds) to execute.

If this option is set to zero, L<"--chunk-size"> doesn't auto-adjust,
so query checksum times will vary, but query checksum sizes will not.

=item --columns

short form: -c; type: array; group: Filter

Checksum only this comma-separated list of columns.

=item --config

type: Array; group: Config

Read this comma-separated list of config files; if specified, this must be the
first option on the command line.

=item --[no]create-replicate-table

default: yes

Create the L<"--replicate"> database and table if they do not exist.
The structure of the replicate table is the same as the suggested table
mentioned in L<"--replicate">.

=item --databases

short form: -d; type: hash; group: Filter

Only checksum this comma-separated list of databases.

=item --databases-regex

type: string; group: Filter

Only checksum databases whose names match this Perl regex.

=item --defaults-file

short form: -F; type: string; group: Connection

Only read mysql options from the given file.  You must give an absolute
pathname.

=item --[no]empty-replicate-table

default: yes

Delete previous checksums for each table before checksumming the table.  This
option does not truncate the entire table, it only deletes rows (checksums) for
each table right before checksumming the table.  Therefore, if checksumming
stops prematurely, the table will still contain rows for tables that were not
checksummed before the tool was stopped.

If you're resuming from a previous checksum run, then the checksum records for
the table where the tool resumes won't be emptied.

=item --engines

short form: -e; type: hash; group: Filter

Only checksum tables which use these storage engines.

=item --explain

cumulative: yes; default: 0; group: Output

Show, but do not execute, checksum queries (disables
L<"--[no]empty-replicate-table">).  If specified twice, the tables are chunked
and the upper and lower boundary values for each chunk are printed.

=item --float-precision

type: int

Precision for C<FLOAT> and C<DOUBLE> number-to-string conversion.  Causes FLOAT
and DOUBLE values to be rounded to the specified number of digits after the
decimal point, with the ROUND() function in MySQL.  This can help avoid
checksum mismatches due to different floating-point representations of the same
values on different MySQL versions and hardware.  The default is no rounding;
the values are converted to strings by the CONCAT() function, and MySQL chooses
the string representation.  If you specify a value of 2, for example, then the
values 1.008 and 1.009 will be rounded to 1.01, and will checksum as equal.

=item --function

type: string

Hash function for checksums (FNV1A_64, MURMUR_HASH, SHA1, MD5, CRC32, etc).

The default is to use C<CRC32>, but C<MD5> and C<SHA1> also work, and you
can use your own function, such as a compiled UDF, if you wish.  Whatever
function you specify is run in SQL, not in Perl, so it must be available
to MySQL.

The C<FNV1A_64> UDF mentioned in the benchmarks is much faster than C<MD5>.  The
C++ source code is distributed with Percona Toolkit.  It is very simple to
compile and install; look at the header in the source code for instructions.  If
it is installed, it is preferred over C<MD5>.  You can also use the MURMUR_HASH
function if you compile and install that as a UDF; the source is also
distributed with Percona Toolkit, and it is faster and has better distribution than
FNV1A_64.

=item --help

group: Help

Show help and exit.

=item --host

short form: -h; type: string; default: localhost; group: Connection

Host to connect to.

=item --ignore-columns

type: Hash; group: Filter

Ignore this comma-separated list of columns when calculating the checksum.

=item --ignore-databases

type: Hash; group: Filter

Ignore this comma-separated list of databases.

=item --ignore-databases-regex

type: string; group: Filter

Ignore databases whose names match this Perl regex.

=item --ignore-engines

type: Hash; default: FEDERATED,MRG_MyISAM; group: Filter

Ignore this comma-separated list of storage engines.

=item --ignore-tables

type: Hash; group: Filter

Ignore this comma-separated list of tables.  Table names may be qualified with
the database name.  The L<"--replicate"> table is always automatically ignored.

=item --ignore-tables-regex

type: string; group: Filter

Ignore tables whose names match the Perl regex.

=item --lock-wait-timeout

type: int; default: 1

Set the session value of the C<innodb_lock_wait_timeout> on the master host.
Setting this option dynamically requires the InnoDB plugin, so this works only
on newer InnoDB and MySQL versions.  This option helps protect against long lock
waits if the checksum queries become slow for some reason.

=item --max-lag

type: time; default: 1s; group: Throttle

Pause checksumming until all replicas' lag is less than this value.

After each checksum query (each chunk), pt-table-checksum looks at the lag
(C<Seconds_Behind_Master>) of all replicas discovered automatically and waits
until all replicas' lag is less than this value.  If any replica is lagging too
much, pt-table-checksum will sleep for L<"--check-interval"> seconds, then check
all replicas again.  If you specify L<"--check-slave-lag">, then the tool only
examines the given server for lag, not all servers.

The tool waits forever for replicas to stop lagging.  If any replica is
stopped, the tool waits forever until the replica is started.  Checksumming
continues once all replicas are running and not lagging too much.

The tool prints progress reports while waiting.  If a replica is stopped, it
prints a progress report immediately, then again at every progress report
interval.

=item --max-load

type: Array; default: Threads_running=25; group: Throttle

Examine SHOW GLOBAL STATUS after every chunk, and pause if any status variables
are higher than the threshold.  The option accepts a comma-separated list of
MySQL status variables to check for a threshold.  An optional C<=MAX_VALUE> (or
C<:MAX_VALUE>) can follow each variable.  If not given, the tool determines a
threshold by examining the current value and increasing it by 20%.

For example, if you want the tool to pause when Threads_connected gets too high,
you can specify "Threads_connected", and the tool will check the current value
when it starts working and add 20% to that value.  If the current value is 100,
then the tool will pause whenever the value exceeds 120, and resume working when
the value drops down below 120 again.  If you want to specify an explicit
threshold, such as 110, you can use either "Threads_connected:110" or
"Threads_connected=110".

=item --password

short form: -p; type: string; group: Connection

Password to use when connecting.

=item --pid

type: string

Create the given PID file.  The file contains the process ID of the script.
The PID file is removed when the script exits.  Before starting, the script
checks if the PID file already exists.  If it does not, then the script creates
and writes its own PID to it.  If it does, then the script checks the following:
if the file contains a PID and a process is running with that PID, then
the script dies; or, if there is no process running with that PID, then the
script overwrites the file with its own PID and starts; else, if the file
contains no PID, then the script dies.

=item --port

short form: -P; type: int; group: Connection

Port number to use for connection.

=item --progress

type: array; default: time,30

Print progress reports to STDERR.

The value is a comma-separated list with two parts.  The first part can be
percentage, time, or iterations; the second part specifies how often an update
should be printed, in percentage, seconds, or number of iterations.

=item --quiet

short form: -q; cumulative: yes; default: 0

Print only the most important information (disables L<"--progress">).
Specifying this option once causes the tool to print only errors, warnings, and
tables with checksum differences.

Specifying this option twice causes the tool to print only errors.  In this
case, the tool's exit status indicates if there were any warnings or checksum
differences.

=item --[no]recheck

default: yes

Check replicas for differences while checksumming tables.

This is a legacy option which no longer has the same meaning.  It is only
used in relation to L<"--[no]replicate-check">.  If C<--no-recheck> is
specified, pt-table-checksum only checks replicas for differences and exits.
Else, the tool checks for differences while checksumming tables.

In other words, if you do not want to checksum tables, and you only want
to check replicas for differences, specify C<--no-recheck>.

=item --recurse

type: int

Number of levels to recurse in the hierarchy when discovering replicas.
Default is infinite.  See also L<"--recursion-method">.

=item --recursion-method

type: string

Preferred recursion method for discovering replicas.  Possible methods are:

  METHOD       USES
  ===========  ==================
  processlist  SHOW PROCESSLIST
  hosts        SHOW SLAVE HOSTS
  dsn=DSN      DSNs from a table

The C<processlist> method is preferred because C<SHOW SLAVE HOSTS> is not
reliable.  However, the C<hosts> method is required if the server uses a
non-standard port (not 3306).  Usually the tool does the right thing and
finds all replicas, but you may give a preferred method and it will be used
first.

The <hosts> method requires replicas to be configured with C<report-host>,
C<report-port>, etc.

The C<dsn> method is special: it specifies a DSN from which other DSN strings
are read.  The specified DSN must specify a D and t, or a database-qualified
t.  The DSN table should have the following structure:

  CREATE TABLE `dsns` (
    `id` int(11) NOT NULL AUTO_INCREMENT,
    `parent_id` int(11) DEFAULT NULL,
    `dsn` varchar(255) NOT NULL,
    PRIMARY KEY (`id`)
  );

One row specifies one DSN in the C<dsn> column.  Currently, the DSNs are
ordered by C<id>, but C<id> and C<parent_id> are otherwise ignored.

=item --replicate

type: string; default: percona.checksums

Write checksum results to this table.  The replicate table must have this
structure (MAGIC_create_replicate):

  CREATE TABLE checksums (
     db             char(64)     NOT NULL,
     tbl            char(64)     NOT NULL,
     chunk          int          NOT NULL,
     chunk_time     float            NULL,
     chunk_index    varchar(200)     NULL,
     lower_boundary text             NULL,
     upper_boundary text             NULL,
     this_crc       char(40)     NOT NULL,
     this_cnt       int          NOT NULL,
     master_crc     char(40)         NULL,
     master_cnt     int              NULL,
     ts             timestamp    NOT NULL,
     PRIMARY KEY (db, tbl, chunk),
     INDEX (ts)
  ) ENGINE=InnoDB;

By default, L<"--[no]create-replicate-table"> is true, so the database and
the table specified by this option are created automatically if they do not
exist.

Be sure to choose an appropriate storage engine for the replicate table.
If you are checksumming InnoDB tables, for instance, a deadlock will break
replication if the replicate table is non-transactional because the transaction
will still be written to the binlog.  It will then replay without a deadlock
on the replicas and break replication with "different error on master and
slave."  This is not a problem with pt-table-checksum; it's a problem with
MySQL replication, and you can read more about it in the MySQL manual.

If the slaves have any C<--replicate-do-X> or C<--replicate-ignore-X> options,
you should be careful not to checksum any databases or tables that exist on the
master and not the slaves.  Changes to such tables may not normally be executed
on the slaves because of the --replicate options, but the checksum queries
modify the contents of the table that stores the checksums, not the tables whose
data you are checksumming.  Therefore, these queries will be executed on the
slave, and if the table or database you're checksumming does not exist, the
queries will cause replication to fail.  For more information on replication
rules, see L<http://dev.mysql.com/doc/en/replication-rules.html>.

The replicate table is never checksummed (the tool automatically adds this
table to L<"--ignore-tables">).

=item --[no]replicate-check

default: yes

Check replicas for data differences.  Differences are found by recursing to
replicas, and executing a simple C<SELECT> statement to compare the replica's
checksum results to the master's checksum results.  Any differences are reported
in the C<DIFFS> column of the tool's output.

=item --replicate-database

type: string

C<USE> only this database with L<"--replicate">.  By default, pt-table-checksum
executes USE to set its default database to the database that contains the table
it's currently working on.  It changes its default database as it works on
different tables.  This is is a best effort to avoid problems with replication
filters such as binlog_ignore_db and replicate_ignore_db.  However, replication
filters can create a situation where there simply is no one right way to do
things.  Some statements might not be replicated, and others might cause
replication to fail on the slaves.  In such cases, it is up to the user to
specify a safe default database.  This option specifies a default database that
pt-table-checksum selects with USE, and never changes afterwards.  See also
<L"--[no]check-replication-filters">.

=item --resume

Resume checksumming from the last completed chunk.  If the tool is stopped
before it finishes checksumming all tables, checksumming can resume from the
last chunk of the last table finished by specifying this option.

=item --retries

type: int; default: 2

Retry a chunk this many times when there is a nonfatal error.  Nonfatal errors
are problems such as a lock wait timeout or the query being killed.

=item --separator

type: string; default: #

The separator character used for CONCAT_WS().  This character is used to join
the values of columns when checksumming.

=item --set-vars

type: string; default: wait_timeout=10000; group: Connection

Set these MySQL variables.  Immediately after connecting to MySQL, this
string will be appended to SET and executed.

=item --socket

short form: -S; type: string; group: Connection

Socket file to use for connection.

=item --tables

short form: -t; type: hash; group: Filter

Checksum only this comma-separated list of tables.
Table names may be qualified with the database name.

=item --tables-regex

type: string; group: Filter

Checksum only tables whose names match this Perl regex.

=item --trim

Add C<TRIM()> to C<VARCHAR> columns (helps when comparing 4.1 to >= 5.0).
This is useful when you don't care about the trailing space differences between
MySQL versions that vary in their handling of trailing spaces. MySQL 5.0 and 
later all retain trailing spaces in C<VARCHAR>, while previous versions would 
remove them.  These differences will cause false checksum differences.

=item --user

short form: -u; type: string; group: Connection

User for login if not current user.

=item --version

group: Help

Show version and exit.

=item --where

type: string

Do only rows matching this C<WHERE> clause.  You can use this option to limit
the checksum to only part of the table.  This is particularly useful if you have
append-only tables and don't want to constantly re-check all rows; you could run
a daily job to just check yesterday's rows, for instance.

This option is much like the -w option to mysqldump.  Do not specify the WHERE
keyword.  You may need to quote the value.  Here is an example:

  pt-table-checksum --where "foo=bar"

=back

=head1 DSN OPTIONS

These DSN options are used to create a DSN.  Each option is given like
C<option=value>.  The options are case-sensitive, so P and p are not the
same option.  There cannot be whitespace before or after the C<=> and
if the value contains whitespace it must be quoted.  DSN options are
comma-separated.  See the L<percona-toolkit> manpage for full details.

=over

=item * A

dsn: charset; copy: yes

Default character set.

=item * D

copy: no

DSN table database.

=item * F

dsn: mysql_read_default_file; copy: no

Only read default options from the given file

=item * h

dsn: host; copy: yes

Connect to host.

=item * p

dsn: password; copy: yes

Password to use when connecting.

=item * P

dsn: port; copy: yes

Port number to use for connection.

=item * S

dsn: mysql_socket; copy: no

Socket file to use for connection.

=item * t

copy: no

DSN table table.

=item * u

dsn: user; copy: yes

User for login if not current user.

=back

=head1 ENVIRONMENT

The environment variable C<PTDEBUG> enables verbose debugging output to STDERR.
To enable debugging and capture all output to a file, run the tool like:

   PTDEBUG=1 pt-table-checksum ... > FILE 2>&1

Be careful: debugging output is voluminous and can generate several megabytes
of output.

=head1 SYSTEM REQUIREMENTS

You need Perl, DBI, DBD::mysql, and some core packages that ought to be
installed in any reasonably new version of Perl.

=head1 BUGS

For a list of known bugs, see L<http://www.percona.com/bugs/pt-table-checksum>.

Please report bugs at L<https://bugs.launchpad.net/percona-toolkit>.
Include the following information in your bug report:

=over

=item * Complete command-line used to run the tool

=item * Tool L<"--version">

=item * MySQL version of all servers involved

=item * Output from the tool including STDERR

=item * Input files (log/dump/config files, etc.)

=back

If possible, include debugging output by running the tool with C<PTDEBUG>;
see L<"ENVIRONMENT">.

=head1 DOWNLOADING

Visit L<http://www.percona.com/software/percona-toolkit/> to download the
latest release of Percona Toolkit.  Or, get the latest release from the
command line:

   wget percona.com/get/percona-toolkit.tar.gz

   wget percona.com/get/percona-toolkit.rpm

   wget percona.com/get/percona-toolkit.deb

You can also get individual tools from the latest release:

   wget percona.com/get/TOOL

Replace C<TOOL> with the name of any tool.

=head1 AUTHORS

Baron Schwartz and Daniel Nichter

=head1 ACKNOWLEDGMENTS

Claus Jeppesen, Francois Saint-Jacques, Giuseppe Maxia, Heikki Tuuri,
James Briggs, Martin Friebe, and Sergey Zhuravlev

=head1 ABOUT PERCONA TOOLKIT

This tool is part of Percona Toolkit, a collection of advanced command-line
tools developed by Percona for MySQL support and consulting.  Percona Toolkit
was forked from two projects in June, 2011: Maatkit and Aspersa.  Those
projects were created by Baron Schwartz and developed primarily by him and
Daniel Nichter, both of whom are employed by Percona.  Visit
L<http://www.percona.com/software/> for more software developed by Percona.

=head1 COPYRIGHT, LICENSE, AND WARRANTY

This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Inc.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.

=head1 VERSION

pt-table-checksum 2.0-beta0

=cut