#!/usr/bin/env perl

# This program synchronizes data efficiently between two MySQL tables, which
# can be on different servers.
#
# This program is copyright 2007-2009 Baron Schwartz.
# 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
# MERCHANTIBILITY 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.

use strict;
use warnings FATAL => 'all';

our $VERSION = '1.0.16';
our $DISTRIB = '4047';
our $SVN_REV = sprintf("%d", (q$Revision: 3977 $ =~ m/(\d+)/g, 0));

# ###########################################################################
# OptionParser package 3945
# ###########################################################################
package OptionParser;

use strict;
use warnings FATAL => 'all';

use Getopt::Long;
use List::Util qw(max);
use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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

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

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(description) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
   $program_name ||= $PROGRAM_NAME;

   my $self = {
      description    => $args{description},
      prompt         => $args{prompt} || '<options>',
      strict         => (exists $args{strict} ? $args{strict} : 1),
      dp             => $args{dp}     || undef,
      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
      default_files  => [
         "/etc/maatkit/maatkit.conf",
         "/etc/maatkit/$program_name.conf",
         "$ENV{HOME}/.maatkit.conf",
         "$ENV{HOME}/.$program_name.conf",
      ],
   };
   return bless $self, $class;
}

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

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

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

   my %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, as provided by a DSNParser which is in $self->{dp}
      size   => 'z', # size with kMG suffix (powers of 2^10)
      'time' => 'm', # time, with an optional suffix of s/h/m/d
   );
   my @specs = ();
   my @rules = ();
   my $para;

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

   while ( $para = <$fh> ) {
      last if $para =~ m/^=over/;
      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 OPTIONS section' unless $para;

   do {
      if ( my ($option) = $para =~ m/^=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 $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  => $option
               . ($attribs{'short form'} ? '|' . $attribs{'short form'} : '' )
               . ($attribs{'negatable'}  ? '!'                          : '' )
               . ($attribs{'cumulative'} ? '+'                          : '' )
               . ($attribs{'type'}       ? '=' . $types{$attribs{type}} : '' ),
            desc  => $para
               . ($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 POD OPTIONS' 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);

         if ( $type && $type eq 'd' && !$self->{dp} ) {
            die "$opt->{long} is type DSN (d) but no dp argument "
               . "was given when this OptionParser object was created";
         }

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

         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
            if ( $opt->{is_negatable} ) {
               $def = $def eq 'yes' ? 1
                    : $def eq 'no'  ? 0
                    : $def;
            }
            $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;
         }

         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 opt_values {
   my ( $self ) = @_;
   my %opts = map {
      my $opt = $self->{opts}->{$_}->{short} ? $self->{opts}->{$_}->{short}
              : $_;
      $opt => $self->{opts}->{$_}->{value}
   } keys %{$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 @ARGV, $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} ) {
      printf("%s  Ver %s Distrib %s Changeset %s\n",
         $self->{program_name}, $main::VERSION, $main::DISTRIB, $main::SVN_REV)
            or die "Cannot print: $OS_ERROR";
      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");
      }
   }

   foreach my $long ( keys %{$self->{opts}} ) {
      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);
   }

   $self->{got_opts} = 1;
   return;
}

sub _validate_type {
   my ( $self, $opt ) = @_;
   return unless $opt && $opt->{type};
   my $val = $opt->{value};

   if ( $val && $opt->{type} eq 'm' ) {
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
      my ( $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} = $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' ) {
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
      my $from_key = $self->{defaults_to}->{ $opt->{long} };
      my $default = {};
      if ( $from_key ) {
         MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
         $default = $self->{dp}->parse(
            $self->{dp}->as_string($self->{opts}->{$from_key}->{value}) );
      }
      $opt->{value} = $self->{dp}->parse($val, $default);
   }
   elsif ( $val && $opt->{type} eq 'z' ) {
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
      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}");
      }
   }
   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
      $opt->{value} = { map { $_ => 1 } split(',', ($val || '')) };
   }
   elsif ( $opt->{type} eq 'A' || (defined $val && $opt->{type} eq 'a') ) {
      $opt->{value} = [ split(/(?<!\\),/, ($val || '')) ];
   }
   else {
      MKDEBUG && _d('Nothing to validate for option',
         $opt->{long}, 'type', $opt->{type}, 'value', $val);
   }

   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;
}

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

sub prompt {
   my ( $self ) = @_;
   return "Usage: $PROGRAM_NAME $self->{prompt}\n";
}

sub descr {
   my ( $self ) = @_;
   my $descr  = $self->{program_name} . ' ' . ($self->{description} || '')
              . "  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);
   $descr =~ s/ +$//mg;
   return $descr;
}

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

sub print_errors {
   my ( $self ) = @_;
   my $usage = $self->prompt() . "\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}) + ($_->{is_negatable} ? 4 : 0) }
      @opts);

   my $maxs = max(0,
      map { length($_) + ($self->{opts}->{$_}->{is_negatable} ? 4 : 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->prompt();

   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};
         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);
         }
      }
   }

   if ( (my @rules = @{$self->{rules}}) ) {
      $usage .= "\nRules:\n\n";
      $usage .= join("\n", map { "  $_" } @rules) . "\n";
   }
   if ( $self->{dp} ) {
      $usage .= "\n" . $self->{dp}->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->{dp}->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;
}

if ( MKDEBUG ) {
   print '# ', $^X, ' ', $], "\n";
   my $uname = `uname -a`;
   if ( $uname ) {
      $uname =~ s/\s+/ /g;
      print "# $uname\n";
   }
   printf("# %s  Ver %s Distrib %s Changeset %s line %d\n",
      $PROGRAM_NAME, ($main::VERSION || ''), ($main::DISTRIB || ''),
      ($main::SVN_REV || ''), __LINE__);
   print('# Arguments: ',
      join(' ', map { my $a = "_[$_]_"; $a =~ s/\n/\n# /g; $a; } @ARGV), "\n");
}

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 _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 OptionParser package
# ###########################################################################

# ###########################################################################
# Quoter package 3186
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package Quoter;

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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

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

sub quote_val {
   my ( $self, @vals ) = @_;
   return join(', ',
      map {
         if ( defined $_ ) {
            $_ =~ s/(['\\])/\\$1/g;
            $_ eq '' || $_ =~ m/^0|\D/ ? "'$_'" : $_;
         }
         else {
            'NULL';
         }
      } @vals
   );
}

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);
}

1;

# ###########################################################################
# End Quoter package
# ###########################################################################

# ###########################################################################
# DSNParser package 3963
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package DSNParser;

use DBI;
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;
use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, @opts ) = @_;
   my $self = {
      opts => {
         A => {
            desc => 'Default character set',
            dsn  => 'charset',
            copy => 1,
         },
         D => {
            desc => 'Database to use',
            dsn  => 'database',
            copy => 1,
         },
         F => {
            desc => 'Only read default options from the given file',
            dsn  => 'mysql_read_default_file',
            copy => 1,
         },
         h => {
            desc => 'Connect to host',
            dsn  => 'host',
            copy => 1,
         },
         p => {
            desc => 'Password to use when connecting',
            dsn  => 'password',
            copy => 1,
         },
         P => {
            desc => 'Port number to use for connection',
            dsn  => 'port',
            copy => 1,
         },
         S => {
            desc => 'Socket file to use for connection',
            dsn  => 'mysql_socket',
            copy => 1,
         },
         u => {
            desc => 'User for login if not current user',
            dsn  => 'user',
            copy => 1,
         },
      },
   };
   foreach my $opt ( @opts ) {
      MKDEBUG && _d('Adding extra property', $opt->{key});
      $self->{opts}->{$opt->{key}} = { desc => $opt->{desc}, copy => $opt->{copy} };
   }
   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 "Unrecognized DSN part '$key' in '$dsn'\n"
         unless exists $opts{$key};
   }
   if ( (my $required = $self->prop('required')) ) {
      foreach my $key ( keys %$required ) {
         die "Missing DSN part '$key' in '$dsn'\n" 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 ) = @_;
   return $dsn unless ref $dsn;
   return join(',',
      map  { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) }
      grep { defined $dsn->{$_} && $self->{opts}->{$_} }
      sort keys %$dsn );
}

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,
      mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/ ? 1 : 0),
   };
   @{$defaults}{ keys %$opts } = values %$opts;

   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 = q{SET @@SQL_QUOTE_SHOW_CREATE = 1}
                 . q{/*!40101, @@SQL_MODE='NO_AUTO_VALUE_ON_ZERO'*/};
            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('setvars') ) {
               $sql = "SET " . $self->prop('setvars');
               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};
         }
         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
# ###########################################################################

# ###########################################################################
# VersionParser package 3186
# ###########################################################################
package VersionParser;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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 _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
# ###########################################################################

# ###########################################################################
# TableSyncStream package 3186
# ###########################################################################
package TableSyncStream;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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

sub get_sql {
   my ( $self, %args ) = @_;
   return "SELECT "
      . ($self->{bufferinmysql} ? 'SQL_BUFFER_RESULT ' : '')
      . join(', ', map { $args{quoter}->quote($_) } @{$self->{cols}})
      . ' FROM ' . $args{quoter}->quote(@args{qw(database table)})
      . ' WHERE ' . ( $args{where} || '1=1' );
}

sub same_row {
   my ( $self, $lr, $rr ) = @_;
}

sub not_in_right {
   my ( $self, $lr ) = @_;
   $self->{handler}->change('INSERT', $lr, $self->key_cols());
}

sub not_in_left {
   my ( $self, $rr ) = @_;
   $self->{handler}->change('DELETE', $rr, $self->key_cols());
}

sub done_with_rows {
   my ( $self ) = @_;
   $self->{done} = 1;
}

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

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

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

sub pending_changes {
   my ( $self ) = @_;
}

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 TableSyncStream package
# ###########################################################################

# ###########################################################################
# TableParser package 3475
# ###########################################################################
package TableParser;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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


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

   if ( ref $ddl eq 'ARRAY' ) {
      if ( lc $ddl->[0] eq 'table' ) {
         $ddl = $ddl->[1];
      }
      else {
         return {
            engine => 'VIEW',
         };
      }
   }

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

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

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

   my @defs   = $ddl =~ m/^(\s+`.*?),?$/gm;
   my @cols   = map { $_ =~ m/`([^`]+)`/ } @defs;
   MKDEBUG && _d('Columns:', join(', ', @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 = $self->get_keys($ddl, $opts, \%is_nullable);

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

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 table_exists {
   my ( $self, $dbh, $db, $tbl, $q, $can_insert ) = @_;
   my $result = 0;
   my $db_tbl = $q->quote($db, $tbl);
   my $sql    = "SHOW FULL COLUMNS FROM $db_tbl";
   MKDEBUG && _d($sql);
   eval {
      my $sth = $dbh->prepare($sql);
      $sth->execute();
      my @columns = @{$sth->fetchall_arrayref({})};
      if ( $can_insert ) {
         $result = grep { ($_->{Privileges} || '') =~ m/insert/ } @columns;
      }
      else {
         $result = 1;
      }
   };
   if ( MKDEBUG && $EVAL_ERROR ) {
      _d($EVAL_ERROR);
   }
   return $result;
}

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   = {};

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

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

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

      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 ( split(',', $cols) ) {
         my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/;
         push @cols, $name;
         push @col_prefixes, $prefix;
      }
      $name =~ s/`//g;

      MKDEBUG && _d('Key', $name, 'cols:', join(', ', @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 },
      };
   }

   return $keys;
}

sub get_fks {
   my ( $self, $ddl, $opts ) = @_;
   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+) \(([^\)]+)\)/;

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

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

   return $fks;
}

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

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
# ###########################################################################

# ###########################################################################
# RowDiff package 3249
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package RowDiff;

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   die "I need a dbh" unless $args{dbh};
   my $self = \%args;
   return bless $self, $class;
}

sub compare_sets {
   my ( $self, %args ) = @_;
   my ( $left, $right, $syncer, $tbl )
      = @args{qw(left right syncer tbl)};

   my ($lr, $rr);  # Current row from the left/right sources.

   my ($left_done, $right_done) = (0, 0);

   do {
      if ( !$lr && !$left_done ) {
         MKDEBUG && _d('Fetching row from left');
         $lr = $left->fetchrow_hashref();
         $left_done = ($lr ? 0 : 1);
      }
      elsif ( MKDEBUG ) {
         _d('Left still has rows');
      }

      if ( !$rr && !$right_done ) {
         MKDEBUG && _d('Fetching row from right');
         $rr = $right->fetchrow_hashref();
         $right_done = ($rr ? 0 : 1);
      }
      elsif ( MKDEBUG ) {
         _d('Right still has rows');
      }

      my $cmp;
      if ( $lr && $rr ) {
         $cmp = $self->key_cmp($lr, $rr, $syncer->key_cols(), $tbl);
         MKDEBUG && _d('Key comparison on left and right:', $cmp);
      }
      if ( $lr || $rr ) {
         if ( $lr && $rr && defined $cmp && $cmp == 0 ) {
            MKDEBUG && _d('Left and right have the same key');
            $syncer->same_row($lr, $rr);
            $lr = $rr = undef; # Fetch another row from each side.
         }
         elsif ( !$rr || ( defined $cmp && $cmp < 0 ) ) {
            MKDEBUG && _d('Left is not in right');
            $syncer->not_in_right($lr);
            $lr = undef;
         }
         else {
            MKDEBUG && _d('Right is not in left');
            $syncer->not_in_left($rr);
            $rr = undef;
         }
      }
   } while ( !($left_done && $right_done) );
   MKDEBUG && _d('No more rows');
   $syncer->done_with_rows();
}

sub key_cmp {
   my ( $self, $lr, $rr, $key_cols, $tbl ) = @_;
   MKDEBUG && _d('Comparing keys using columns:', join(',', @$key_cols));
   foreach my $col ( @$key_cols ) {
      my $l = $lr->{$col};
      my $r = $rr->{$col};
      if ( !defined $l || !defined $r ) {
         MKDEBUG && _d($col, 'is not defined in both rows');
         return defined $l ? 1 : defined $r ? -1 : 0;
      }
      else {
         if ($tbl->{is_numeric}->{$col} ) {   # Numeric column
            MKDEBUG && _d($col, 'is numeric');
            my $cmp = $l <=> $r;
            return $cmp unless $cmp == 0;
         }
         elsif ( $l ne $r ) {
            my $cmp;
            my $coll = $tbl->{collation_for}->{$col};
            if ( $coll && ( $coll ne 'latin1_swedish_ci'
                           || $l =~ m/[^\040-\177]/ || $r =~ m/[^\040-\177]/) ) {
               MKDEBUG && _d('Comparing', $col, 'via MySQL');
               $cmp = $self->db_cmp($coll, $l, $r);
            }
            else {
               MKDEBUG && _d('Comparing', $col, 'in lowercase');
               $cmp = lc $l cmp lc $r;
            }
            return $cmp unless $cmp == 0;
         }
      }
   }
   return 0;
}

sub db_cmp {
   my ( $self, $collation, $l, $r ) = @_;
   if ( !$self->{sth}->{$collation} ) {
      if ( !$self->{charset_for} ) {
         MKDEBUG && _d('Fetching collations from MySQL');
         my @collations = @{$self->{dbh}->selectall_arrayref(
            'SHOW COLLATION', {Slice => { collation => 1, charset => 1 }})};
         foreach my $collation ( @collations ) {
            $self->{charset_for}->{$collation->{collation}}
               = $collation->{charset};
         }
      }
      my $sql = "SELECT STRCMP(_$self->{charset_for}->{$collation}? COLLATE $collation, "
         . "_$self->{charset_for}->{$collation}? COLLATE $collation) AS res";
      MKDEBUG && _d($sql);
      $self->{sth}->{$collation} = $self->{dbh}->prepare($sql);
   }
   my $sth = $self->{sth}->{$collation};
   $sth->execute($l, $r);
   return $sth->fetchall_arrayref()->[0]->[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 RowDiff package
# ###########################################################################

# ###########################################################################
# MySQLDump package 3312
# ###########################################################################
package MySQLDump;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

( our $before = <<'EOF') =~ s/^   //gm;
   /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
   /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
   /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
   /*!40101 SET NAMES utf8 */;
   /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
   /*!40103 SET TIME_ZONE='+00:00' */;
   /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
   /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
   /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
   /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
EOF

( our $after = <<'EOF') =~ s/^   //gm;
   /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
   /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
   /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
   /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
   /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
   /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
   /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
   /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
EOF

sub new {
   my ( $class, %args ) = @_;
   $args{cache} = 1 unless defined $args{cache};
   my $self = bless \%args, $class;
   return $self;
}

sub dump {
   my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_;

   if ( $what eq 'table' ) {
      my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
      if ( $ddl->[0] eq 'table' ) {
         return $before
            . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
            . $ddl->[1] . ";\n";
      }
      else {
         return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
            . '/*!50001 DROP VIEW IF EXISTS '
            . $quoter->quote($tbl) . "*/;\n/*!50001 "
            . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n";
      }
   }
   elsif ( $what eq 'triggers' ) {
      my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl);
      if ( $trgs && @$trgs ) {
         my $result = $before . "\nDELIMITER ;;\n";
         foreach my $trg ( @$trgs ) {
            if ( $trg->{sql_mode} ) {
               $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n};
            }
            $result .= "/*!50003 CREATE */ ";
            if ( $trg->{definer} ) {
               my ( $user, $host )
                  = map { s/'/''/g; "'$_'"; }
                    split('@', $trg->{definer}, 2);
               $result .= "/*!50017 DEFINER=$user\@$host */ ";
            }
            $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n",
               $quoter->quote($trg->{trigger}),
               @{$trg}{qw(timing event)},
               $quoter->quote($trg->{table}),
               $trg->{statement});
         }
         $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n";
         return $result;
      }
      else {
         return undef;
      }
   }
   elsif ( $what eq 'view' ) {
      my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
      return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
         . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
         . '/*!50001 ' . $ddl->[1] . "*/;\n";
   }
   else {
      die "You didn't say what to dump.";
   }
}

sub _use_db {
   my ( $self, $dbh, $quoter, $new ) = @_;
   if ( !$new ) {
      MKDEBUG && _d('No new DB to use');
      return;
   }
   my $sql = 'SELECT DATABASE()';
   MKDEBUG && _d($sql);
   my $curr = $dbh->selectrow_array($sql);
   if ( $curr && $new && $curr eq $new ) {
      MKDEBUG && _d('Current and new DB are the same');
      return $curr;
   }
   $sql = 'USE ' . $quoter->quote($new);
   MKDEBUG && _d($sql);
   $dbh->do($sql);
   return $curr;
}

sub get_create_table {
   my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
   if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) {
      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);
      my $curr_db = $self->_use_db($dbh, $quoter, $db);
      $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl);
      MKDEBUG && _d($sql);
      my $href = $dbh->selectrow_hashref($sql);
      $self->_use_db($dbh, $quoter, $curr_db);
      $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');
         $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ];
      }
      else {
         MKDEBUG && _d('This table is a view');
         ($key) = grep { m/create view/i } keys %$href;
         $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ];
      }
   }
   return $self->{tables}->{$db}->{$tbl};
}

sub get_columns {
   my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
   MKDEBUG && _d('Get columns for', $db, $tbl);
   if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) {
      my $curr_db = $self->_use_db($dbh, $quoter, $db);
      my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl);
      MKDEBUG && _d($sql);
      my $cols = $dbh->selectall_arrayref($sql, { Slice => {} });
      $self->_use_db($dbh, $quoter, $curr_db);
      $self->{columns}->{$db}->{$tbl} = [
         map {
            my %row;
            @row{ map { lc $_ } keys %$_ } = values %$_;
            \%row;
         } @$cols
      ];
   }
   return $self->{columns}->{$db}->{$tbl};
}

sub get_tmp_table {
   my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
   my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n";
   $result .= join(",\n",
      map { '  ' . $quoter->quote($_->{field}) . ' ' . $_->{type} }
      @{$self->get_columns($dbh, $quoter, $db, $tbl)});
   $result .= "\n)";
   MKDEBUG && _d($result);
   return $result;
}

sub get_triggers {
   my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
   if ( !$self->{cache} || !$self->{triggers}->{$db} ) {
      $self->{triggers}->{$db} = {};
      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 = "SHOW TRIGGERS FROM " . $quoter->quote($db);
      MKDEBUG && _d($sql);
      my $sth = $dbh->prepare($sql);
      $sth->execute();
      if ( $sth->rows ) {
         my $trgs = $sth->fetchall_arrayref({});
         foreach my $trg (@$trgs) {
            my %trg;
            @trg{ map { lc $_ } keys %$trg } = values %$trg;
            push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg;
         }
      }
      $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
         . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   }
   if ( $tbl ) {
      return $self->{triggers}->{$db}->{$tbl};
   }
   return values %{$self->{triggers}->{$db}};
}

sub get_databases {
   my ( $self, $dbh, $quoter, $like ) = @_;
   if ( !$self->{cache} || !$self->{databases} || $like ) {
      my $sql = 'SHOW DATABASES';
      my @params;
      if ( $like ) {
         $sql .= ' LIKE ?';
         push @params, $like;
      }
      my $sth = $dbh->prepare($sql);
      MKDEBUG && _d($sql, @params);
      $sth->execute( @params );
      my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()};
      $self->{databases} = \@dbs unless $like;
      return @dbs;
   }
   return @{$self->{databases}};
}

sub get_table_status {
   my ( $self, $dbh, $quoter, $db, $like ) = @_;
   if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) {
      my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db);
      my @params;
      if ( $like ) {
         $sql .= ' LIKE ?';
         push @params, $like;
      }
      MKDEBUG && _d($sql, @params);
      my $sth = $dbh->prepare($sql);
      $sth->execute(@params);
      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;
      $self->{table_status}->{$db} = \@tables unless $like;
      return @tables;
   }
   return @{$self->{table_status}->{$db}};
}

sub get_table_list {
   my ( $self, $dbh, $quoter, $db, $like ) = @_;
   if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) {
      my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db);
      my @params;
      if ( $like ) {
         $sql .= ' LIKE ?';
         push @params, $like;
      }
      MKDEBUG && _d($sql, @params);
      my $sth = $dbh->prepare($sql);
      $sth->execute(@params);
      my @tables = @{$sth->fetchall_arrayref()};
      @tables = map {
         my %tbl = (
            name   => $_->[0],
            engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '',
         );
         \%tbl;
      } @tables;
      $self->{table_list}->{$db} = \@tables unless $like;
      return @tables;
   }
   return @{$self->{table_list}->{$db}};
}

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 MySQLDump package
# ###########################################################################

# ###########################################################################
# ChangeHandler package 3186
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package ChangeHandler;

use English qw(-no_match_vars);

my $DUPE_KEY  = qr/Duplicate entry/;
our @ACTIONS  = qw(DELETE REPLACE INSERT UPDATE);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(quoter database table sdatabase stable replace queue)
   ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   my $self = { %args, map { $_ => [] } @ACTIONS };
   $self->{db_tbl}  = $self->{quoter}->quote(@args{qw(database table)});
   $self->{sdb_tbl} = $self->{quoter}->quote(@args{qw(sdatabase stable)});
   $self->{changes} = { map { $_ => 0 } @ACTIONS };
   return bless $self, $class;
}

sub fetch_back {
   my ( $self, $dbh ) = @_;
   $self->{fetch_back} = $dbh;
   MKDEBUG && _d('Will fetch rows from source when updating destination');
}

sub take_action {
   my ( $self, @sql ) = @_;
   MKDEBUG && _d('Calling subroutines on', @sql);
   foreach my $action ( @{$self->{actions}} ) {
      $action->(@sql);
   }
}

sub change {
   my ( $self, $action, $row, $cols ) = @_;
   MKDEBUG && _d($action, 'where', $self->make_where_clause($row, $cols));
   $self->{changes}->{
      $self->{replace} && $action ne 'DELETE' ? 'REPLACE' : $action
   }++;
   if ( $self->{queue} ) {
      $self->__queue($action, $row, $cols);
   }
   else {
      eval {
         my $func = "make_$action";
         $self->take_action($self->$func($row, $cols));
      };
      if ( $EVAL_ERROR =~ m/$DUPE_KEY/ ) {
         MKDEBUG && _d('Duplicate key violation; will queue and rewrite');
         $self->{queue}++;
         $self->{replace} = 1;
         $self->__queue($action, $row, $cols);
      }
      elsif ( $EVAL_ERROR ) {
         die $EVAL_ERROR;
      }
   }
}

sub __queue {
   my ( $self, $action, $row, $cols ) = @_;
   MKDEBUG && _d('Queueing change for later');
   if ( $self->{replace} ) {
      $action = $action eq 'DELETE' ? $action : 'REPLACE';
   }
   push @{$self->{$action}}, [ $row, $cols ];
}

sub process_rows {
   my ( $self, $queue_level ) = @_;
   my $error_count = 0;
   TRY: {
      if ( $queue_level && $queue_level < $self->{queue} ) { # see redo below!
         MKDEBUG && _d('Not processing now', $queue_level, '<', $self->{queue});
         return;
      }

      my ($row, $cur_act);
      eval {
         foreach my $action ( @ACTIONS ) {
            my $func = "make_$action";
            my $rows = $self->{$action};
            MKDEBUG && _d(scalar(@$rows), 'to', $action);
            $cur_act = $action;
            while ( @$rows ) {
               $row = shift @$rows;
               $self->take_action($self->$func(@$row));
            }
         }
         $error_count = 0;
      };
      if ( !$error_count++ && $EVAL_ERROR =~ m/$DUPE_KEY/ ) {
         MKDEBUG
            && _d('Duplicate key violation; re-queueing and rewriting');
         $self->{queue}++; # Defer rows to the very end
         $self->{replace} = 1;
         $self->__queue($cur_act, @$row);
         redo TRY;
      }
      elsif ( $EVAL_ERROR ) {
         die $EVAL_ERROR;
      }
   }
}

sub make_DELETE {
   my ( $self, $row, $cols ) = @_;
   return "DELETE FROM $self->{db_tbl} WHERE "
      . $self->make_where_clause($row, $cols)
      . ' LIMIT 1';
}

sub make_UPDATE {
   my ( $self, $row, $cols ) = @_;
   if ( $self->{replace} ) {
      return $self->make_row('REPLACE', $row, $cols);
   }
   my %in_where = map { $_ => 1 } @$cols;
   my $where = $self->make_where_clause($row, $cols);
   if ( my $dbh = $self->{fetch_back} ) {
      my $sql = "SELECT * FROM $self->{sdb_tbl} WHERE $where LIMIT 1";
      MKDEBUG && _d('Fetching data for UPDATE:', $sql);
      my $res = $dbh->selectrow_hashref($sql);
      @{$row}{keys %$res} = values %$res;
      $cols = [sort keys %$res];
   }
   else {
      $cols = [ sort keys %$row ];
   }
   return "UPDATE $self->{db_tbl} SET "
      . join(', ', map {
            $self->{quoter}->quote($_)
            . '=' .  $self->{quoter}->quote_val($row->{$_})
         } grep { !$in_where{$_} } @$cols)
      . " WHERE $where LIMIT 1";
}

sub make_INSERT {
   my ( $self, $row, $cols ) = @_;
   if ( $self->{replace} ) {
      return $self->make_row('REPLACE', $row, $cols);
   }
   return $self->make_row('INSERT', $row, $cols);
}

sub make_REPLACE {
   my ( $self, $row, $cols ) = @_;
   return $self->make_row('REPLACE', $row, $cols);
}

sub make_row {
   my ( $self, $verb, $row, $cols ) = @_;
   my @cols = sort keys %$row;
   if ( my $dbh = $self->{fetch_back} ) {
      my $where = $self->make_where_clause($row, $cols);
      my $sql = "SELECT * FROM $self->{sdb_tbl} WHERE $where LIMIT 1";
      MKDEBUG && _d('Fetching data for UPDATE:', $sql);
      my $res = $dbh->selectrow_hashref($sql);
      @{$row}{keys %$res} = values %$res;
      @cols = sort keys %$res;
   }
   return "$verb INTO $self->{db_tbl}("
      . join(', ', map { $self->{quoter}->quote($_) } @cols)
      . ') VALUES ('
      . $self->{quoter}->quote_val( @{$row}{@cols} )
      . ')';
}

sub make_where_clause {
   my ( $self, $row, $cols ) = @_;
   my @clauses = map {
      my $val = $row->{$_};
      my $sep = defined $val ? '=' : ' IS ';
      $self->{quoter}->quote($_) . $sep . $self->{quoter}->quote_val($val);
   } @$cols;
   return join(' AND ', @clauses);
}

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

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 ChangeHandler package
# ###########################################################################

# ###########################################################################
# TableChunker package 3186
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package TableChunker;

use English qw(-no_match_vars);
use POSIX qw(ceil);
use List::Util qw(min max);
use Data::Dumper;
$Data::Dumper::Quotekeys = 0;
$Data::Dumper::Indent    = 0;

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   die "I need a quoter" unless $args{quoter};
   bless { %args }, $class;
}

my $EPOCH      = '1970-01-01';
my %int_types  = map { $_ => 1 }
   qw( bigint date datetime int mediumint smallint time timestamp tinyint year );
my %real_types = map { $_ => 1 }
   qw( decimal double float );

sub find_chunk_columns {
   my ( $self, $table, $opts ) = @_;
   $opts ||= {};

   my %prefer;
   if ( $opts->{possible_keys} && @{$opts->{possible_keys}} ) {
      my $i = 1;
      %prefer = map { $_ => $i++ } @{$opts->{possible_keys}};
      MKDEBUG && _d('Preferred indexes for chunking:',
         join(', ', @{$opts->{possible_keys}}));
   }

   my @possible_keys;
   KEY:
   foreach my $key ( values %{ $table->{keys} } ) {

      next unless $key->{type} eq 'BTREE';

      defined $_ && next KEY for @{ $key->{col_prefixes} };

      if ( $opts->{exact} ) {
         next unless $key->{is_unique} && @{$key->{cols}} == 1;
      }

      push @possible_keys, $key;
   }

   @possible_keys = sort {
      ($prefer{$a->{name}} || 9999) <=> ($prefer{$b->{name}} || 9999)
   } @possible_keys;

   MKDEBUG && _d('Possible keys in order:',
      join(', ', map { $_->{name} } @possible_keys));

   my $can_chunk_exact = 0;
   my @candidate_cols;
   foreach my $key ( @possible_keys ) { 
      my $col = $key->{cols}->[0];

      next unless ( $int_types{$table->{type_for}->{$col}}
                    || $real_types{$table->{type_for}->{$col}} );

      push @candidate_cols, { column => $col, index => $key->{name} };
   }

   $can_chunk_exact = 1 if ( $opts->{exact} && scalar @candidate_cols );

   if ( MKDEBUG ) {
      my $chunk_type = $opts->{exact} ? 'Exact' : 'Inexact';
      _d($chunk_type, 'chunkable:',
         join(', ', map { "$_->{column} on $_->{index}" } @candidate_cols));
   }

   my @result;
   if ( !%prefer ) {
      MKDEBUG && _d('Ordering columns by order in tbl, PK first');
      if ( $table->{keys}->{PRIMARY} ) {
         my $pk_first_col = $table->{keys}->{PRIMARY}->{cols}->[0];
         @result = grep { $_->{column} eq $pk_first_col } @candidate_cols;
         @candidate_cols = grep { $_->{column} ne $pk_first_col } @candidate_cols;
      }
      my $i = 0;
      my %col_pos = map { $_ => $i++ } @{$table->{cols}};
      push @result, sort { $col_pos{$a->{column}} <=> $col_pos{$b->{column}} }
                       @candidate_cols;
   }
   else {
      @result = @candidate_cols;
   }

   if ( MKDEBUG ) {
      _d('Chunkable columns:',
         join(', ', map { "$_->{column} on $_->{index}" } @result));
      _d('Can chunk exactly:', $can_chunk_exact);
   }

   return ($can_chunk_exact, \@result);
}

sub calculate_chunks {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(table col min max rows_in_range size dbh) ) {
      die "Required argument $arg not given or undefined"
         unless defined $args{$arg};
   }
   MKDEBUG && _d('Arguments:',
      join(', ',
         map { "$_=" . (defined $args{$_} ? $args{$_} : 'undef') } keys %args));

   my @chunks;
   my ($range_func, $start_point, $end_point);
   my $col_type = $args{table}->{type_for}->{$args{col}};
   MKDEBUG && _d('Chunking on', $args{col}, '(',$col_type,')');


   if ( $col_type =~ m/(?:int|year|float|double|decimal)$/ ) {
      $start_point = $args{min};
      $end_point   = $args{max};
      $range_func  = 'range_num';
   }
   elsif ( $col_type eq 'timestamp' ) {
      my $sql = "SELECT UNIX_TIMESTAMP('$args{min}'), UNIX_TIMESTAMP('$args{max}')";
      MKDEBUG && _d($sql);
      ($start_point, $end_point) = $args{dbh}->selectrow_array($sql);
      $range_func  = 'range_timestamp';
   }
   elsif ( $col_type eq 'date' ) {
      my $sql = "SELECT TO_DAYS('$args{min}'), TO_DAYS('$args{max}')";
      MKDEBUG && _d($sql);
      ($start_point, $end_point) = $args{dbh}->selectrow_array($sql);
      $range_func  = 'range_date';
   }
   elsif ( $col_type eq 'time' ) {
      my $sql = "SELECT TIME_TO_SEC('$args{min}'), TIME_TO_SEC('$args{max}')";
      MKDEBUG && _d($sql);
      ($start_point, $end_point) = $args{dbh}->selectrow_array($sql);
      $range_func  = 'range_time';
   }
   elsif ( $col_type eq 'datetime' ) {
      $start_point = $self->timestampdiff($args{dbh}, $args{min});
      $end_point   = $self->timestampdiff($args{dbh}, $args{max});
      $range_func  = 'range_datetime';
   }
   else {
      die "I don't know how to chunk $col_type\n";
   }

   if ( !defined $start_point ) {
      MKDEBUG && _d('Start point is undefined');
      $start_point = 0;
   }
   if ( !defined $end_point || $end_point < $start_point ) {
      MKDEBUG && _d('End point is undefined or before start point');
      $end_point = 0;
   }
   MKDEBUG && _d('Start and end of chunk range:',$start_point,',', $end_point);

   my $interval = $args{size} * ($end_point - $start_point) / $args{rows_in_range};
   if ( $int_types{$col_type} ) {
      $interval = ceil($interval);
   }
   $interval ||= $args{size};
   if ( $args{exact} ) {
      $interval = $args{size};
   }
   MKDEBUG && _d('Chunk interval:', $interval, 'units');

   my $col = "`$args{col}`";
   if ( $start_point < $end_point ) {
      my ( $beg, $end );
      my $iter = 0;
      for ( my $i = $start_point; $i < $end_point; $i += $interval ) {
         ( $beg, $end ) = $self->$range_func($args{dbh}, $i, $interval, $end_point);

         if ( $iter++ == 0 ) {
            push @chunks, "$col < " . $self->quote($end);
         }
         else {
            push @chunks, "$col >= " . $self->quote($beg) . " AND $col < " . $self->quote($end);
         }
      }

      my $nullable = $args{table}->{is_nullable}->{$args{col}};
      pop @chunks;
      if ( @chunks ) {
         push @chunks, "$col >= " . $self->quote($beg);
      }
      else {
         push @chunks, $nullable ? "$col IS NOT NULL" : '1=1';
      }
      if ( $nullable ) {
         push @chunks, "$col IS NULL";
      }

   }
   else {
      push @chunks, '1=1';
   }

   return @chunks;
}

sub get_first_chunkable_column {
   my ( $self, $table, $opts ) = @_;
   my ($exact, $cols) = $self->find_chunk_columns($table, $opts);
   return ( $cols->[0]->{column}, $cols->[0]->{index} );
}

sub size_to_rows {
   my ( $self, $dbh, $db, $tbl, $size, $dumper ) = @_;
  
   my ( $num, $suffix ) = $size =~ m/^(\d+)([MGk])?$/;
   if ( $suffix ) { # Convert to bytes.
      $size = $suffix eq 'k' ? $num * 1_024
            : $suffix eq 'M' ? $num * 1_024 * 1_024
            :                  $num * 1_024 * 1_024 * 1_024;
   }
   elsif ( $num ) {
      return $num;
   }
   else {
      die "Invalid size spec $size; must be an integer with optional suffix kMG";
   }

   my @status = $dumper->get_table_status($dbh, $self->{quoter}, $db);
   my ($status) = grep { $_->{name} eq $tbl } @status;
   my $avg_row_length = $status->{avg_row_length};
   return $avg_row_length ? ceil($size / $avg_row_length) : undef;
}

sub get_range_statistics {
   my ( $self, $dbh, $db, $tbl, $col, $where ) = @_;
   my $q = $self->{quoter};
   my $sql = "SELECT MIN(" . $q->quote($col) . "), MAX(" . $q->quote($col)
      . ") FROM " . $q->quote($db, $tbl)
      . ($where ? " WHERE $where" : '');
   MKDEBUG && _d($sql);
   my ( $min, $max );
   eval {
      ( $min, $max ) = $dbh->selectrow_array($sql);
   };
   if ( $EVAL_ERROR ) {
      chomp $EVAL_ERROR;
      if ( $EVAL_ERROR =~ m/in your SQL syntax/ ) {
         die "$EVAL_ERROR (WHERE clause: $where)";
      }
      else {
         die $EVAL_ERROR;
      }
   }
   $sql = "EXPLAIN SELECT * FROM " . $q->quote($db, $tbl)
      . ($where ? " WHERE $where" : '');
   MKDEBUG && _d($sql);
   my $expl = $dbh->selectrow_hashref($sql);
   return (
      min           => $min,
      max           => $max,
      rows_in_range => $expl->{rows},
   );
}

sub quote {
   my ( $self, $val ) = @_;
   return $val =~ m/\d[:-]/ ? qq{"$val"} : $val;
}

sub inject_chunks {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(database table chunks chunk_num query) ) {
      die "$arg is required" unless defined $args{$arg};
   }
   MKDEBUG && _d('Injecting chunk', $args{chunk_num});
   my $comment = sprintf("/*%s.%s:%d/%d*/",
      $args{database}, $args{table},
      $args{chunk_num} + 1, scalar @{$args{chunks}});
   $args{query} =~ s!/\*PROGRESS_COMMENT\*/!$comment!;
   my $where = "WHERE (" . $args{chunks}->[$args{chunk_num}] . ')';
   if ( $args{where} && grep { $_ } @{$args{where}} ) {
      $where .= " AND ("
         . join(" AND ", map { "($_)" } grep { $_ } @{$args{where}} )
         . ")";
   }
   my $db_tbl     = $self->{quoter}->quote(@args{qw(database table)});
   my $index_hint = defined $args{index_hint}
                    ? "USE INDEX (`$args{index_hint}`)"
                    : '';
   MKDEBUG && _d('Parameters:',
      Dumper({WHERE => $where, DB_TBL => $db_tbl, INDEX_HINT => $index_hint}));
   $args{query} =~ s!/\*WHERE\*/! $where!;
   $args{query} =~ s!/\*DB_TBL\*/!$db_tbl!;
   $args{query} =~ s!/\*INDEX_HINT\*/! $index_hint!;
   $args{query} =~ s!/\*CHUNK_NUM\*/! $args{chunk_num} AS chunk_num,!;
   return $args{query};
}

sub range_num {
   my ( $self, $dbh, $start, $interval, $max ) = @_;
   my $end = min($max, $start + $interval);


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

   $start =~ s/\.(\d{5}).*$/.$1/;
   $end   =~ s/\.(\d{5}).*$/.$1/;

   if ( $end > $start ) {
      return ( $start, $end );
   }
   else {
      die "Chunk size is too small: $end !> $start\n";
   }
}

sub range_time {
   my ( $self, $dbh, $start, $interval, $max ) = @_;
   my $sql = "SELECT SEC_TO_TIME($start), SEC_TO_TIME(LEAST($max, $start + $interval))";
   MKDEBUG && _d($sql);
   return $dbh->selectrow_array($sql);
}

sub range_date {
   my ( $self, $dbh, $start, $interval, $max ) = @_;
   my $sql = "SELECT FROM_DAYS($start), FROM_DAYS(LEAST($max, $start + $interval))";
   MKDEBUG && _d($sql);
   return $dbh->selectrow_array($sql);
}

sub range_datetime {
   my ( $self, $dbh, $start, $interval, $max ) = @_;
   my $sql = "SELECT DATE_ADD('$EPOCH', INTERVAL $start SECOND), "
       . "DATE_ADD('$EPOCH', INTERVAL LEAST($max, $start + $interval) SECOND)";
   MKDEBUG && _d($sql);
   return $dbh->selectrow_array($sql);
}

sub range_timestamp {
   my ( $self, $dbh, $start, $interval, $max ) = @_;
   my $sql = "SELECT FROM_UNIXTIME($start), FROM_UNIXTIME(LEAST($max, $start + $interval))";
   MKDEBUG && _d($sql);
   return $dbh->selectrow_array($sql);
}

sub timestampdiff {
   my ( $self, $dbh, $time ) = @_;
   my $sql = "SELECT (COALESCE(TO_DAYS('$time'), 0) * 86400 + TIME_TO_SEC('$time')) "
      . "- TO_DAYS('$EPOCH 00:00:00') * 86400";
   MKDEBUG && _d($sql);
   my ( $diff ) = $dbh->selectrow_array($sql);
   $sql = "SELECT DATE_ADD('$EPOCH', INTERVAL $diff SECOND)";
   MKDEBUG && _d($sql);
   my ( $check ) = $dbh->selectrow_array($sql);
   die <<"   EOF"
   Incorrect datetime math: given $time, calculated $diff but checked to $check.
   This is probably because you are using a version of MySQL that overflows on
   large interval values to DATE_ADD().  If not, please report this as a bug.
   EOF
      unless $check eq $time;
   return $diff;
}

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 TableChunker package
# ###########################################################################

# ###########################################################################
# TableChecksum package 3186
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package TableChecksum;

use English qw(-no_match_vars);
use List::Util qw(max);

use constant MKDEBUG => $ENV{MKDEBUG};

our %ALGOS = (
   CHECKSUM => { pref => 0, hash => 0 },
   BIT_XOR  => { pref => 2, hash => 1 },
   ACCUM    => { pref => 3, hash => 1 },
);

sub new {
   bless {}, shift;
}

sub crc32 {
   my ( $self, $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 get_crc_wid {
   my ( $self, $dbh, $func ) = @_;
   my $crc_wid = 16;
   if ( uc $func ne 'FNV_64' ) {
      eval {
         my ($val) = $dbh->selectrow_array("SELECT $func('a')");
         $crc_wid = max(16, length($val));
      };
   }
   return $crc_wid;
}

sub get_crc_type {
   my ( $self, $dbh, $func ) = @_;
   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;
   return ($type, $length);
}

sub best_algorithm {
   my ( $self, %args ) = @_;
   my ($alg, $vp, $dbh) = @args{ qw(algorithm vp dbh) };
   my @choices = sort { $ALGOS{$a}->{pref} <=> $ALGOS{$b}->{pref} } keys %ALGOS;
   die "Invalid checksum algorithm $alg"
      if $alg && !$ALGOS{$alg};

   if (
      $args{where} || $args{chunk}        # CHECKSUM does whole table
      || $args{replicate}                 # CHECKSUM can't do INSERT.. SELECT
      || !$vp->version_ge($dbh, '4.1.1')) # CHECKSUM doesn't exist
   {
      MKDEBUG && _d('Cannot use CHECKSUM algorithm');
      @choices = grep { $_ ne 'CHECKSUM' } @choices;
   }

   if ( !$vp->version_ge($dbh, '4.1.1') ) {
      MKDEBUG && _d('Cannot use BIT_XOR algorithm');
      @choices = grep { $_ ne 'BIT_XOR' } @choices;
   }

   if ( $alg && grep { $_ eq $alg } @choices ) {
      MKDEBUG && _d('User requested', $alg, 'algorithm');
      return $alg;
   }

   if ( $args{count} && grep { $_ ne 'CHECKSUM' } @choices ) {
      MKDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired');
      @choices = grep { $_ ne 'CHECKSUM' } @choices;
   }

   MKDEBUG && _d('Algorithms, in order:', @choices);
   return $choices[0];
}

sub is_hash_algorithm {
   my ( $self, $algorithm ) = @_;
   return $ALGOS{$algorithm} && $ALGOS{$algorithm}->{hash};
}

sub choose_hash_func {
   my ( $self, %args ) = @_;
   my @funcs = qw(CRC32 FNV_64 MD5 SHA1);
   if ( $args{func} ) {
      unshift @funcs, $args{func};
   }
   my ($result, $error);
   do {
      my $func;
      eval {
         $func = shift(@funcs);
         my $sql = "SELECT $func('test-string')";
         MKDEBUG && _d($sql);
         $args{dbh}->do($sql);
         $result = $func;
      };
      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);
      }
   } while ( @funcs && !$result );

   die $error unless $result;
   return $result;
}

sub optimize_xor {
   my ( $self, %args ) = @_;
   my ( $dbh, $func ) = @args{qw(dbh func)};

   die "$func never needs the BIT_XOR optimization"
      if $func =~ m/^(?: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_wid   = 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(
         query     => "\@crc := $func('a')",
         crc_wid   => $crc_wid,
         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_wid && $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 ( $query, $crc_wid, $opt_slice )
      = @args{qw(query crc_wid opt_slice)};

   my @slices;
   for ( my $start = 1; $start <= $crc_wid; $start += 16 ) {
      my $len = $crc_wid - $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 := $query/;
   }
   else {
      map { s/\@crc/$query/ } @slices;
   }

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

sub make_row_checksum {
   my ( $self, %args ) = @_;
   my ( $table, $quoter, $func )
      = @args{ qw(table quoter func) };

   my $sep = $args{sep} || '#';
   $sep =~ s/'//g;
   $sep ||= '#';

   my %ignorecols = map { $_ => 1 } @{$args{ignorecols}};

   my %cols = map { lc($_) => 1 }
              grep { !exists $ignorecols{$_} }
              ($args{cols} ? @{$args{cols}} : @{$table->{cols}});
   my @cols =
      map {
         my $type = $table->{type_for}->{$_};
         my $result = $quoter->quote($_);
         if ( $type eq 'timestamp' ) {
            $result .= ' + 0';
         }
         elsif ( $type =~ m/float|double/ && $args{precision} ) {
            $result = "ROUND($result, $args{precision})";
         }
         elsif ( $type =~ m/varchar/ && $args{trim} ) {
            $result = "TRIM($result)";
         }
         $result;
      }
      grep {
         $cols{$_}
      }
      @{$table->{cols}};

   my $query;
   if ( uc $func ne 'FNV_64' ) {
      my @nulls = grep { $cols{$_} } @{$table->{null_cols}};
      if ( @nulls ) {
         my $bitmap = "CONCAT("
            . join(', ', map { 'ISNULL(' . $quoter->quote($_) . ')' } @nulls)
            . ")";
         push @cols, $bitmap;
      }

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

   return $query;
}

sub make_checksum_query {
   my ( $self, %args ) = @_;
   my @arg_names = qw(dbname tblname table quoter algorithm
        func crc_wid crc_type opt_slice);
   foreach my $arg( @arg_names ) {
      die "You must specify argument $arg" unless exists $args{$arg};
   }
   my ( $dbname, $tblname, $table, $quoter, $algorithm,
        $func, $crc_wid, $crc_type, $opt_slice ) = @args{ @arg_names };
   die "Invalid or missing checksum algorithm"
      unless $algorithm && $ALGOS{$algorithm};

   my $result;

   if ( $algorithm eq 'CHECKSUM' ) {
      return "CHECKSUM TABLE " . $quoter->quote($dbname, $tblname);
   }

   my $expr = $self->make_row_checksum(%args);

   if ( $algorithm eq 'BIT_XOR' ) {
      if ( $crc_type =~ m/int$/ ) {
         $result = "LOWER(CONV(BIT_XOR(CAST($expr AS UNSIGNED)), 10, 16)) AS crc ";
      }
      else {
         my $slices = $self->make_xor_slices( query => $expr, %args );
         $result = "LOWER(CONCAT($slices)) AS crc ";
      }
   }
   else {
      if ( $crc_type =~ m/int$/ ) {
         $result = "RIGHT(MAX("
            . "\@crc := CONCAT(LPAD(\@cnt := \@cnt + 1, 16, '0'), "
            . "CONV(CAST($func(CONCAT(\@crc, $expr)) AS UNSIGNED), 10, 16))"
            . "), $crc_wid) AS crc ";
      }
      else {
         $result = "RIGHT(MAX("
            . "\@crc := CONCAT(LPAD(\@cnt := \@cnt + 1, 16, '0'), "
            . "$func(CONCAT(\@crc, $expr)))"
            . "), $crc_wid) AS crc ";
      }
   }
   if ( $args{replicate} ) {
      $result = "REPLACE /*PROGRESS_COMMENT*/ INTO $args{replicate} "
         . "(db, tbl, chunk, boundaries, this_cnt, this_crc) "
         . "SELECT ?, ?, /*CHUNK_NUM*/ ?, COUNT(*) AS cnt, $result";
   }
   else {
      $result = "SELECT "
         . ($args{buffer} ? 'SQL_BUFFER_RESULT ' : '')
         . "/*PROGRESS_COMMENT*//*CHUNK_NUM*/ COUNT(*) AS cnt, $result";
   }
   return $result . "FROM /*DB_TBL*//*INDEX_HINT*//*WHERE*/";
}

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

   (my $sql = <<"   EOF") =~ s/\s+/ /gm;
      SELECT db, tbl, chunk, boundaries,
         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 $table
      WHERE master_cnt <> this_cnt OR master_crc <> this_crc
      OR ISNULL(master_crc) <> ISNULL(this_crc)
   EOF

   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 TableChecksum package
# ###########################################################################

# ###########################################################################
# TableSyncChunk package 3186
# ###########################################################################
package TableSyncChunk;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);
use List::Util qw(max);
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(dbh database table handler chunker quoter struct
                        checksum cols vp chunksize where possible_keys
                        dumper trim) ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   $args{crc_col} = '__crc';
   while ( $args{struct}->{is_col}->{$args{crc_col}} ) {
      $args{crc_col} = "_$args{crc_col}"; # Prepend more _ until not a column.
   }
   MKDEBUG && _d('CRC column will be named', $args{crc_col});

   my @chunks;
   my ( $col, $idx ) = $args{chunker}->get_first_chunkable_column(
      $args{struct}, { possible_keys => $args{possible_keys} });
   $args{index} = $idx;
   if ( $col ) {
      my %params = $args{chunker}->get_range_statistics(
         $args{dbh}, $args{database}, $args{table}, $col,
         $args{where});
      if ( !grep { !defined $params{$_} }
            qw(min max rows_in_range) )
      {
         @chunks = $args{chunker}->calculate_chunks(
            dbh      => $args{dbh},
            table    => $args{struct},
            col      => $col,
            size     => $args{chunksize},
            %params,
         );
      }
      else {
         @chunks = '1=1';
      }
      $args{chunk_col} = $col;
   }
   die "Cannot chunk $args{database}.$args{table}" unless @chunks;
   $args{chunks}     = \@chunks;
   $args{chunk_num}  = 0;

   $args{algorithm} = $args{checksum}->best_algorithm(
      algorithm   => 'BIT_XOR',
      vp          => $args{vp},
      dbh         => $args{dbh},
      where       => 1,
      chunk       => 1,
      count       => 1,
   );
   $args{func} = $args{checksum}->choose_hash_func(
      func => $args{func},
      dbh  => $args{dbh},
   );
   $args{crc_wid}    = $args{checksum}->get_crc_wid($args{dbh}, $args{func});
   ($args{crc_type}) = $args{checksum}->get_crc_type($args{dbh}, $args{func});
   if ( $args{algorithm} eq 'BIT_XOR' && $args{crc_type} !~ m/int$/ ) {
      $args{opt_slice}
         = $args{checksum}->optimize_xor(dbh => $args{dbh}, func => $args{func});
   }
   $args{chunk_sql} ||= $args{checksum}->make_checksum_query(
      dbname    => $args{database},
      tblname   => $args{table},
      table     => $args{struct},
      quoter    => $args{quoter},
      algorithm => $args{algorithm},
      func      => $args{func},
      crc_wid   => $args{crc_wid},
      crc_type  => $args{crc_type},
      opt_slice => $args{opt_slice},
      cols      => $args{cols},
      trim      => $args{trim},
      buffer    => $args{bufferinmysql},
   );
   $args{row_sql} ||= $args{checksum}->make_row_checksum(
      table     => $args{struct},
      quoter    => $args{quoter},
      func      => $args{func},
      cols      => $args{cols},
      trim      => $args{trim},
   );

   $args{state} = 0;
   $args{handler}->fetch_back($args{dbh});
   return bless { %args }, $class;
}

sub get_sql {
   my ( $self, %args ) = @_;
   if ( $self->{state} ) {
      my $index_hint = defined $args{index_hint}
                       ? " USE INDEX (`$args{index_hint}`) "
                       : '';
      return 'SELECT '
         . ($self->{bufferinmysql} ? 'SQL_BUFFER_RESULT ' : '')
         . join(', ', map { $self->{quoter}->quote($_) } @{$self->key_cols()})
         . ', ' . $self->{row_sql} . " AS $self->{crc_col}"
         . ' FROM ' . $self->{quoter}->quote(@args{qw(database table)})
         . $index_hint 
         . ' WHERE (' . $self->{chunks}->[$self->{chunk_num}] . ')'
         . ($args{where} ? " AND ($args{where})" : '');
   }
   else {
      return $self->{chunker}->inject_chunks(
         database   => $args{database},
         table      => $args{table},
         chunks     => $self->{chunks},
         chunk_num  => $self->{chunk_num},
         query      => $self->{chunk_sql},
         where      => [$args{where}],
         quoter     => $self->{quoter},
         index_hint => $args{index_hint},
      );
   }
}

sub prepare {
   my ( $self, $dbh ) = @_;
   $dbh->do(q{SET @crc := ''});
}

sub same_row {
   my ( $self, $lr, $rr ) = @_;
   if ( $self->{state} ) {
      if ( $lr->{$self->{crc_col}} ne $rr->{$self->{crc_col}} ) {
         $self->{handler}->change('UPDATE', $lr, $self->key_cols());
      }
   }
   elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) {
      MKDEBUG && _d('Rows:', Dumper($lr, $rr));
      MKDEBUG && _d('Will examine this chunk before moving to next');
      $self->{state} = 1; # Must examine this chunk row-by-row
   }
}

sub not_in_right {
   my ( $self, $lr ) = @_;
   die "Called not_in_right in state 0" unless $self->{state};
   $self->{handler}->change('INSERT', $lr, $self->key_cols());
}

sub not_in_left {
   my ( $self, $rr ) = @_;
   die "Called not_in_left in state 0" unless $self->{state};
   $self->{handler}->change('DELETE', $rr, $self->key_cols());
}

sub done_with_rows {
   my ( $self ) = @_;
   if ( $self->{state} == 1 ) {
      $self->{state} = 2;
      MKDEBUG && _d('Setting state =', $self->{state});
   }
   else {
      $self->{state} = 0;
      $self->{chunk_num}++;
      MKDEBUG && _d('Setting state =', $self->{state},
         'chunk_num =', $self->{chunk_num});
   }
}

sub done {
   my ( $self ) = @_;
   MKDEBUG && _d('Done with', $self->{chunk_num}, 'of',
      scalar(@{$self->{chunks}}), 'chunks');
   MKDEBUG && $self->{state} && _d('Chunk differs; must examine rows');
   return $self->{state} == 0
      && $self->{chunk_num} >= scalar(@{$self->{chunks}})
}

sub pending_changes {
   my ( $self ) = @_;
   if ( $self->{state} ) {
      MKDEBUG && _d('There are pending changes');
      return 1;
   }
   else {
      MKDEBUG && _d('No pending changes');
      return 0;
   }
}

sub key_cols {
   my ( $self ) = @_;
   my @cols;
   if ( $self->{state} == 0 ) {
      @cols = qw(chunk_num);
   }
   else {
      @cols = $self->{chunk_col};
   }
   MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols));
   return \@cols;
}

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 TableSyncChunk package
# ###########################################################################

# ###########################################################################
# TableSyncNibble package 3186
# ###########################################################################
package TableSyncNibble;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);
use List::Util qw(max);
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(dbh database table handler nibbler quoter struct
                        parser checksum cols vp chunksize where chunker
                        versionparser possible_keys trim) ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   $args{crc_col} = '__crc';
   while ( $args{struct}->{is_col}->{$args{crc_col}} ) {
      $args{crc_col} = "_$args{crc_col}"; # Prepend more _ until not a column.
   }
   MKDEBUG && _d('CRC column will be named', $args{crc_col});

   $args{sel_stmt} = $args{nibbler}->generate_asc_stmt(
      parser   => $args{parser},
      tbl      => $args{struct},
      index    => $args{possible_keys}->[0],
      quoter   => $args{quoter},
      asconly  => 1,
   );

   die "No suitable index found"
      unless $args{sel_stmt}->{index}
         && $args{struct}->{keys}->{$args{sel_stmt}->{index}}->{is_unique};
   $args{key_cols} = $args{struct}->{keys}->{$args{sel_stmt}->{index}}->{cols};

   $args{algorithm} = $args{checksum}->best_algorithm(
      algorithm   => 'BIT_XOR',
      vp          => $args{vp},
      dbh         => $args{dbh},
      where       => 1,
      chunk       => 1,
      count       => 1,
   );
   $args{func} = $args{checksum}->choose_hash_func(
      dbh  => $args{dbh},
      func => $args{func},
   );
   $args{crc_wid}    = $args{checksum}->get_crc_wid($args{dbh}, $args{func});
   ($args{crc_type}) = $args{checksum}->get_crc_type($args{dbh}, $args{func});
   if ( $args{algorithm} eq 'BIT_XOR' && $args{crc_type} !~ m/int$/ ) {
      $args{opt_slice}
         = $args{checksum}->optimize_xor(dbh => $args{dbh}, func => $args{func});
   }

   $args{nibble_sql} ||= $args{checksum}->make_checksum_query(
      dbname    => $args{database},
      tblname   => $args{table},
      table     => $args{struct},
      quoter    => $args{quoter},
      algorithm => $args{algorithm},
      func      => $args{func},
      crc_wid   => $args{crc_wid},
      crc_type  => $args{crc_type},
      opt_slice => $args{opt_slice},
      cols      => $args{cols},
      trim      => $args{trim},
      buffer    => $args{bufferinmysql},
   );
   $args{row_sql} ||= $args{checksum}->make_row_checksum(
      table     => $args{struct},
      quoter    => $args{quoter},
      func      => $args{func},
      cols      => $args{cols},
      trim      => $args{trim},
   );

   $args{state}  = 0;
   $args{nibble} = 0;
   $args{handler}->fetch_back($args{dbh});
   return bless { %args }, $class;
}

sub get_sql {
   my ( $self, %args ) = @_;
   if ( $self->{state} ) {
      return 'SELECT '
         . ($self->{bufferinmysql} ? 'SQL_BUFFER_RESULT ' : '')
         . join(', ', map { $self->{quoter}->quote($_) } @{$self->key_cols()})
         . ', ' . $self->{row_sql} . " AS $self->{crc_col}"
         . ' FROM ' . $self->{quoter}->quote(@args{qw(database table)})
         . ' WHERE (' . $self->__get_boundaries() . ')'
         . ($args{where} ? " AND ($args{where})" : '');
   }
   else {
      my $where = $self->__get_boundaries();
      return $self->{chunker}->inject_chunks(
         database  => $args{database},
         table     => $args{table},
         chunks    => [$where],
         chunk_num => 0,
         query     => $self->{nibble_sql},
         where     => [$args{where}],
         quoter    => $self->{quoter},
      );
   }
}

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

   if ( $self->{cached_boundaries} ) {
      MKDEBUG && _d('Using cached boundaries');
      return $self->{cached_boundaries};
   }

   my $q = $self->{quoter};
   my $s = $self->{sel_stmt};
   my $row;
   my $lb; # Lower boundaries
   if ( $self->{cached_row} && $self->{cached_nibble} == $self->{nibble} ) {
      MKDEBUG && _d('Using cached row for boundaries');
      $row = $self->{cached_row};
   }
   else {
      my $sql      = 'SELECT '
         . join(',', map { $q->quote($_) } @{$s->{cols}})
         . " FROM " . $q->quote($self->{database}, $self->{table})
         . ($self->{versionparser}->version_ge($self->{dbh}, '4.0.9')
            ? " FORCE" : " USE")
         . " INDEX(" . $q->quote($s->{index}) . ")";
      if ( $self->{nibble} ) {
         my $tmp = $self->{cached_row};
         my $i   = 0;
         ($lb = $s->{boundaries}->{'>'})
            =~ s{([=><]) \?}
                {"$1 " . $q->quote_val($tmp->{$s->{scols}->[$i++]})}eg;
         $sql .= ' WHERE ' . $lb;
      }
      $sql .= ' LIMIT ' . ($self->{chunksize} - 1) . ', 1';
      MKDEBUG && _d($sql);
      $row = $self->{dbh}->selectrow_hashref($sql);
   }

   my $where;
   if ( $row ) {
      my $i = 0;
      ($where = $s->{boundaries}->{'<='})
         =~ s{([=><]) \?}{"$1 " . $q->quote_val($row->{$s->{scols}->[$i++]})}eg;
   }
   else {
      $where = '1=1';
   }

   if ( $lb ) {
      $where = "($lb AND $where)";
   }

   $self->{cached_row}        = $row;
   $self->{cached_nibble}     = $self->{nibble};
   $self->{cached_boundaries} = $where;

   MKDEBUG && _d('WHERE clause:', $where);
   return $where;
}

sub prepare {
   my ( $self, $dbh ) = @_;
   $dbh->do(q{SET @crc := ''});
}

sub same_row {
   my ( $self, $lr, $rr ) = @_;
   if ( $self->{state} ) {
      if ( $lr->{$self->{crc_col}} ne $rr->{$self->{crc_col}} ) {
         $self->{handler}->change('UPDATE', $lr, $self->key_cols());
      }
   }
   elsif ( $lr->{cnt} != $rr->{cnt} || $lr->{crc} ne $rr->{crc} ) {
      MKDEBUG && _d('Rows:', Dumper($lr, $rr));
      MKDEBUG && _d('Will examine this nibble before moving to next');
      $self->{state} = 1; # Must examine this nibble row-by-row
   }
}

sub not_in_right {
   my ( $self, $lr ) = @_;
   die "Called not_in_right in state 0" unless $self->{state};
   $self->{handler}->change('INSERT', $lr, $self->key_cols());
}

sub not_in_left {
   my ( $self, $rr ) = @_;
   die "Called not_in_left in state 0" unless $self->{state};
   $self->{handler}->change('DELETE', $rr, $self->key_cols());
}

sub done_with_rows {
   my ( $self ) = @_;
   if ( $self->{state} == 1 ) {
      $self->{state} = 2;
      MKDEBUG && _d('Setting state =', $self->{state});
   }
   else {
      $self->{state} = 0;
      $self->{nibble}++;
      delete $self->{cached_boundaries};
      MKDEBUG && _d('Setting state =', $self->{state},
         ', nibble =', $self->{nibble});
   }
}

sub done {
   my ( $self ) = @_;
   MKDEBUG && _d('Done with nibble', $self->{nibble});
   MKDEBUG && $self->{state} && _d('Nibble differs; must examine rows');
   return $self->{state} == 0 && $self->{nibble} && !$self->{cached_row};
}

sub pending_changes {
   my ( $self ) = @_;
   if ( $self->{state} ) {
      MKDEBUG && _d('There are pending changes');
      return 1;
   }
   else {
      MKDEBUG && _d('No pending changes');
      return 0;
   }
}

sub key_cols {
   my ( $self ) = @_;
   my @cols;
   if ( $self->{state} == 0 ) {
      @cols = qw(chunk_num);
   }
   else {
      @cols = @{$self->{key_cols}};
   }
   MKDEBUG && _d('State', $self->{state},',', 'key cols', join(', ', @cols));
   return \@cols;
}

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 TableSyncNibble package
# ###########################################################################

# ###########################################################################
# TableSyncGroupBy package 3186
# ###########################################################################
package TableSyncGroupBy;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(handler cols) ) {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   $args{count_col} = '__maatkit_count';
   while ( $args{struct}->{is_col}->{$args{count_col}} ) {
      $args{count_col} = "_$args{count_col}";
   }
   MKDEBUG && _d('COUNT column will be named', $args{count_col});
   return bless { %args }, $class;
}

sub get_sql {
   my ( $self, %args ) = @_;
   my $cols = join(', ', map { $args{quoter}->quote($_) } @{$self->{cols}});
   return "SELECT"
      . ($self->{bufferinmysql} ? ' SQL_BUFFER_RESULT' : '')
      . " $cols, COUNT(*) AS $self->{count_col}"
      . ' FROM ' . $args{quoter}->quote(@args{qw(database table)})
      . ' WHERE ' . ( $args{where} || '1=1' )
      . " GROUP BY $cols ORDER BY $cols";
}

sub same_row {
   my ( $self, $lr, $rr ) = @_;
   my $cc = $self->{count_col};
   my $lc = $lr->{$cc};
   my $rc = $rr->{$cc};
   my $diff = abs($lc - $rc);
   return unless $diff;
   $lr = { %$lr };
   delete $lr->{$cc};
   $rr = { %$rr };
   delete $rr->{$cc};
   foreach my $i ( 1 .. $diff ) {
      if ( $lc > $rc ) {
         $self->{handler}->change('INSERT', $lr, $self->key_cols());
      }
      else {
         $self->{handler}->change('DELETE', $rr, $self->key_cols());
      }
   }
}

sub not_in_right {
   my ( $self, $lr ) = @_;
   $lr = { %$lr };
   my $cnt = delete $lr->{$self->{count_col}};
   foreach my $i ( 1 .. $cnt ) {
      $self->{handler}->change('INSERT', $lr, $self->key_cols());
   }
}

sub not_in_left {
   my ( $self, $rr ) = @_;
   $rr = { %$rr };
   my $cnt = delete $rr->{$self->{count_col}};
   foreach my $i ( 1 .. $cnt ) {
      $self->{handler}->change('DELETE', $rr, $self->key_cols());
   }
}

sub done_with_rows {
   my ( $self ) = @_;
   $self->{done} = 1;
}

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

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

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

sub pending_changes {
   my ( $self ) = @_;
}

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 TableSyncGroupBy package
# ###########################################################################

# ###########################################################################
# TableSyncer package 3495
# ###########################################################################
package TableSyncer;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

our %ALGOS = map { lc $_ => $_ } qw(Stream Chunk Nibble GroupBy);

sub new {
   bless {}, shift;
}

sub best_algorithm {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(tbl_struct parser nibbler chunker) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $result;

   my ($exact, $cols) = $args{chunker}
      ->find_chunk_columns($args{tbl_struct}, { exact => 1 });
   if ( $exact ) {
      MKDEBUG && _d('Chunker says', $cols->[0], 'supports chunking exactly');
      $result = 'Chunk';
   }
   else {
      my ($idx) = $args{parser}->find_best_index($args{tbl_struct});
      if ( $idx ) {
         MKDEBUG && _d('Parser found best index', $idx, 'so Nibbler will work');
         $result = 'Nibble';
      }
      else {
         MKDEBUG && _d('No primary or unique non-null key in table');
         $result = 'GroupBy';
      }
   }
   MKDEBUG && _d('Algorithm:', $result);
   return $result;
}

sub sync_table {
   my ( $self, %args ) = @_;
   foreach my $arg ( qw(
      buffer checksum chunker chunksize dst_db dst_dbh dst_tbl execute lock
      misc_dbh quoter replace replicate src_db src_dbh src_tbl test tbl_struct
      timeoutok transaction versionparser wait where possible_keys cols
      nibbler parser master_slave func dumper trim skipslavecheck bufferinmysql) )
   {
      die "I need a $arg argument" unless defined $args{$arg};
   }
   MKDEBUG && _d('Syncing table with args',
      join(', ',
         map { "$_=" . (defined $args{$_} ? $args{$_} : 'undef') }
         sort keys %args));

   my $can_replace
      = grep { $_->{is_unique} } values %{$args{tbl_struct}->{keys}};
   MKDEBUG && _d('This table\'s replace-ability:', $can_replace);
   my $use_replace = $args{replace} || $args{replicate};

   my $update_func;
   my $change_dbh;
   if ( $args{execute} ) {
      if ( $args{replicate} ) {
         $change_dbh = $args{src_dbh};
         $self->check_permissions(@args{qw(src_dbh src_db src_tbl quoter)});
         if ( !$can_replace ) {
            die "Can't make changes on the master: no unique index exists";
         }
      }
      else {
         $change_dbh = $args{dst_dbh};
         $self->check_permissions(@args{qw(dst_dbh dst_db dst_tbl quoter)});
         my $slave_status = $args{master_slave}->get_slave_status($change_dbh);
         my (undef, $log_bin) = $change_dbh->selectrow_array(
            'SHOW VARIABLES LIKE "log_bin"');
         my ($sql_log_bin) = $change_dbh->selectrow_array(
            'SELECT @@SQL_LOG_BIN');
         MKDEBUG && _d('Variables: log_bin=',
            (defined $log_bin ? $log_bin : 'NULL'),
            ' @@SQL_LOG_BIN=',
            (defined $sql_log_bin ? $sql_log_bin : 'NULL'));
         if ( !$args{skipslavecheck} && $slave_status && $sql_log_bin
            && ($log_bin || 'OFF') eq 'ON' )
         {
            die "Can't make changes on $change_dbh because it's a slave: see "
               . "the documentation section 'REPLICATION SAFETY' for solutions "
               . "to this problem.";
         }
      }
      MKDEBUG && _d('Will make changes via', $change_dbh);
      $update_func = sub {
         map {
            MKDEBUG && _d('About to execute:', $_);
            $change_dbh->do($_);
         } @_;
      };
   }

   my $ch = new ChangeHandler(
      queue     => $args{buffer} ? 0 : 1,
      quoter    => $args{quoter},
      database  => $args{dst_db},
      table     => $args{dst_tbl},
      sdatabase => $args{src_db},
      stable    => $args{src_tbl},
      replace   => $use_replace,
      actions   => [
         ( $update_func ? $update_func            : () ),
         ( $args{print}
            ? sub { print(@_, ";\n") or die "Cannot print: $OS_ERROR" }
            : () ),
      ],
   );
   my $rd = new RowDiff( dbh => $args{misc_dbh} );

   $args{algorithm} ||= $self->best_algorithm(
      map { $_ => $args{$_} } qw(tbl_struct parser nibbler chunker));

   if ( !$ALGOS{ lc $args{algorithm} } ) {
      die "No such algorithm $args{algorithm}; try one of "
         . join(', ', values %ALGOS) . "\n";
   }
   $args{algorithm} = $ALGOS{ lc $args{algorithm} };

   if ( $args{test} ) {
      return ($ch->get_changes(), ALGORITHM => $args{algorithm});
   }

   my $chunksize = $args{chunker}->size_to_rows(
         @args{qw(src_dbh src_db src_tbl chunksize dumper)}),

   my $class  = "TableSync$args{algorithm}";
   my $plugin = $class->new(
      handler   => $ch,
      cols      => $args{cols},
      dbh       => $args{src_dbh},
      database  => $args{src_db},
      dumper    => $args{dumper},
      table     => $args{src_tbl},
      chunker   => $args{chunker},
      nibbler   => $args{nibbler},
      parser    => $args{parser},
      struct    => $args{tbl_struct},
      checksum  => $args{checksum},
      vp        => $args{versionparser},
      quoter    => $args{quoter},
      chunksize => $chunksize,
      where     => $args{where},
      possible_keys => [],
      versionparser => $args{versionparser},
      func          => $args{func},
      trim          => $args{trim},
      bufferinmysql => $args{bufferinmysql},
   );

   $self->lock_and_wait(%args, lock_level => 2);

   my $cycle = 0;
   while ( !$plugin->done ) {

      MKDEBUG && _d('Beginning sync cycle', $cycle);
      my $src_sql = $plugin->get_sql(
         quoter     => $args{quoter},
         database   => $args{src_db},
         table      => $args{src_tbl},
         where      => $args{where},
         index_hint => $args{index_hint} ? $plugin->{index} : undef,
      );
      my $dst_sql = $plugin->get_sql(
         quoter     => $args{quoter},
         database   => $args{dst_db},
         table      => $args{dst_tbl},
         where      => $args{where},
         index_hint => $args{index_hint} ? $plugin->{index} : undef,
      );
      if ( $args{transaction} ) {
         if ( $change_dbh && $change_dbh eq $args{src_dbh} ) {
            $src_sql .= ' FOR UPDATE';
            $dst_sql .= ' LOCK IN SHARE MODE';
         }
         elsif ( $change_dbh ) {
            $src_sql .= ' LOCK IN SHARE MODE';
            $dst_sql .= ' FOR UPDATE';
         }
         else {
            $src_sql .= ' LOCK IN SHARE MODE';
            $dst_sql .= ' LOCK IN SHARE MODE';
         }
      }
      $plugin->prepare($args{src_dbh});
      $plugin->prepare($args{dst_dbh});
      MKDEBUG && _d('src:', $src_sql);
      MKDEBUG && _d('dst:', $dst_sql);
      my $src_sth = $args{src_dbh}
         ->prepare( $src_sql, { mysql_use_result => !$args{buffer} } );
      my $dst_sth = $args{dst_dbh}
         ->prepare( $dst_sql, { mysql_use_result => !$args{buffer} } );

      my $executed_src = 0;
      if ( !$cycle || !$plugin->pending_changes() ) {
         $executed_src
            = $self->lock_and_wait(%args, src_sth => $src_sth, lock_level => 1);
      }

      $src_sth->execute() unless $executed_src;
      $dst_sth->execute();

      $rd->compare_sets(
         left   => $src_sth,
         right  => $dst_sth,
         syncer => $plugin,
         tbl    => $args{tbl_struct},
      );
      MKDEBUG && _d('Finished sync cycle', $cycle);
      $ch->process_rows(1);

      $cycle++;
   }

   $ch->process_rows();

   $self->unlock(%args, lock_level => 2);

   return ($ch->get_changes(), ALGORITHM => $args{algorithm});
}

sub check_permissions {
   my ( $self, $dbh, $db, $tbl, $quoter ) = @_;
   my $db_tbl = $quoter->quote($db, $tbl);
   my $sql = "SHOW FULL COLUMNS FROM $db_tbl";
   MKDEBUG && _d('Permissions check:', $sql);
   my $cols = $dbh->selectall_arrayref($sql, {Slice => {}});
   my ($hdr_name) = grep { m/privileges/i } keys %{$cols->[0]};
   my $privs = $cols->[0]->{$hdr_name};
   die "$privs does not include all needed privileges for $db_tbl"
      unless $privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/;
   $sql = "DELETE FROM $db_tbl LIMIT 0"; # FULL COLUMNS doesn't show all privs
   MKDEBUG && _d('Permissions check:', $sql);
   $dbh->do($sql);
}

sub lock_table {
   my ( $self, $dbh, $where, $db_tbl, $mode ) = @_;
   my $query = "LOCK TABLES $db_tbl $mode";
   MKDEBUG && _d($query);
   $dbh->do($query);
   MKDEBUG && _d('Acquired table lock on', $where, 'in', $mode, 'mode');
}

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

   foreach my $arg ( qw(
      dst_db dst_dbh dst_tbl lock quoter replicate src_db src_dbh src_tbl
      timeoutok transaction wait lock_level) )
   {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   return unless $args{lock} && $args{lock} <= $args{lock_level};

   foreach my $dbh( @args{qw(src_dbh dst_dbh)} ) {
      if ( $args{transaction} ) {
         MKDEBUG && _d('Committing', $dbh);
         $dbh->commit;
      }
      else {
         my $sql = 'UNLOCK TABLES';
         MKDEBUG && _d($dbh, $sql);
         $dbh->do($sql);
      }
   }
}

sub lock_and_wait {
   my ( $self, %args ) = @_;
   my $result = 0;

   foreach my $arg ( qw(
      dst_db dst_dbh dst_tbl lock quoter replicate src_db src_dbh src_tbl
      timeoutok transaction wait lock_level misc_dbh master_slave) )
   {
      die "I need a $arg argument" unless defined $args{$arg};
   }

   return unless $args{lock} && $args{lock} == $args{lock_level};

   foreach my $dbh( @args{qw(src_dbh dst_dbh)} ) {
      if ( $args{transaction} ) {
         MKDEBUG && _d('Committing', $dbh);
         $dbh->commit;
      }
      else {
         my $sql = 'UNLOCK TABLES';
         MKDEBUG && _d($dbh, $sql);
         $dbh->do($sql);
      }
   }

   if ( $args{lock} == 3 ) {
      my $sql = 'FLUSH TABLES WITH READ LOCK';
      MKDEBUG && _d($args{src_dbh}, ',', $sql);
      $args{src_dbh}->do($sql);
   }
   else {
      if ( $args{transaction} ) {
         if ( $args{src_sth} ) {
            MKDEBUG && _d('Executing statement on source to lock rows');
            $args{src_sth}->execute();
            $result = 1;
         }
      }
      else {
         $self->lock_table($args{src_dbh}, 'source',
            $args{quoter}->quote($args{src_db}, $args{src_tbl}),
            $args{replicate} ? 'WRITE' : 'READ');
      }
   }

   eval {
      if ( $args{wait} ) {
         $args{master_slave}->wait_for_master(
            $args{misc_dbh}, $args{dst_dbh}, $args{wait}, $args{timeoutok});
      }

      if ( $args{replicate} ) {
         MKDEBUG
            && _d('Not locking destination because syncing via replication');
      }
      else {
         if ( $args{lock} == 3 ) {
            my $sql = 'FLUSH TABLES WITH READ LOCK';
            MKDEBUG && _d($args{dst_dbh}, ',', $sql);
            $args{dst_dbh}->do($sql);
         }
         elsif ( !$args{transaction} ) {
            $self->lock_table($args{dst_dbh}, 'dest',
               $args{quoter}->quote($args{dst_db}, $args{dst_tbl}),
               $args{execute} ? 'WRITE' : 'READ');
         }
      }
   };

   if ( $EVAL_ERROR ) {
      if ( $args{src_sth}->{Active} ) {
         $args{src_sth}->finish();
      }
      foreach my $dbh ( @args{qw(src_dbh dst_dbh misc_dbh)} ) {
         next unless $dbh;
         MKDEBUG && _d('Caught error, unlocking/committing on', $dbh);
         $dbh->do('UNLOCK TABLES');
         $dbh->commit() unless $dbh->{AutoCommit};
      }
      die $EVAL_ERROR;
   }

   return $result;
}

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 TableSyncer package
# ###########################################################################

# ###########################################################################
# MySQLFind package 3186
# ###########################################################################
package MySQLFind;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;

use constant MKDEBUG => $ENV{MKDEBUG};


sub new {
   my ( $class, %args ) = @_;
   foreach my $arg ( qw(dumper quoter) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   die "Do not pass me a dbh argument" if $args{dbh};
   my $self = bless \%args, $class;
   $self->{need_engine}
      = (   $self->{engines}->{permit}
         || $self->{engines}->{reject}
         || $self->{engines}->{regexp} ? 1 : 0);
   die "I need a parser argument"
      if $self->{need_engine} && !defined $args{parser};
   MKDEBUG && _d('Need engine:', $self->{need_engine} ? 'yes' : 'no');
   $self->{engines}->{views} = 1  unless defined $self->{engines}->{views};
   $self->{tables}->{status} = [] unless defined $self->{tables}->{status};
   if ( $args{useddl} ) {
      MKDEBUG && _d('Will prefer DDL');
   }
   return $self;
}

sub init_timestamp {
   my ( $self, $dbh ) = @_;
   return if $self->{timestamp}->{$dbh}->{now};
   my $sql = 'SELECT CURRENT_TIMESTAMP';
   MKDEBUG && _d($sql);
   ($self->{timestamp}->{$dbh}->{now}) = $dbh->selectrow_array($sql);
   MKDEBUG && _d('Current timestamp:', $self->{timestamp}->{$dbh}->{now});
}

sub find_databases {
   my ( $self, $dbh ) = @_;
   return grep {
      $_ !~ m/^(information_schema|lost\+found)$/i
   }  $self->_filter('databases', sub { $_[0] },
         $self->{dumper}->get_databases(
            $dbh,
            $self->{quoter},
            $self->{databases}->{like}));
}

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

   my @tables
      = $self->_filter('tables', sub { $_[0]->{name} },
         $self->_fetch_tbl_list($dbh, %args));

   if ( $self->{need_engine} ) {
      foreach my $tbl ( @tables ) {
         next if $tbl->{engine};
         my ( $tbl_name ) = $tbl->{name} =~ m/\.(.+)$/;
         my $struct = $self->{parser}->parse(
            $self->{dumper}->get_create_table(
               $dbh, $self->{quoter}, $args{database}, $tbl_name));
         $tbl->{engine} = $struct->{engine};
      }
      @tables = $self->_filter('engines', sub { $_[0]->{engine} }, @tables);
   }

   map { $_->{name} =~ s/^[^.]*\.// } @tables;

   foreach my $crit ( @{$self->{tables}->{status}} ) {
      my ($key, $test) = %$crit;
      @tables
         = grep {
            $self->_test_date($_, $key, $test, $dbh)
         } @tables;
   }

   return map { $_->{name} } @tables;
}

sub find_views {
   my ( $self, $dbh, %args ) = @_;
   my @tables = $self->_fetch_tbl_list($dbh, %args);
   @tables = grep { $_->{engine} eq 'VIEW' } @tables;
   map { $_->{name} =~ s/^[^.]*\.// } @tables; # <database>.<table> => <table> 
   return map { $_->{name} } @tables;
}

sub _use_db {
   my ( $self, $dbh, $new ) = @_;
   if ( !$new ) {
      MKDEBUG && _d('No new DB to use');
      return;
   }
   my $sql = 'SELECT DATABASE()';
   MKDEBUG && _d($sql);
   my $curr = $dbh->selectrow_array($sql);
   if ( $curr && $new && $curr eq $new ) {
      MKDEBUG && _d('Current and new DB are the same');
      return $curr;
   }
   $sql = 'USE ' . $self->{quoter}->quote($new);
   MKDEBUG && _d($sql);
   $dbh->do($sql);
   return $curr;
}

sub _fetch_tbl_list {
   my ( $self, $dbh, %args ) = @_;
   die "database is required" unless $args{database};

   my $curr_db = $self->_use_db($dbh, $args{database});

   my @tables;
   if ( scalar @{$self->{tables}->{status}} ) {
      @tables = $self->{dumper}->get_table_status(
         $dbh,
         $self->{quoter},
         $args{database},
         $self->{tables}->{like});
   }
   else {
      @tables = $self->{dumper}->get_table_list(
         $dbh,
         $self->{quoter},
         $args{database},
         $self->{tables}->{like});
   }

   @tables = map {
      my %hash = %$_;
      $hash{name} = join('.', $args{database}, $hash{name});
      \%hash;
   }
   grep {
      ( $self->{engines}->{views} || ($_->{engine} ne 'VIEW') )
   } @tables;

   $self->_use_db($dbh, $curr_db);

   return @tables;
}

sub _filter {
   my ( $self, $thing, $sub, @vals ) = @_;
   MKDEBUG && _d('Filtering', $thing, 'list on', Dumper($self->{$thing}));
   my $permit = $self->{$thing}->{permit};
   my $reject = $self->{$thing}->{reject};
   my $regexp = $self->{$thing}->{regexp};
   return grep {
      my $val = $sub->($_);
      $val = '' unless defined $val;
      if ( $thing eq 'tables' ) {
         (my $tbl = $val) =~ s/^.*\.//;
         ( !$reject || (!$reject->{$val} && !$reject->{$tbl}) )
            && ( !$permit || $permit->{$val} || $permit->{$tbl} )
            && ( !$regexp || $val =~ m/$regexp/ )
      }
      else {
         ( !$reject || !$reject->{$val} )
            && ( !$permit || $permit->{$val} )
            && ( !$regexp || $val =~ m/$regexp/ )
      }
   } @vals;
}

sub _test_date {
   my ( $self, $table, $prop, $test, $dbh ) = @_;
   $prop = lc $prop;
   if ( !defined $table->{$prop} ) {
      MKDEBUG && _d($prop, 'is not defined');
      return $self->{nullpass};
   }
   my ( $equality, $num ) = $test =~ m/^([+-])?(\d+)$/;
   die "Invalid date test $test for $prop" unless defined $num;
   $self->init_timestamp($dbh);
   my $sql = "SELECT DATE_SUB('$self->{timestamp}->{$dbh}->{now}', "
           . "INTERVAL $num SECOND)";
   MKDEBUG && _d($sql);
   ($self->{timestamp}->{$dbh}->{$num}) ||= $dbh->selectrow_array($sql);
   my $time = $self->{timestamp}->{$dbh}->{$num};
   return 
         ( $equality eq '-' && $table->{$prop} gt $time )
      || ( $equality eq '+' && $table->{$prop} lt $time )
      || (                     $table->{$prop} eq $time );
}

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 MySQLFind package
# ###########################################################################

# ###########################################################################
# TableNibbler package 3186
# ###########################################################################
package TableNibbler;

use strict;
use warnings FATAL => 'all';

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   bless {}, shift;
}

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

   my $tbl  = $args{tbl};
   my @cols = $args{cols} ? @{$args{cols}} : @{$tbl->{cols}};
   my $q    = $args{quoter};

   my @asc_cols;
   my @asc_slice;

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

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

   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->{is_nullable},
         );
         $asc_stmt->{boundaries}->{$cmp} = $cmp_where->{where};
      }
      my $cmp = $args{asconly} ? '>' : '>=';
      $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 quoter is_nullable) ) {
      die "I need a $arg arg" unless defined $args{$arg};
   }

   my @slice       = @{$args{slice}};
   my @cols        = @{$args{cols}};
   my $q           = $args{quoter};
   my $is_nullable = $args{is_nullable};
   my $type        = $args{type};

   (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) . ')';
   return {
      slice => \@r_slice,
      scols => \@r_scols,
      where => $result,
   };
}

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

   my $tbl  = $args{tbl};
   my @cols = $args{cols} ? @{$args{cols}} : ();
   my $q    = $args{quoter};

   my @del_cols;
   my @del_slice;

   my $index = $args{parser}->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 3186
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package MasterSlave;

use English qw(-no_match_vars);
use List::Util qw(min max);
use Data::Dumper;
$Data::Dumper::Quotekeys = 0;
$Data::Dumper::Indent    = 0;

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   bless {}, shift;
}

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 ) = @_;
   $method ||= '';
   MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn));

   my @slaves;

   if ( (!$method && ($dsn->{P}||3306) == 3306) || $method eq 'processlist' ) {
      @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);
   }

   if ( !@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;
      }
   }

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

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

   my $proc =
      grep { m/ALL PRIVILEGES.*?\*\.\*|PROCESS/ }
      @{$dbh->selectcol_arrayref('SHOW GRANTS')};
   if ( !$proc ) {
      die "You do not have the PROCESS privilege";
   }

   my $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} ) {
      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({})};

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

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

sub wait_for_master {
   my ( $self, $master, $slave, $time, $timeoutok, $ms ) = @_;
   my $result;
   MKDEBUG && _d('Waiting for slave to catch up to master');
   $ms ||= $self->get_master_status($master);
   if ( $ms ) {
      my $query = "SELECT MASTER_POS_WAIT('$ms->{file}', $ms->{position}, $time)";
      MKDEBUG && _d($slave, $query);
      ($result) = $slave->selectrow_array($query);
      my $stat = defined $result ? $result : 'NULL';
      if ( $stat eq 'NULL' || $stat < 0 && !$timeoutok ) {
         die "MASTER_POS_WAIT returned $stat";
      }
      MKDEBUG && _d('Result of waiting:', $stat);
   }
   else {
      MKDEBUG && _d('Not waiting: this server is not a master');
   }
   return $result;
}

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, $time ) = @_;
   $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));
   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);
      eval {
         $self->wait_for_master($master, $slave, $time, 0, $master_status);
      };
      if ( $EVAL_ERROR ) {
         MKDEBUG && _d($EVAL_ERROR);
         if ( $EVAL_ERROR =~ m/MASTER_POS_WAIT returned NULL/ ) {
            $slave_status = $self->get_slave_status($slave);
            if ( !$self->slave_is_running($slave_status) ) {
               $slave_pos = $self->repl_posn($slave_status);
               if ( $self->pos_cmp($slave_pos, $master_pos) != 0 ) {
                  die "$EVAL_ERROR but slave has not caught up to master";
               }
               MKDEBUG && _d('Slave is caught up to master and stopped');
            }
            else {
               die "$EVAL_ERROR but slave was still running";
            }
         }
         else {
            die $EVAL_ERROR;
         }
      }
   }
}

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 change_master_to {
   my ( $self, $dbh, $master_dsn, $master_pos ) = @_;
   $self->stop_slave($dbh);
   MKDEBUG && _d(Dumper($master_dsn), Dumper($master_pos));
   my $sql = "CHANGE MASTER TO MASTER_HOST='$master_dsn->{h}', "
      . "MASTER_PORT= $master_dsn->{P}, MASTER_LOG_FILE='$master_pos->{file}', "
      . "MASTER_LOG_POS=$master_pos->{position}";
   MKDEBUG && _d($dbh, $sql);
   $dbh->do($sql);
}

sub make_sibling_of_master {
   my ( $self, $slave_dbh, $slave_dsn, $dsn_parser, $timeout) = @_;

   my $master_dsn  = $self->get_master_dsn($slave_dbh, $slave_dsn, $dsn_parser)
      or die "This server is not a slave";
   my $master_dbh  = $dsn_parser->get_dbh(
      $dsn_parser->get_cxn_params($master_dsn), { AutoCommit => 1 });
   my $gmaster_dsn
      = $self->get_master_dsn($master_dbh, $master_dsn, $dsn_parser)
      or die "This server's master is not a slave";
   my $gmaster_dbh = $dsn_parser->get_dbh(
      $dsn_parser->get_cxn_params($gmaster_dsn), { AutoCommit => 1 });
   if ( $self->short_host($slave_dsn) eq $self->short_host($gmaster_dsn) ) {
      die "The slave's master's master is the slave: master-master replication";
   }

   $self->stop_slave($master_dbh);
   $self->catchup_to_master($slave_dbh, $master_dbh, $timeout);
   $self->stop_slave($slave_dbh);

   my $master_status = $self->get_master_status($master_dbh);
   my $mslave_status = $self->get_slave_status($master_dbh);
   my $slave_status  = $self->get_slave_status($slave_dbh);
   my $master_pos    = $self->repl_posn($master_status);
   my $slave_pos     = $self->repl_posn($slave_status);

   if ( !$self->slave_is_running($mslave_status)
     && !$self->slave_is_running($slave_status)
     && $self->pos_cmp($master_pos, $slave_pos) == 0)
   {
      $self->change_master_to($slave_dbh, $gmaster_dsn,
         $self->repl_posn($mslave_status)); # Note it's not $master_pos!
   }
   else {
      die "The servers aren't both stopped at the same position";
   }

   $mslave_status = $self->get_slave_status($master_dbh);
   $slave_status  = $self->get_slave_status($slave_dbh);
   my $mslave_pos = $self->repl_posn($mslave_status);
   $slave_pos     = $self->repl_posn($slave_status);
   if ( $self->short_host($mslave_status) ne $self->short_host($slave_status)
     || $self->pos_cmp($mslave_pos, $slave_pos) != 0)
   {
      die "The servers don't have the same master/position after the change";
   }
}

sub make_slave_of_sibling {
   my ( $self, $slave_dbh, $slave_dsn, $sib_dbh, $sib_dsn,
        $dsn_parser, $timeout) = @_;

   if ( $self->short_host($slave_dsn) eq $self->short_host($sib_dsn) ) {
      die "You are trying to make the slave a slave of itself";
   }

   my $master_dsn1 = $self->get_master_dsn($slave_dbh, $slave_dsn, $dsn_parser)
      or die "This server is not a slave";
   my $master_dbh1 = $dsn_parser->get_dbh(
      $dsn_parser->get_cxn_params($master_dsn1), { AutoCommit => 1 });
   my $master_dsn2 = $self->get_master_dsn($slave_dbh, $slave_dsn, $dsn_parser)
      or die "The sibling is not a slave";
   if ( $self->short_host($master_dsn1) ne $self->short_host($master_dsn2) ) {
      die "This server isn't a sibling of the slave";
   }
   my $sib_master_stat = $self->get_master_status($sib_dbh)
      or die "Binary logging is not enabled on the sibling";
   die "The log_slave_updates option is not enabled on the sibling"
      unless $self->has_slave_updates($sib_dbh);

   $self->catchup_to_same_pos($slave_dbh, $sib_dbh);

   $sib_master_stat = $self->get_master_status($sib_dbh);
   $self->change_master_to($slave_dbh, $sib_dsn,
         $self->repl_posn($sib_master_stat));

   my $slave_status = $self->get_slave_status($slave_dbh);
   my $slave_pos    = $self->repl_posn($slave_status);
   $sib_master_stat = $self->get_master_status($sib_dbh);
   if ( $self->short_host($slave_status) ne $self->short_host($sib_dsn)
     || $self->pos_cmp($self->repl_posn($sib_master_stat), $slave_pos) != 0)
   {
      die "After changing the slave's master, it isn't a slave of the sibling, "
         . "or it has a different replication position than the sibling";
   }
}

sub make_slave_of_uncle {
   my ( $self, $slave_dbh, $slave_dsn, $unc_dbh, $unc_dsn,
        $dsn_parser, $timeout) = @_;

   if ( $self->short_host($slave_dsn) eq $self->short_host($unc_dsn) ) {
      die "You are trying to make the slave a slave of itself";
   }

   my $master_dsn = $self->get_master_dsn($slave_dbh, $slave_dsn, $dsn_parser)
      or die "This server is not a slave";
   my $master_dbh = $dsn_parser->get_dbh(
      $dsn_parser->get_cxn_params($master_dsn), { AutoCommit => 1 });
   my $gmaster_dsn
      = $self->get_master_dsn($master_dbh, $master_dsn, $dsn_parser)
      or die "The master is not a slave";
   my $unc_master_dsn
      = $self->get_master_dsn($unc_dbh, $unc_dsn, $dsn_parser)
      or die "The uncle is not a slave";
   if ($self->short_host($gmaster_dsn) ne $self->short_host($unc_master_dsn)) {
      die "The uncle isn't really the slave's uncle";
   }

   my $unc_master_stat = $self->get_master_status($unc_dbh)
      or die "Binary logging is not enabled on the uncle";
   die "The log_slave_updates option is not enabled on the uncle"
      unless $self->has_slave_updates($unc_dbh);

   $self->catchup_to_same_pos($master_dbh, $unc_dbh);
   $self->catchup_to_master($slave_dbh, $master_dbh, $timeout);

   my $slave_status  = $self->get_slave_status($slave_dbh);
   my $master_status = $self->get_master_status($master_dbh);
   if ( $self->pos_cmp(
         $self->repl_posn($slave_status),
         $self->repl_posn($master_status)) != 0 )
   {
      die "The slave is not caught up to its master";
   }

   $unc_master_stat = $self->get_master_status($unc_dbh);
   $self->change_master_to($slave_dbh, $unc_dsn,
      $self->repl_posn($unc_master_stat));


   $slave_status    = $self->get_slave_status($slave_dbh);
   my $slave_pos    = $self->repl_posn($slave_status);
   if ( $self->short_host($slave_status) ne $self->short_host($unc_dsn)
     || $self->pos_cmp($self->repl_posn($unc_master_stat), $slave_pos) != 0)
   {
      die "After changing the slave's master, it isn't a slave of the uncle, "
         . "or it has a different replication position than the uncle";
   }
}

sub detach_slave {
   my ( $self, $dbh ) = @_;
   $self->stop_slave($dbh);
   my $stat = $self->get_slave_status($dbh)
      or die "This server is not a slave";
   $dbh->do('CHANGE MASTER TO MASTER_HOST=""');
   $dbh->do('RESET SLAVE'); # Wipes out master.info, etc etc
   return $stat;
}

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 $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 pos_to_string {
   my ( $self, $pos ) = @_;
   my $fmt  = '%s/%020d';
   return sprintf($fmt, @{$pos}{qw(file position)});
}

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
# ###########################################################################

# ###########################################################################
# Daemon package 3976
# ###########################################################################

package Daemon;

use strict;
use warnings FATAL => 'all';

use POSIX qw(setsid);
use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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->{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();

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

   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";
   }

   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->{rm_PID_file} = 1;
   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->{child} || $self->{rm_PID_file};
   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
# ###########################################################################

# ###########################################################################
# 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 mk_table_sync;

# TODO
# * make it more efficient.  Ideas: profile the Perl, use prepared statements,
#   don't use Perl to quote values, use arrays instead of hashes.
# * Add back top-down, bottom-up, sja algorithms for efficiency when locking
#   isn't an issue.

use English qw(-no_match_vars);
use List::Util qw(sum max min);
use POSIX qw(ceil);

use constant MKDEBUG => $ENV{MKDEBUG};

$OUTPUT_AUTOFLUSH = 1;

sub main {
   @ARGV = @_;  # set global ARGV for this package

   # ########################################################################
   # Get configuration information.
   # ########################################################################
   my $dp = new DSNParser(
      {
         key  => 'D',
         desc => 'Database containing the table to be synced',
         dsn  => 'database',
         copy => 1,
      },
      {
         key  => 't',
         desc => 'Table to be synced',
         dsn  => undef,
         copy => 1,
      },
   );

   my $o = new OptionParser(
      dp          => $dp,
      strict      => 0,
      prompt      => '[OPTION]... DSN [DSN]...',
      description => 'synchronizes data efficiently between MySQL tables.',
   );
   $o->get_specs();
   $o->get_opts();

   $dp->prop('setvars', $o->get('set-vars'));

   if ( $o->get('replicate') || $o->get('sync-to-master') ) {
      $o->set('wait', 60) unless $o->got('wait');
   }
   if ( $o->get('wait') ) {
      $o->set('lock', 1) unless $o->got('lock');
   }
   if ( $o->get('dry-run') ) {
      $o->set('verbose', 1);
   }

   my @dsns;
   while ( my $arg = shift(@ARGV) ) {
      if ( $o->get('utf8') ) {
         $arg .= ',A=utf8';
      }
      my $dsn = $dp->parse($arg, $dsns[0]);
      die "You specified a t part, but not a D part in $arg"
         if ($dsn->{t} && !$dsn->{D});
      if ( $dsn->{D} && !$dsn->{t} ) {
         die "You specified a database but not a table in $arg.  Are you "
            . "trying to sync only tables in the '$dsn->{D}' database?  "
            . "If so, use '--databases $dsn->{D}' instead.\n";
      }
      push @dsns, $dsn;
   }

   if ( !@dsns
        || (@dsns ==1 && !$o->get('replicate') && !$o->get('sync-to-master'))) {
      $o->save_error('At least one DSN is required, and at least two are '
         . 'required unless --sync-to-master or --replicate is specified');
   }

   if ( $o->get('lock-and-rename') ) {
      if ( @dsns != 2 || !$dsns[0]->{t} || !$dsns[1]->{t} ) {
         $o->save_error("--lock-and-rename requires exactly two DSNs and they "
            . "must each specify a table.");
      }
   }

   if ( $o->get('explain-hosts') ) {
      foreach my $host ( @dsns ) {
         print "# DSN: ", $dp->as_string($host), "\n";
      }
      return 0;
   }

   $o->usage_or_errors();

   # ########################################################################
   # If --pid, check it first since we'll die if it already exits.
   # ########################################################################
   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();
   }

   # ########################################################################
   # Do the work.
   # ########################################################################
   my $du        = new MySQLDump();
   my $tp        = new TableParser();
   my $q         = new Quoter();
   my $vp        = new VersionParser();
   my $chunker   = new TableChunker( quoter => $q );
   my $nibbler   = new TableNibbler();
   my $checksum  = new TableChecksum();
   my $ms        = new MasterSlave();
   my $syncer    = new TableSyncer();
   my %common_modules = (
      o        => $o,
      dp       => $dp,
      du       => $du,
      tp       => $tp,
      q        => $q,
      vp       => $vp,
      chunker  => $chunker,
      nibbler  => $nibbler,
      checksum => $checksum,
      ms       => $ms,
      syncer   => $syncer,
   );

   my $hdr = "# %6s %7s %6s %6s %-9s %s.%s\n";
   my %output_formats = (
      hdr => $hdr,
   );

   my $exit_status = 0; # 1: internal error, 2: tables differed, 3: both

   if ( $o->get('lock-and-rename') ) {
      MKDEBUG && _d('Locking and syncing ONE TABLE with rename');
      $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
      $dsns[1]->{dbh} = get_cxn($dsns[1], %common_modules);

      if ( !$o->get('with-triggers') ) {
         check_tables_for_triggers(
            [ @dsns[1 .. $#dsns] ],
            [ { db => $dsns[0]->{D}, tbl => $dsns[0]->{t} } ],
            %common_modules,
         );
      }

      if ( $o->get('verbose') ) {
         print "# Lock and rename ", $dp->as_string($dsns[0]), "\n";
         printf($hdr, @ChangeHandler::ACTIONS, qw(ALGORITHM DATABASE TABLE));
      }

      my %src_and_dst = (
         src => $dsns[0],
         dst => $dsns[1],
      );

      # We don't use lock_server() here because it does the usual stuff wrt
      # waiting for slaves to catch up to master, etc, etc.
      my $src_db_tbl = $q->quote(@{$dsns[0]}{qw(D t)});
      my $dst_db_tbl = $q->quote(@{$dsns[1]}{qw(D t)});
      my $tmp_db_tbl = $q->quote($dsns[0]->{D}, $dsns[0]->{t} . "_tmp_$PID");
      my $sql = "LOCK TABLES $src_db_tbl WRITE";
      MKDEBUG && _d($sql);
      $dsns[0]->{dbh}->do($sql);
      $sql = "LOCK TABLES $dst_db_tbl WRITE";
      MKDEBUG && _d($sql);
      $dsns[1]->{dbh}->do($sql);

      $exit_status = sync_a_table(
         %src_and_dst,
         lock       => 0,
         src_db     => $dsns[0]->{D},
         src_tbl    => $dsns[0]->{t},
         dst_db     => $dsns[1]->{D},
         dst_tbl    => $dsns[1]->{t},
         where      => $o->get('where'),
         index_hint => !$o->get('no-use-index'),
         %common_modules,
         %output_formats,
      );

      # Now rename the tables to swap them.
      $sql = "ALTER TABLE $src_db_tbl RENAME $tmp_db_tbl";
      MKDEBUG && _d($sql);
      $dsns[0]->{dbh}->do($sql);
      $sql = "ALTER TABLE $dst_db_tbl RENAME $src_db_tbl";
      MKDEBUG && _d($sql);
      $dsns[1]->{dbh}->do($sql);
      $sql = "UNLOCK TABLES";
      MKDEBUG && _d($sql);
      $dsns[0]->{dbh}->do($sql);
      $sql = "ALTER TABLE $tmp_db_tbl RENAME $dst_db_tbl";
      MKDEBUG && _d($sql);
      $dsns[0]->{dbh}->do($sql);

      unlock_server(%src_and_dst, %common_modules);
   }
   elsif ( $dsns[0]->{t} ) {
      MKDEBUG && _d('DSN has t part; syncing ONE TABLE between servers');
      if ( @dsns == 1 ) {
         die "You specified one DSN with a t part, but not --sync-to-master"
            unless $o->get('sync-to-master');
         $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
         my $master = $ms->get_master_dsn(
            $dsns[0]->{dbh},
            $dsns[0],
            $dp
         ) or die "Can't determine master of ". $dp->as_string($dsns[0]);
         unshift @dsns, $master;
         $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
         $ms->is_master_of($dsns[0]->{dbh}, $dsns[1]->{dbh});
      }

      if ( $dsns[0]->{t} ne $dsns[1]->{t}
           && -t STDIN
           && -t STDOUT
           && ( (($dsns[0]->{h} || '') ne ($dsns[1]->{h} || ''))
                || (($dsns[0]->{P} || '') ne ($dsns[1]->{P} || '')) ))
      {
         print "Continue syncing tables with different names?  y/n: ";
         my $answer = <STDIN>;
         if ( $answer !~ m/y/i ) {
            return 1;
         }
      }

      if ( !$o->get('with-triggers') ) {
         check_tables_for_triggers(
            [ @dsns[1 .. $#dsns] ],
            [ { db => $dsns[0]->{D}, tbl => $dsns[0]->{t} } ],
            %common_modules,
         );
      }

      foreach my $dsn ( @dsns[1 .. $#dsns] ) {

         if ( $o->get('verbose') ) {
            print "# Syncing ", $dp->as_string($dsn), "\n";
            printf($hdr, @ChangeHandler::ACTIONS, qw(ALGORITHM DATABASE TABLE));
         }

         my %src_and_dst = (
            src => $dsns[0],
            dst => $dsn,
         );

         lock_server(%src_and_dst, %common_modules);

         $exit_status = sync_a_table(
            %src_and_dst,
            src_db     => $dsns[0]->{D},
            src_tbl    => $dsns[0]->{t},
            dst_db     => $dsn->{D},
            dst_tbl    => $dsn->{t},
            where      => $o->get('where'),
            index_hint => !$o->get('no-use-index'),
            %common_modules,
            %output_formats,
         );

         unlock_server(%src_and_dst, %common_modules);
      }
   }
   elsif ( $o->get('replicate') ) {

      if ( @dsns > 1 ) {
         die "You should specify only one DSN with --replicate\n";
      }

      # Connect to the master and treat it as the source, then find
      # differences on the slave and sync them.
      if ( $o->get('sync-to-master') ) {

         $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
         my $master = $ms->get_master_dsn($dsns[0]->{dbh},
            $dsns[0], $dp)
            or die "Can't determine master of "
               . $dp->as_string($dsns[0]);
         unshift @dsns, $master;
         $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
         $ms->is_master_of($dsns[0]->{dbh}, $dsns[1]->{dbh});

         my %src_and_dst = (
            src => $dsns[0],
            dst => $dsns[1],
         );

         # First, check that the master (source) has no discrepancies itself,
         # and ignore tables that do.
         my %skip_table;
         foreach my $diff (
            $checksum->find_replication_differences($dsns[0]->{dbh}, $o->get('replicate')) )
         {
            $skip_table{$diff->{db}}->{$diff->{tbl}}++;
         }

         # Now check the slave for differences and sync them if necessary.
         my @diffs = $checksum
            ->find_replication_differences($dsns[1]->{dbh}, $o->get('replicate'));
         @diffs = grep { !$skip_table{$_->{db}}->{$_->{tbl}} } @diffs;
         if ( $o->get('verbose') ) {
            print "# Syncing ", $dp->as_string($dsns[1]), "\n";
            printf($hdr, @ChangeHandler::ACTIONS, qw(ALGORITHM DATABASE TABLE));
         }

         if ( @diffs ) {

            if ( !$o->get('with-triggers') ) {
               # Turn @diffs into an array of hashes having keys db and tbl
               my @dbs_tbls = map +{ db => $_->{db}, tbl => $_->{tbl} }, @diffs;
               check_tables_for_triggers(
                  [$src_and_dst{dst}],
                  \@dbs_tbls,
                  %common_modules
               );
            }

            lock_server(%src_and_dst, %common_modules);
            foreach my $diff ( @diffs ) {
               next unless tbl_permitted($diff->{db}, $diff->{tbl}, o=>$o);

               $exit_status = sync_a_table(
                  %src_and_dst,
                  src_db     => $diff->{db},
                  src_tbl    => $diff->{tbl},
                  dst_db     => $diff->{db},
                  dst_tbl    => $diff->{tbl},
                  where      => $diff->{boundaries},
                  index_hint => !$o->get('no-use-index'),
                  %common_modules,
                  %output_formats,
               );

            }
            unlock_server(%src_and_dst, %common_modules);
         }
      }

      # The DSN is the master.  Connect to each slave and find differences, then
      # sync them.
      else {
         my %skip_table;
         $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
         $ms->recurse_to_slaves(
            {  dbh        => $dsns[0]->{dbh},
               dsn        => $dsns[0],
               dsn_parser => $dp,
               recurse    => 1,
               callback   => sub {
                  my ( $dsn, $dbh, $level, $parent ) = @_;
                  my @diffs = $checksum
                     ->find_replication_differences($dbh, $o->get('replicate'));
                  if ( !$level ) {
                     # This is the master; don't sync any tables that are wrong
                     # here, for obvious reasons.
                     map { $skip_table{$_->{db}}->{$_->{tbl}}++ } @diffs;
                  }
                  else {
                     # Save a reference to the DBH to close gracefully later.
                     $dsn->{dbh} ||= $dbh;
                     push @dsns, $dsn;
                     @diffs = grep { !$skip_table{$_->{db}}->{$_->{tbl}} } @diffs;
                     return unless @diffs;
                     if ( $o->get('verbose') ) {
                        print "# Syncing ", $dp->as_string($dsn), "\n";
                        printf($hdr, @ChangeHandler::ACTIONS,
                           qw(ALGORITHM DATABASE TABLE));
                     }
                     my %src_and_dst = (
                        src     => $dsns[0],
                        dst     => $dsn,
                     );
                     if ( !$o->get('with-triggers') ) {
                        # Turn @diffs into an array of hashes
                        # having keys db and tbl
                        my @dbs_tbls
                           = map +{ db => $_->{db}, tbl => $_->{tbl} }, @diffs;
                        check_tables_for_triggers(
                           [$src_and_dst{dst}],
                           \@dbs_tbls,
                           %common_modules
                        );
                     }
                     lock_server(%src_and_dst, %common_modules);
                     foreach my $diff ( @diffs ) {
                        next unless tbl_permitted($diff->{db}, $diff->{tbl}, o=>$o);

                        $exit_status = sync_a_table(
                           %src_and_dst,
                           src_db     => $diff->{db},
                           src_tbl    => $diff->{tbl},
                           dst_db     => $diff->{db},
                           dst_tbl    => $diff->{tbl},
                           where      => $diff->{boundaries},
                           index_hint => !$o->get('no-use-index'),
                           %common_modules,
                           %output_formats,
                        );

                     }
                     unlock_server(%src_and_dst, %common_modules);
                  }
               },
            }
         );
      }

   }
   else {
      $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);

      if ( @dsns == 1 ) {
         if ( $o->get('sync-to-master') ) {
            my $master = $ms->get_master_dsn($dsns[0]->{dbh},
               $dsns[0], $dp)
               or die "Can't determine master of "
                  . $dp->as_string($dsns[0]);
            unshift @dsns, $master;
            $dsns[0]->{dbh} = get_cxn($dsns[0], %common_modules);
            $ms->is_master_of($dsns[0]->{dbh}, $dsns[1]->{dbh});
         }
         else {
            die "You specified only one DSN, "
               . "but not --sync-to-master or --replicate.\n";
         }
      }

      my $finder = new MySQLFind(
         quoter    => $q,
         useddl    => 1,
         parser    => $tp,
         dumper    => $du,
         databases => {
            permit => $o->get('databases'),
            reject => $o->get('ignore-databases'),
         },
         tables => {
            permit => $o->get('tables'),
            reject => $o->get('ignore-tables'),
         },
         engines => {
            views  => 0,
            permit => $o->get('engines'),
            reject => $o->get('ignore-engines'),
         },
      );

      # Find all dbs.tbls on source DSN
      my @dbs_tbls;
      foreach my $db ( $finder->find_databases($dsns[0]->{dbh}) ) {
         foreach my $tbl ( $finder->find_tables($dsns[0]->{dbh},
                                                database => $db) ) {
            push @dbs_tbls, { db => $db, tbl => $tbl };
         }
      }

      if ( !$o->get('with-triggers') ) {
         check_tables_for_triggers(
            [ @dsns[1 .. $#dsns] ],
            \@dbs_tbls,
            %common_modules
         );
      }

      foreach my $dsn ( @dsns[1 .. $#dsns] ) {

         if ( $o->get('verbose') ) {
            print "# Syncing ", $dp->as_string($dsn), "\n";
            printf($hdr, @ChangeHandler::ACTIONS, qw(ALGORITHM DATABASE TABLE));
         }

         my %src_and_dst = (
            src     => $dsns[0],
            dst     => $dsn,
         );

         lock_server(%src_and_dst, %common_modules);
         foreach my $db_tbl ( @dbs_tbls ) {

            $exit_status = sync_a_table(
               %src_and_dst,
               src_db     => $db_tbl->{db},
               src_tbl    => $db_tbl->{tbl},
               dst_db     => $db_tbl->{db},
               dst_tbl    => $db_tbl->{tbl},
               where      => $o->get('where'),
               index_hint => !$o->get('no-use-index'),
               %common_modules,
               %output_formats,
            );

         }
         unlock_server(%src_and_dst, %common_modules);
      }
   }

   foreach my $dsn ( @dsns ) {
      foreach my $thing ( qw(dbh misc_dbh) ) {
         my $dbh = $dsn->{$thing};
         next unless $dbh;
         $dbh->commit() unless $dbh->{AutoCommit};
         $dp->disconnect($dbh);
      }
   }

   return $exit_status;
}

# ############################################################################
# Subroutines
# ############################################################################
sub lock_server {
   my ( %args ) = @_;
   foreach my $arg ( qw(src dst o dp syncer) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   eval {
      # Open connections as needed.
      $args{src}->{dbh}      ||= get_cxn($args{src}, %args);
      $args{dst}->{dbh}      ||= get_cxn($args{dst}, %args);
      $args{src}->{misc_dbh} ||= get_cxn($args{src}, %args);
      $args{syncer}->lock_and_wait(%args, lock_level => 3);
   }
}

sub unlock_server {
   my ( %args ) = @_;
   foreach my $arg ( qw(src dst o dp syncer) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   eval {
      # Open connections as needed.
      $args{src}->{dbh}      ||= get_cxn($args{src}, %args);
      $args{dst}->{dbh}      ||= get_cxn($args{dst}, %args);
      $args{src}->{misc_dbh} ||= get_cxn($args{src}, %args);
      $args{syncer}->unlock(%args, lock_level => 3);
   }
}

# This is the primary subroutine which actually makes the table syncs
# happen by calling $syncer->sync_table().  It is, therefore, a big
# wrapper around $syncer->sync_table(); it does pre- and post-sync
# stuff.  It returns an exit status; see EXIT STATUS in the POD.
sub sync_a_table {
   my ( %args ) = @_;
   foreach my $arg ( qw(src src_db src_tbl dst dst_db dst_tbl o dp q
                        du tp syncer checksum chunker nibbler ms hdr) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $o      = $args{o};
   my $q      = $args{q};
   my $du     = $args{du};
   my $tp     = $args{tp};
   my $syncer = $args{syncer};

   my $exit_status = 0; 

   eval {
      # Open connections as needed.
      $args{src}->{dbh}      ||= get_cxn($args{src}, %args);
      $args{dst}->{dbh}      ||= get_cxn($args{dst}, %args);
      $args{src}->{misc_dbh} ||= get_cxn($args{src}, %args);

      my @dbhs = ($args{src}->{dbh}, $args{dst}->{dbh}, $args{src}->{misc_dbh});

      # Disable auto-increment on zero (bug #1919897).
      my $no_auto_val_sql = '/*!40101 SET @@SQL_MODE := CONCAT(@@SQL_MODE, '
         . '",NO_AUTO_VALUE_ON_ZERO")*/';
      foreach my $dbh ( @dbhs ) {
         MKDEBUG && _d($dbh, $no_auto_val_sql);
         $dbh->do($no_auto_val_sql);
      }

      my $tbl_struct = $tp->parse(
         $du->get_create_table($args{src}->{dbh}, $q, @args{qw(src_db src_tbl)}));
      my @possible_keys = $tp->find_possible_keys(
         $args{src}->{dbh}, @args{qw(src_db src_tbl)}, $q, $o->get('where'));

      # If the table is InnoDB, prefer to sync it with transactions, unless
      # the user explicitly said not to.
      my $use_txn = $o->got('transaction')            ? $o->get('transaction')
                  : $tbl_struct->{engine} eq 'InnoDB' ? 1
                  :                                     0;

      # If we're using transactions, turn on AutoCommit on the handles.
      foreach my $dbh ( @dbhs ) {
         $dbh->{AutoCommit} = !$use_txn;
      }

      # Determine which columns to compare.
      my $ignore_columns  = $o->get('ignore-columns');
      my @compare_columns = grep {
         !$ignore_columns->{lc $_};
      } @{$o->get('columns') || $tbl_struct->{cols}};

      my %status = $syncer->sync_table(
         algorithm     => $o->get('algorithm') || '',
         buffer        => $o->get('buffer-results')  || 0,
         bufferinmysql => $o->get('buffer-in-mysql') || 0,
         checksum      => $args{checksum},
         chunker       => $args{chunker},
         chunksize     => $o->get('chunk-size'),
         cols          => \@compare_columns,
         dst_db        => $args{dst_db},
         dst_dbh       => $args{dst}->{dbh},
         dst_tbl       => $args{dst_tbl},
         dumper        => $du,
         execute       => $o->get('execute') || 0,
         index_hint    => $args{index_hint},
         lock          => $o->get('lock') || 0,
         misc_dbh      => $args{src}->{misc_dbh},
         nibbler       => $args{nibbler},
         possible_keys => \@possible_keys,
         parser        => $tp,
         print         => $o->get('print') || 0,
         quoter        => $q,
         replace       => $o->get('replace') || 0,
         replicate     => ($o->get('replicate') || $o->get('sync-to-master'))
                          || 0,
         transaction   => $use_txn,
         src_db        => $args{src_db},
         src_dbh       => $args{src}->{dbh},
         src_tbl       => $args{src_tbl},
         test          => $o->get('dry-run') || 0,
         tbl_struct    => $tbl_struct,
         timeoutok     => $o->get('timeout-ok') || 0,
         trim          => $o->get('trim') || 0,
         versionparser => $args{vp},
         wait          => $o->get('wait') || 0,
         where         => $args{where} || '',
         master_slave  => $args{ms},
         func          => $o->get('function') || '',
         skipslavecheck=> ($o->get('slave-check') ? 0 : 1),
      );

      if ( $o->get('verbose') ) {
         printf($args{hdr},
            @status{@ChangeHandler::ACTIONS, 'ALGORITHM'},
            @args{qw(src_db src_tbl)});
      }

      if ( sum(@status{@ChangeHandler::ACTIONS}) ) {
         $exit_status |= 2;
      }
   };

   if ( $EVAL_ERROR ) {
      print_err($EVAL_ERROR, @args{qw(dst_db dst_tbl)}, $args{dst_dsn}->{h} );
      $exit_status |= 1;
   }

   return $exit_status;
}

# Tries to extract the MySQL error message and print it
sub print_err {
   my ( $msg, $database, $table, $host ) = @_;
   return if !defined $msg;
   $msg =~ s/^.*?failed: (.*?) at \S+ line (\d+).*$/$1 at line $2/s;
   $msg =~ s/\s+/ /g;
   if ( $database && $table ) {
      $msg .= " while doing $database.$table";
   }
   if ( $host ) {
      $msg .= " on $host";
   }
   print STDERR $msg, "\n";
}

sub get_cxn {
   my ( $dsn, %args ) = @_;
   foreach my $arg ( qw(o dp) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $dp  = $args{dp};
   my $o   = $args{o};

   my $db_options = {};  # TODO: is this used for something?

   if ( !$dsn->{p} && $o->get('ask-pass') ) {
      $dsn->{p} = OptionParser::prompt_noecho("Enter password for $dsn->{h}: ");
   }
   my $dbh = $dp->get_dbh(
      $dp->get_cxn_params($dsn), $db_options);
   my $sql;
   if ( $o->get('bin-log') == 0 ) {
      $sql = "/*!32316 SET SQL_LOG_BIN=0 */";
      MKDEBUG && _d($dbh, $sql);
      $dbh->do($sql);
   }
   if ( $o->get('unique-checks') == 0 ) {
      $sql = "/*!40014 SET UNIQUE_CHECKS=0 */";
      MKDEBUG && _d($dbh, $sql);
      $dbh->do($sql);
   }
   if ( $o->get('foreign-key-checks') == 0 ) {
      $sql = "/*!40014 SET FOREIGN_KEY_CHECKS=0 */";
      MKDEBUG && _d($dbh, $sql);
      $dbh->do($sql);
   }
   return $dbh;
}

# Dies if any table in $dbs_tbls on any DSN in $dsns has triggers
# defined on it.
# $dsns is an array ref to a list of DSNs.
# $dbs_tbls is an array ref to a list of hashes containing a db and tbl key.
sub check_tables_for_triggers {
   my ( $dsns, $dbs_tbls, %args ) = @_;
   foreach my $arg ( qw(o dp q du) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $du = $args{du};
   my $dp = $args{dp};

   foreach my $dsn ( @$dsns ) {
      my %missing_db;
      my $dbh = get_cxn($dsn, %args);

      DB_TBL:
      foreach my $db_tbl ( @$dbs_tbls ) {
         if ( $missing_db{ $db_tbl->{db} } ) {
            MKDEBUG && _d('Skipping trigger check on',
               $db_tbl->{db}, '.', $db_tbl->{tbl},
               'host', $dsn->{h}, ':', $dsn->{P},
               'because the db does not exist');
            next DB_TBL;
         }

         # Check that database exists on destination.
         eval { $dbh->do("USE `$db_tbl->{db}`"); };
         if ( $EVAL_ERROR ) {
            if ( $EVAL_ERROR =~ m/Unknown database/ ) {
               warn "Database $db_tbl->{db} does not exist on "
                  . $dp->as_string($dsn);
               $missing_db{ $db_tbl->{db} } = 1;
               next DB_TBL;
            }
            else {
               print_err($EVAL_ERROR, $db_tbl->{db}, $db_tbl->{tbl}, $dsn->{h});
               next DB_TBL;
            }
         }

         # If table exists on destination, check it for triggers.
         my $create;
         eval {
            $create = $du->get_create_table($dbh, $args{q},
                                            $db_tbl->{db}, $db_tbl->{tbl});
         };
         if ( ref $create eq 'ARRAY' ) {
            # TODO: this is a fugly hack that must die.
            # MySQLDump.pm is really fscked up.  MUST FIX.
            my $triggers = $du->get_triggers($dbh, $args{q},
                                             $db_tbl->{db}, $db_tbl->{tbl});
            if ( $triggers) {
               $dbh->disconnect();
               die "Cannot write to table with triggers: "
                  . "$db_tbl->{db}.$db_tbl->{tbl}.\n"
                  . "Use --with-triggers to allow writing to "
                  . "tables with triggers.\n";
            }
         }
         else {
            warn "$db_tbl->{db}.$db_tbl->{tbl} does not exist on "
               . $dp->as_string($dsn);
         }
      }
      $dbh->disconnect();
   }

   return;
}

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

   # Any tbl is permitted if --tables wasn't given.
   return 1 if !$o->got('tables'); 
   
   # Exact match: --tables has qualified db.tbl names.
   return 1 if $o->get('tables')->{"$db.$tbl"};

   # Try to match tbl for any db.
   return 1 if $o->get('tables')->{$tbl};

   # Else, table is not permitted.
   MKDEBUG && _d('Table not permitted by --tables:', $db, $tbl);
   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";
}

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

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

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

=head1 NAME

mk-table-sync - Synchronize MySQL tables efficiently.

=head1 SYNOPSIS

B<WARNING>: back up your data before you use this tool.

It is a good idea to B<back up your data> and run C<mk-table-sync> with
L<"--dry-run"> to see what will happen.  If you want to see which rows
are different, without changing any data, use L<"--print"> instead of
L<"--execute">.

To sync db.tbl1 from host1 to host2:

   mk-table-sync --execute u=user,p=pass,h=host1,D=db,t=tbl host2

Sync all tables in host1 to host2 and host3:

   mk-table-sync --execute host1 host2 host3

Resolve differences L<mk-table-checksum> found on this master's slaves:

   mk-table-sync --execute --replicate test.checksum master1

Make slave1 have the same data as its replication master:

   mk-table-sync --execute --sync-to-master slave1

Ditto, resolving differences L<mk-table-checksum> found:

   mk-table-sync --execute --sync-to-master --replicate test.checksum slave1

Sync server2 in a master-master replication configuration, where server2's copy
of db1.tbl1 is known or suspected to be incorrect:

   mk-table-sync --execute --sync-to-master h=server2,D=db1,t=tbl1

Note that in the master-master configuration, the following will NOT do what you
want, because it will make changes directly on server2, which will then flow
through replication and change server1's data:

   # Don't do this in a master-master setup!
   mk-table-sync --execute h=server1,D=db1,t=tbl1 h=server2

=head1 DESCRIPTION

B<WARNING> this tool is unfinished and could perform slowly.  The Chunk
algorithm is great when it can be used, and so is Nibble, but otherwise GroupBy
is the default choice and it may not perform very well.  Please run with
L<"--dry-run"> before subjecting your servers to this tool, and make backups of
your data!

This tool is designed to do one-way synchronization of data (two-way sync is
planned for the future).  It finds differences efficiently with one of several
algorithms (see L<"ALGORITHMS">).  It makes changes on the destination table(s)
so it matches the source.

It does B<not> synchronize table structures, indexes, or any other schema
changes.  It synchronizes only data.

It can operate through replication by comparing a slave with its master and
making changes on the master.  These changes will flow through replication and
correct any differences found on the slave.

It accepts a list of DSNs (see the L<"--help"> output) to tell it where and how
to connect.

There are many ways to invoke it.  The following is the abbreviated logic:

   if DSN has a t part, sync only that table:
      if 1 DSN:
         if --sync-to-master:
            The DSN is a slave.  Connect to its master and sync.
      if more than 1 DSN:
         The first DSN is the source.  Sync each DSN in turn.
   else if --replicate:
      if --sync-to-master:
         The DSN is a slave.  Connect to its master, find records
         of differences, and fix.
      else:
         The DSN is the master.  Find slaves and connect to each,
         find records of differences, and fix.
   else:
      if only 1 DSN and --sync-to-master:
         The DSN is a slave.  Connect to its master, find tables and
         filter with --databases etc, and sync each table to the master.
      else:
         find tables, filtering with --databases etc, and sync each
         DSN to the first.

If you're confused about how it the DSNs are interpreted, use the
L<"--explain-hosts"> option and it will tell you.

=head1 REPLICATION SAFETY

Synchronizing a replication master and slave safely is a non-trivial problem, in
general.  There are all sorts of issues to think about, such as other processes
changing data, trying to change data on the slave, whether the destination and
source are a master-master pair, and much more.

In general, the safe way to do it is to change the data on the master, and let
the changes flow through replication to the slave like any other changes.
However, this works only if it's possible to REPLACE into the table on the
master.  REPLACE works only if there's a unique index on the table (otherwise it
just acts like an ordinary INSERT).

If your table has unique keys, you should use the L<"--sync-to-master"> and/or
L<"--replicate"> options to sync a slave to its master.  This will generally do
the right thing.  When there is no unique key on the table, there is no choice
but to change the data on the slave, and mk-table-sync will detect that you're
trying to do so.  It will complain and die unless you specify
C<--no-slave-check> (see L<"--[no]slave-check">).

If you're syncing a table without a primary or unique key on a master-master
pair, you must change the data on the destination server.  Therefore, you need
to specify C<--no-bin-log> for safety (see L<"--[no]bin-log">).  If you don't,
the changes you make on the destination server will replicate back to the
source server and change the data there!

The generally safe thing to do on a master-master pair is to use the
L<"--sync-to-master"> option so you don't change the data on the destination
server.  You will also need to specify C<--no-slave-check> to keep
mk-table-sync from complaining that it is changing data on a slave.

=head1 ALGORITHMS

This tool has a generic data-syncing framework, within which it is possible to
use any number of different algorithms to actually find differences.  It chooses
the best algorithm automatically.  While I plan to add more algorithms in the
future, the following are implemented now:

=over

=item Chunk

Finds an index whose first column is numeric (including date and time types),
and divides the column's range of values into chunks of approximately
L<"--chunk-size"> rows.  Syncs a chunk at a time by checksumming the entire
chunk.  If the chunk differs on the source and destination, checksums each
chunk's rows individually to find the rows that differ.

It is efficient when the column has sufficient cardinality to make the chunks
end up about the right size.

The initial per-chunk checksum is quite small and results in minimal network
traffic and memory consumption.  If a chunk's rows must be examined, only the
primary key columns and a checksum are sent over the network, not the entire
row.  If a row is found to be different, the entire row will be fetched, but not
before.

=item Nibble

Finds an index and ascends the index in fixed-size nibbles of L<"--chunk-size">
rows, using a non-backtracking algorithm (see L<mk-archiver> for more on this
algorithm).  It is very similar to L<"Chunk">, but instead of pre-calculating
the boundaries of each piece of the table based on index cardinality, it uses
C<LIMIT> to define each nibble's upper limit, and the previous nibble's upper
limit to define the lower limit.

It works in steps: one query finds the row that will define the next nibble's
upper boundary, and the next query checksums the entire nibble.  If the nibble
differs between the source and destination, it examines the nibble row-by-row,
just as L<"Chunk"> does.

=item GroupBy

Selects the entire table grouped by all columns, with a COUNT(*) column added.
Compares all columns, and if they're the same, compares the COUNT(*) column's
value to determine how many rows to insert or delete into the destination.
Works on tables with no primary key or unique index.

=item Stream

Selects the entire table in one big stream and compares all columns.  Selects
all columns.  Much less efficient than the other algorithms, but works when
there is no suitable index for them to use.

=item Future Plans

Possibilities for future algorithms are TempTable (what I originally called
bottom-up in earlier versions of this tool), DrillDown (what I originallly
called top-down), and GroupByPrefix (similar to how SqlYOG Job Agent works).
Each algorithm has strengths and weaknesses.  If you'd like to implement your
favorite technique for finding differences between two sources of data on
possibly different servers, I'm willing to help.  The algorithms adhere to a
simple interface that makes it pretty easy to write your own.

=back

=head1 DOWNLOADING

You can download Maatkit from Google Code at
L<http://code.google.com/p/maatkit/>, or you can get any of the tools
easily with a command like the following:

   wget http://www.maatkit.org/get/toolname
   or
   wget http://www.maatkit.org/trunk/toolname

Where C<toolname> can be replaced with the name (or fragment of a name) of any
of the Maatkit tools.  Once downloaded, they're ready to run; no installation is
needed.  The first URL gets the latest released version of the tool, and the
second gets the latest trunk code from Subversion.

=head1 OPTIONS

Specify at least one of L<"--print">, L<"--execute">, or L<"--dry-run">.

L<"--where"> and L<"--replicate"> are mutually exclusive.

=over

=item --algorithm

type: string

The algorithm to use when comparing the tables.

This is a suggestion.  The tool will auto-detect the best algorithm, and if your
chosen algorithm can't be used, will use the best available one instead.  See
L<"ALGORITHMS">.

=item --ask-pass

Prompt for a password when connecting to MySQL.

=item --[no]bin-log

default: yes

Log to the binary log (C<SET SQL_LOG_BIN=1>).

Specifying C<--no-bin-log> will C<SET SQL_LOG_BIN=0>.

=item --buffer-in-mysql

Instruct MySQL to buffer queries in its memory.

This option adds the C<SQL_BUFFER_RESULT> option to the comparison queries.
This causes MySQL to execute the queries and place them in a temporary table
internally before sending the results back to mk-table-sync.  The advantage of
this strategy is that mk-table-sync can fetch rows as desired without using a
lot of memory inside the Perl process, while releasing locks on the MySQL table
(to reduce contention with other queries).  The disadvantage is that it uses
more memory on the MySQL server instead.

You probably want to enable L<"--buffer-results"> too, because buffering into
a temp table and then fetching it all into Perl's memory is probably a silly
thing to do.  This option is most useful for the GroupBy and Stream algorithms,
which may fetch a lot of data from the server.

=item --buffer-results

Fetch all rows from MySQL before comparing.

This is disabled by default.  If enabled, all rows will be fetched into memory
for comparing.  This may result in the results "cursor" being held open for a
shorter time on the server, but if the tables are large, it could take a long
time anyway, and eat all your memory.  For most non-trivial data sizes, you
want to leave this disabled.

=item --chunk-size

type: string; default: 1000

Number of rows or data size per chunk.

The size of each chunk of rows for the L<"Chunk"> and L<"Nibble"> algorithms.
The size can be either a number of rows, or a data size.  Data sizes are
specified with a suffix of k=kibibytes, M=mebibytes, G=gibibytes.  Data sizes
are converted to a number of rows by dividing by the average row length.

=item --columns

short form: -c; type: array

Compare this comma-separated list of columns.

=item --config

type: Array

Read this comma-separated list of config files; if specified, this must be the
first option on the command line.

=item --databases

short form: -d; type: hash

Sync only this comma-separated list of databases.

A common request is to sync tables from one database with tables from another
database on the same or different server.  This is not yet possible.
L<"--databases"> will not do it, and you can't do it with the D part of the DSN
either because in the absence of a table name it assumes the whole server
should be synced and the D part controls only the connection's default database.

=item --dry-run

Analyze, decide the sync algorithm to use, print and exit.

Implies L<"--verbose"> so you can see the results.  The results are in the same
output format that you'll see from actually running the tool, but there will be
zeros for rows affected.  This is because the tool actually executes, but stops
before it compares any data and just returns zeros.  The zeros do not mean there
are no changes to be made.

=item --engines

short form: -e; type: hash

Sync only this comma-separated list of storage engines.

=item --execute

Execute queries to make the tables have identical data.

This option makes mk-table-sync actually sync table data by executing all
the queries that it created to resolve table differences.  Therefore, B<the
tables will be changed!>  And unless you also specify L<"--verbose">, the
changes will be made silently.  If this is not what you want, see
L<"--print"> or L<"--dry-run">.

=item --explain-hosts

Print connection information and exit.

Print out a list of hosts to which mk-table-sync will connect, with all
the various connection options, and exit.

=item --[no]foreign-key-checks

default: yes

Enable foreign key checks (C<SET FOREIGN_KEY_CHECKS=1>).

Specifying C<--no-foreign-key-checks> will C<SET FOREIGN_KEY_CHECKS=0>.

=item --function

type: string

Which hash function you'd like to use for checksums.

The default is C<CRC32>.  Other good choices include C<MD5> and C<SHA1>.  If you
have installed the C<FNV_64> user-defined function, C<mk-table-sync> will detect
it and prefer to use it, because it is much faster than the built-ins.  You can
also use MURMUR_HASH if you've installed that user-defined function.  Both of
these are distributed with Maatkit.  See L<mk-table-checksum> for more
information and benchmarks.

=item --help

Show help and exit.

=item --ignore-columns

type: Hash

Ignore this comma-separated list of column names in comparisons.

This option causes columns not to be compared.  However, if a row is determined
to differ between tables, all columns in that row will be synced, regardless.
(It is not currently possible to exclude columns from the sync process itself,
only from the comparison.)

=item --ignore-databases

type: Hash

Ignore this comma-separated list of databases.

=item --ignore-engines

type: Hash; default: FEDERATED,MRG_MyISAM

Ignore this comma-separated list of storage engines.

=item --ignore-tables

type: Hash

Ignore this comma-separated list of tables.

Table names may be qualified with the database name.

=item --lock

type: int

Lock tables: 0=none, 1=per sync cycle, 2=per table, or 3=globally.

This uses C<LOCK TABLES>.  This can help prevent tables being changed while
you're examining them.  The possible values are as follows:

  VALUE  MEANING
  =====  =======================================================
  0      Never lock tables.
  1      Lock and unlock one time per sync cycle (as implemented
         by the syncing algorithm).  This is the most granular
         level of locking available.  For example, the Chunk
         algorithm will lock each chunk of C<N> rows, and then
         unlock them if they are the same on the source and the
         destination, before moving on to the next chunk.
  2      Lock and unlock before and after each table.
  3      Lock and unlock once for every server (DSN) synced, with
         C<FLUSH TABLES WITH READ LOCK>.

A replication slave is never locked if L<"--replicate"> or L<"--sync-to-master">
is specified, since in theory locking the table on the master should prevent any
changes from taking place.  (You are not changing data on your slave, right?)
If L<"--wait"> is given, the master (source) is locked and then the tool waits
for the slave to catch up to the master before continuing.

If C<--transaction> is specified, C<LOCK TABLES> is not used.  Instead, lock
and unlock are implemented by beginning and committing transactions.
The exception is if L<"--lock"> is 3.

If C<--no-transaction> is specified, then C<LOCK TABLES> is used for any
value of L<"--lock">. See L<"--[no]transaction">.

=item --lock-and-rename

Lock the source and destination table, sync, then swap names.  This is useful as
a less-blocking ALTER TABLE, once the tables are reasonably in sync with each
other (which you may choose to accomplish via any number of means, including
dump and reload or even something like L<mk-archiver>).  It requires exactly two
DSNs and assumes they are on the same server, so it does no waiting for
replication or the like.  Tables are locked with LOCK TABLES.

=item --no-use-index

Do not add USE INDEX hint to SQL statements for Chunk algorithm.

By default C<mk-table-sync> adds an USE INDEX hint to each SQL statement
for the Chunk algorithm to coerce MySQL into using the index for the column
by which a table will be chunked.  This option causes C<mk-table-sync> to
omit the USE INDEX hint.

The Nibble algorithm always uses a FORCE/USE INDEX hint.  The GroupBy and Stream
algorithms never use an index hint.

=item --pid

type: string

Create the given PID file when daemonized.  The file contains the process
ID of the daemonized instance.  The PID file is removed when the
daemonized instance exits.  The program checks for the existence of the
PID file when starting; if it exists and the process with the matching PID
exists, the program exits.

=item --print

Print queries that will resolve differences.

If you don't trust C<mk-table-sync>, or just want to see what it will do, this
is a good way to be safe.  These queries are valid SQL and you can run them
yourself if you want to sync the tables manually.

=item --replace

Write all C<INSERT> and C<UPDATE> statements as C<REPLACE>.

This is automatically switched on as needed when there are unique index
violations.

=item --replicate

type: string

Sync tables listed as different in this table.

Specifies that C<mk-table-sync> should examine the specified table to find data
that differs.  The table is exactly the same as the argument of the same name to
L<mk-table-checksum>.  That is, it contains records of which tables (and ranges
of values) differ between the master and slave.

For each table and range of values that shows differences between the master and
slave, C<mk-table-checksum> will sync that table, with the appropriate C<WHERE>
clause, to its master.

This automatically sets L<"--wait"> to 60 and causes changes to be made on the
master instead of the slave.

If L<"--sync-to-master"> is specified, the tool will assume the server you
specified is the slave, and connect to the master as usual to sync.

Otherwise, it will try to use C<SHOW PROCESSLIST> to find slaves of the server
you specified.  If it is unable to find any slaves via C<SHOW PROCESSLIST>, it
will inspect C<SHOW SLAVE HOSTS> instead.  You must configure each slave's
C<report-host>, C<report-port> and other options for this to work right.  After
finding slaves, it will inspect the specified table on each slave to find data
that needs to be synced, and sync it. 

The tool examines the master's copy of the table first, assuming that the master
is potentially a slave as well.  Any table that shows differences there will
B<NOT> be synced on the slave(s).  For example, suppose your replication is set
up as A->B, B->C, B->D.  Suppose you use this argument and specify server B.
The tool will examine server B's copy of the table.  If it looks like server B's
data in table C<test.tbl1> is different from server A's copy, the tool will not
sync that table on servers C and D.

=item --set-vars

type: string; default: wait_timeout=10000

Set these MySQL variables.  Immediately after connecting to MySQL, this
string will be appended to SET and executed.

=item --[no]slave-check

default: yes

Check whether the destination server is a slave.

If the destination server is a slave, it's generally unsafe to make changes on
it.  However, sometimes you have to; L<"--replace"> won't work unless there's a
unique index, for example, so you can't make changes on the master in that
scenario.  By default mk-table-sync will complain if you try to change data on
a slave.  Specify C<--no-slave-check> to disable this check.  Use it at your own
risk.

=item --sync-to-master

Treat the DSN as a slave and sync it to its master.

Treat the server you specified as a slave.  Inspect C<SHOW SLAVE STATUS>,
connect to the server's master, and treat the master as the source and the slave
as the destination.  Causes changes to be made on the master.  Sets L<"--wait">
to 60 by default, sets L<"--lock"> to 1 by default, and disables
L<"--[no]transaction"> by default.  See also L<"--replicate">, which changes
this option's behavior.

=item --tables

short form: -t; type: hash

Sync only this comma-separated list of tables.

Table names may be qualified with the database name.

=item --timeout-ok

Keep going if L<"--wait"> fails.

If you specify L<"--wait"> and the slave doesn't catch up to the master's
position before the wait times out, the default behavior is to abort.  This
option makes the tool keep going anyway.  B<Warning>: if you are trying to get a
consistent comparision between the two servers, you probably don't want to keep
going after a timeout.

=item --[no]transaction

Use transactions instead of C<LOCK TABLES>.

The granularity of beginning and committing transactions is controlled by
L<"--lock">.  This is enabled by default, but since L<"--lock"> is disabled by
default, it has no effect.

Most options that enable locking also disable transactions by default, so if
you want to use transactional locking (via C<LOCK IN SHARE MODE> and C<FOR
UPDATE>, you must specify C<--transaction> explicitly.

If you don't specify C<--transaction> explicitly C<mk-table-sync> will decide on
a per-table basis whether to use transactions or table locks.  It currently
uses transactions on InnoDB tables, and table locks on all others.

If C<--no-transaction> is specified, then C<mk-table-sync> will not use
transactions at all (not even for InnoDB tables) and locking is controlled
by L<"--lock">.

=item --trim

C<TRIM()> C<VARCHAR> columns in C<BIT_XOR> and C<ACCUM> modes.  Helps when
comparing MySQL 4.1 to >= 5.0.

This is useful when you don't care about the trailing space differences between
MySQL versions which 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.

=item --[no]unique-checks

default: yes

Enable unique key checks (C<SET UNIQUE_CHECKS=1>).

Specifying C<--no-unique-checks> will C<SET UNIQUE_CHECKS=0>.

=item --[no]utf8

default: yes

Enable UTF-8 options in Perl and MySQL.

This option is deprecated.  Pass the C<A> option in a DSN instead.  For
backwards compatibility, this option adds C<A=utf8> to all DSNs.

Enables character set settings in Perl and MySQL.  If the value is C<utf8>, sets
Perl's binmode on STDOUT to utf8, passes the C<mysql_enable_utf8> option to
DBD::mysql, and runs C<SET NAMES UTF8> after connecting to MySQL.  Any other
value sets binmode on STDOUT without the utf8 layer, and runs C<SET NAMES> after
connecting to MySQL.

=item --verbose

short form: -v

Print results of sync operations.

See L<"OUTPUT"> for more details about the output.

=item --version

Show version and exit.

=item --wait

short form: -w; type: time

How long to wait for slaves to catch up to their master.

Make the master wait for the slave to catch up in replication before comparing
the tables.  The value is the number of seconds to wait before timing out (see
also L<"--timeout-ok">).  Sets L<"--lock"> to 1 and L<"--[no]transaction"> to 0
by default.  If you see an error such as the following,

  MASTER_POS_WAIT returned -1

It means the timeout was exceeded and you need to increase it.

The default value of this option is influenced by other options.  To see what
value is in effect, run with L<"--help">.

=item --where

type: string

C<WHERE> clause to restrict syncing to part of the table.

=item --with-triggers

Allow C<mk-table-sync> to write to tables with triggers.

Before syncing tables C<mk-table-sync> checks all destination tables on all
destination hosts (those tables which will be synced to the source host's
tables).  If any destination host table has triggers defined on it,
C<mk-table-sync> will die unless L<"--with-triggers"> is specified.

=back

=head1 EXIT STATUS

Exit status is as follows:

   STATUS  MEANING
   ======  =======================================================
   0       Success.
   1       Internal error.
   2       At least one table differed on the destination.
   3       Combination of 1 and 2.

=head1 OUTPUT

If you specify the L<"--verbose"> option, you'll see information about the 
differences between the tables.  There is one row per table.  Each server is
printed separately.  For example,

   # Syncing D=test,t=test2
   # DELETE REPLACE INSERT UPDATE ALGORITHM DATABASE.TABLE
   #      0       0      2      0 Chunk     test.test1

This table required 2 C<UPDATE> statements to synchronize.

There are cases where no combination of C<INSERT>, C<UPDATE> or C<DELETE>
statements can resolve differences without violating some unique key.  For
example, suppose there's a primary key on column a and a unique key on column b.
Then there is no way to sync these two tables with straightforward UPDATE
statements:

 +---+---+  +---+---+
 | a | b |  | a | b |
 +---+---+  +---+---+
 | 1 | 2 |  | 1 | 1 |
 | 2 | 1 |  | 2 | 2 |
 +---+---+  +---+---+

The tool rewrites queries to C<DELETE> and C<REPLACE> in this case.  This is
automatically handled after the first index violation, so you don't have to
worry about it.

=head1 ENVIRONMENT

The environment variable MKDEBUG enables verbose debugging output in all of the
Maatkit tools:

   MKDEBUG=1 mk-....

=head1 HISTORY AND ACKNOWLEDGEMENTS

My work is based in part on Giuseppe Maxia's work on distributed databases,
L<http://www.sysadminmag.com/articles/2004/0408/> and code derived from that
article.  There is more explanation, and a link to the code, at
L<http://www.perlmonks.org/?node_id=381053>.

Another programmer extended Maxia's work even further.  Fabien Coelho changed
and generalized Maxia's technique, introducing symmetry and avoiding some
problems that might have caused too-frequent checksum collisions.  This work
grew into pg_comparator, L<http://www.coelho.net/pg_comparator/>.  Coelho also
explained the technique further in a paper titled "Remote Comparison of Database
Tables" (L<http://cri.ensmp.fr/classement/doc/A-375.pdf>).

This existing literature mostly addressed how to find the differences between
the tables, not how to resolve them once found.  I needed a tool that would not
only find them efficiently, but would then resolve them.  I first began thinking
about how to improve the technique further with my article
L<http://www.xaprb.com/blog/2007/03/05/an-algorithm-to-find-and-resolve-data-differences-between-mysql-tables/>,
where I discussed a number of problems with the Maxia/Coelho "bottom-up"
algorithm.  After writing that article, I began to write this tool.  I wanted to
actually implement their algorithm with some improvements so I was sure I
understood it completely.  I discovered it is not what I thought it was, and is
considerably more complex than it appeared to me at first.  Fabien Coelho was
kind enough to address some questions over email.

The first versions of this tool implemented a version of the Coelho/Maxia
algorithm, which I called "bottom-up", and my own, which I called "top-down."
Those algorithms are considerably more complex than the current algorithms and
I have removed them from this tool, and may add them back later.  The
improvements to the bottom-up algorithm are my original work, as is the
top-down algorithm.  The techniques to actually resolve the differences are
also my own work.

Another tool that can synchronize tables is the SQLyog Job Agent from webyog.
Thanks to Rohit Nadhani, SJA's author, for the conversations about the general
techniques.  There is a comparison of mk-table-sync and SJA at
L<http://www.xaprb.com/blog/2007/04/05/mysql-table-sync-vs-sqlyog-job-agent/>

Thanks to the following people and organizations for helping in many ways:

The Rimm-Kaufman Group L<http://www.rimmkaufman.com/>,
MySQL AB L<http://www.mysql.com/>,
Blue Ridge InternetWorks L<http://www.briworks.com/>,
Percona L<http://www.percona.com/>,
Fabien Coelho,
Giuseppe Maxia and others at MySQL AB,
Kristian Koehntopp (MySQL AB),
Rohit Nadhani (WebYog),
The helpful monks at Perlmonks,
And others too numerous to mention.

=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

Please use Google Code Issues and Groups to report bugs or request support:
L<http://code.google.com/p/maatkit/>.  You can also join #maatkit on Freenode to
discuss Maatkit.

Please include the complete command-line used to reproduce the problem you are
seeing, the version of all MySQL servers involved, the complete output of the
tool when run with L<"--version">, and if possible, debugging output produced by
running with the C<MKDEBUG=1> environment variable.

=head1 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright 2007-2009 Baron Schwartz.
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
MERCHANTIBILITY 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 AUTHOR

Baron Schwartz.

=head1 VERSION

This manual page documents Ver 1.0.16 Distrib 4047 $Revision: 3977 $.

=cut
