#!/usr/bin/env perl

# This is a program to dump sets of MySQL tables in parallel, via mysqldump or
# SELECT INTO OUTFILE.
#
# 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: 4045 $ =~ m/(\d+)/g, 0));

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

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

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

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

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

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

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

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

# ###########################################################################
# Transformers package 3972
# ###########################################################################

package Transformers;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Time::Local qw(timelocal);
use Digest::MD5 qw(md5_hex);

use constant MKDEBUG => $ENV{MKDEBUG};

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

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

   $t = 0 if $t < 0;

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

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

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

   return $f;
}

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

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

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

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

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

sub ts {
   my ( $time ) = @_;
   my ( $sec, $min, $hour, $mday, $mon, $year )
      = localtime($time);
   $mon  += 1;
   $year += 1900;
   return sprintf("%d-%02d-%02dT%02d:%02d:%02d",
      $year, $mon, $mday, $hour, $min, $sec);
}

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

sub unix_timestamp {
   my ( $val ) = @_;
   if ( my($y, $m, $d, $h, $i, $s)
     = $val =~ m/^(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(?:\.\d+)?$/ )
   {
      return timelocal($s, $i, $h, $d, $m - 1, $y);
   }
   return $val;
}

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

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

1;

# ###########################################################################
# End Transformers package
# ###########################################################################

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

# TODO: permit to disable resuming behavior.
# TODO: permit dumping a single table in many threads.

use English qw(-no_match_vars);
use File::Basename qw(dirname);
use File::Spec;
use List::Util qw(max sum);
use POSIX;
use Time::HiRes qw(time);
use Data::Dumper;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 0;

Transformers->import( qw(shorten secs_to_time ts) );

use constant MKDEBUG => $ENV{MKDEBUG};

# Global variables.
my @mysqldump_args;
my @mysqldump_args_nodata;

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

   # ########################################################################
   # Get configuration information.
   # ########################################################################
   my $dp = new DSNParser();
   my $o  = new OptionParser(
      strict      => 0,
      prompt      => '[OPTION]... [-- [EXTERNAL_OPTION]...]',
      description => q{dumps sets of MySQL tables simultaneously via }
                   . q{mysqldump or SELECT INTO OUTFILE.},
   );
   $o->get_specs();
   $o->get_opts();

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

   eval {
      # Try to read --numthread from the number of CPUs in /proc/cpuinfo.
      # This only works on GNU/Linux.
      open my $file, "<", "/proc/cpuinfo"
         or die $OS_ERROR;
      local $INPUT_RECORD_SEPARATOR = undef;
      my $contents = <$file>;
      close $file;
      my $threads = scalar( map { $_ } $contents =~ m/(processor)/g );

      # Alternatives to /proc/cpuinfo.
      $threads ||= $ENV{NUMBER_OF_PROCESSORS}; # MSWin32
      $threads = max(2, $threads || 0);

      $o->set('threads', $threads);
   };

   # ########################################################################
   # Process options.
   # ########################################################################
   $o->set('base-dir', File::Spec->rel2abs($o->get('base-dir')));

   $o->set('gzip', 0) if $OSNAME eq 'MSWin32';

   # TODO: modularize these.
   if ( !$o->get('help') ) {
      if ( $o->get('default-set') && !$o->get('sets') ) {
         $o->save_error("--default-set has no effect without --sets");
      }

      if ( !$o->get('threads') ) {
         $o->save_error("You must specify --threads");
      }

      if ( !$o->get('help') && $o->get('lossless-floats') && !$o->get('tab') ) {
         $o->save_error("--losslessfp requires --tab");
      }

      if ( $o->get('sets') && !$o->get('set-table') ) {
         $o->save_error("--sets requires --set-table");
      }

      if ( $o->get('tab') && @ARGV ) {
         $o->save_error("Unused arguments: @ARGV");
      }
   }

   if ( $o->get('csv') ) { # TODO: --csv implies --tab
      $o->set('tab', 1);
   }

   if ( $o->get('tab') ) { # TODO: --tab implies --umask 0
      $o->set('umask', 0) unless $o->got('umask');
   }

   if ( $o->get('umask') ) {
      umask oct($o->get('umask'));
   }

   $o->usage_or_errors();

   # ########################################################################
   # Gather connection parameters to pass to mysqldump.  Order matters;
   # mysqldump will have a problem if --defaults-file isn't first.
   # ########################################################################
   if ( $o->get('ask-pass') ) {
      $o->set('password', OptionParser::prompt_noecho("Enter password: "));
   }

   my @conn_params = (
      [qw(--defaults-file F)],
      [qw(--host          h)],
      [qw(--password      p)],
      [qw(--port          P)],
      [qw(--socket        S)],
      [qw(--user          u)],
   );
   @conn_params = map  { "$_->[0]='".$o->get($_->[1])."'"; }
                  grep { $o->got($_->[1]); }
                  @conn_params;

   # ########################################################################
   # Decide on options to mysqldump.
   # ########################################################################
   if ( !@ARGV && !$o->get('tab') ) {
      # Choose sensible defaults.  Inspect mysqldump --help to see what
      # options it accepts.  Add --no-data by default, but then remove it
      # for the ordinary mysqldump commands.  This is used to implement
      # --ignore-engines.
      my $help = `mysqldump --help`;
      if ( $CHILD_ERROR ) {
         return 1;
      }
      $help =~ s/\A.*?\n----//s;
      my %is_opt = map { $_ => 1 } $help =~ m/^(\w[a-z_-]+)/gm;
      my %skip   = map { $_ => 1 } qw(lock-all-tables lock-tables triggers);
      @mysqldump_args_nodata = (
         qw(mysqldump),
         @conn_params,
         (
            map  { $skip{$_} ? "--skip-$_" : "--$_" }
            grep { $is_opt{$_} }
            qw(
               lock-all-tables
               lock-tables
               add-drop-table
               add-locks
               allow-keywords
               comments
               complete-insert
               create-options
               no-data
               disable-keys
               extended-insert
               quick
               quote-names
               set-charset
               triggers
               tz-utc
               no-create-info
            )
         ),
         qw( %D %N ),
      );
      if ( $o->get('chunk-size') ) {
         push @mysqldump_args_nodata, qw( --where %W );
      }
      if ( $o->get('gzip') ) {
         push @mysqldump_args_nodata,
            qw( | gzip --force --fast --stdout - > ),
            filename($o->get('base-dir'), '%S', '%D', '%N.%6C.sql.gz');
      }
      else {
         push @mysqldump_args_nodata,
            qw(--result-file),
            filename($o->get('base-dir'), '%S', '%D', '%N.%6C.sql');
      }
      @mysqldump_args = grep { $_ !~ m/no-data/ } @mysqldump_args_nodata;
   }
   else {
      @mysqldump_args = @ARGV;
   }
   MKDEBUG && _d('Args for mysqldump:', join(', ', @mysqldump_args));

   # ########################################################################
   # Connect.
   # ########################################################################
   my $dsn                  = $dp->parse_options($o);
   my $dbh                  = $dp->get_dbh($dp->get_cxn_params($dsn));
   $dbh->{InactiveDestroy}  = 1;         # Don't die on fork().
   $dbh->{FetchHashKeyName} = 'NAME_lc'; # Lowercases all column names for fetchrow_hashref() 
   my $has_triggers         = VersionParser->new()->version_ge($dbh, '5.0.10');

   # This signal handler will do nothing but wake up the sleeping parent process
   # and record the exit status and time of the child that exited (as a side
   # effect of not discarding the signal).
   my %exited_children;
   $SIG{CHLD} = sub {
      my $kid;
      while (($kid = waitpid(-1, POSIX::WNOHANG)) > 0) {
         MKDEBUG && _d('Process', $kid, 'exited with', $CHILD_ERROR);
         # Must right-shift to get the actual exit status of the child.
         $exited_children{$kid}->{exit_status} = $CHILD_ERROR >> 8;
         $exited_children{$kid}->{exit_time}   = time();
      }
   };

   # ########################################################################
   # Stop the slave if desired.
   # ########################################################################
   if ( $o->get('stop-slave') && !$o->get('dry-run') ) {
      my $sql = 'SHOW STATUS LIKE "Slave_running"';
      MKDEBUG && _d($sql);
      my (undef, $slave_running) = $dbh->selectrow_array($sql);
      MKDEBUG && _d($slave_running);
      if ( ($slave_running || '') ne 'ON' ) {
         die "This server is not a running slave";
      }
      $sql = 'STOP SLAVE';
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   }

   # ########################################################################
   # Lock the whole server if desired.
   # ########################################################################
   if ( $o->get('flush-lock') && !$o->get('dry-run') ) {
      my $sql = 'FLUSH TABLES WITH READ LOCK';
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   }

   # ########################################################################
   # Iterate over "sets" of tables.
   # ########################################################################
   my $q  = new Quoter();
   my $tp = new TableParser();
   my $tc = new TableChunker(quoter => $q);
   my $du = new MySQLDump();
   my %common_modules = (
      o  => $o,
      dp => $dp,
      q  => $q,
      tp => $tp,
      tc => $tc,
      du => $du,
   );

   my %tables_in_sets;
   my %tables_for_set;
   my %stats_for_set;
   my %tables_for;
   my @views;
   my @sets_to_do = $o->get('sets') ? unique(@{$o->get('sets')}) : ();

   # Fetch backup sets from the database.
   my $backedup_sth;
   if ( $o->get('sets') ) {
      my $since   = $o->get('since');
      my $set_tbl = $o->get('set-table'); 
      foreach my $set ( @sets_to_do ) {
         die "'default' is a reserved set; don't use it\n"
            if lc $set eq 'default'; 
         my $sql = "SELECT `db`, `tbl` "
                 . "FROM $set_tbl "
                 . "WHERE `setname` = '$set' "
                 . ($since
                    ? "AND `ts` <= DATE_SUB(NOW(), INTERVAL $since SECOND) "
                    : '')
                 . "ORDER BY `priority`, `db`, `tbl`";
         MKDEBUG && _d($sql);
         my $result = $dbh->selectall_arrayref($sql, { Slice => {} } );
         foreach my $row ( @$result ) {
            MKDEBUG && _d("Set", $set, "contains",
               $row->{db} , ".", $row->{tbl});
            $stats_for_set{$set}->{tables}++;
            $tables_in_sets{$row->{db}}->{$row->{tbl}}++;
            push @{$tables_for_set{$set}}, [ $row->{db}, $row->{tbl} ];
         }
      }
      if ( $since ) {
         $backedup_sth = $dbh->prepare(
            "UPDATE $set_tbl AS `mysql_parallel_dump_writable` "
           . "SET `ts` = NOW() WHERE `setname` = ? AND `db` = ? AND `tbl` = ?");
      }
   }

   my %databases_for;

   my %findspec = (
      quoter => $q,
      dumper => $du,
      databases => {
         permit => $o->get('databases'),
         reject => $o->get('ignore-databases'),
         regexp => $o->get('databases-regex'),
      },
      tables => {
         permit => $o->get('tables'),
         reject => $o->get('ignore-tables'),
         regexp => $o->get('tables-regex'),
      },
      engines => {
         views  => 0,
      },
   );
   if ( $o->get('since') && !$o->get('sets') ) {
      push @{$findspec{tables}->{status}}, { Update_time => $o->get('since') };
   }
   my $f = new MySQLFind(%findspec);

   # Do all databases and tables in a 'default' set, possibly excluding those
   # that have been included in named sets above.  Or, if --set-per-database is
   # specified, place each into its own set.
   if ( !$o->get('sets') || $o->get('default-set') ) {
      foreach my $database ( $f->find_databases($dbh) ) {
         my $set = $o->get('set-per-database') ? $database : 'default';
         push @{$databases_for{$set}}, $database;
         push @sets_to_do, $set;
      }
      @sets_to_do = unique(@sets_to_do);
   }

   # ########################################################################
   # Do each backup set.
   # ########################################################################
   SET:
   foreach my $set ( @sets_to_do ) {

      if ( !$o->get('sets') ) { # Must fetch tables.
         foreach my $database ( @{$databases_for{$set}} ) {
            if ( !$tables_for{$database} ) {
               my @tables = $f->find_tables($dbh, database => $database);
               foreach my $table ( @tables ) {
                  push @{$tables_for{$database}}, $table;
               }
               push @views,
                  map { [ $database, $_ ] }
                     $f->find_views($dbh, database => $database);
            }
            TABLE:
            foreach my $table ( @{$tables_for{$database}} ) {
               # Skip if in another set
               if ( !$tables_in_sets{$database}->{$table} ) {
                  $stats_for_set{$set}->{tables}++;
                  $tables_in_sets{$database}->{$table}++;
                  push @{$tables_for_set{$set}}, [ $database, $table ];
               }
            }
         }
      }

      if ( !$tables_for_set{$set} || !@{$tables_for_set{$set}} ) {
         info($o, 2, "No tables to do for set $set");
         next SET;
      }
      my $start = time();
      my $stats = $stats_for_set{$set};

      # #####################################################################
      # Lock tables if needed.  Cycle until there are none to lock or we get
      # the lock (some tables could have been dropped between the time we got
      # the list and now).
      # #####################################################################
      if ( $o->get('lock-tables') && !$o->get('dry-run') ) {
         my @to_lock;
         my $done;
         do {
            @to_lock = unique(
               map { $q->quote(@$_) . " READ" } @{$tables_for_set{$set}} );
            if ( $backedup_sth ) {
               push @to_lock,
                  $o->get('set-table')
                  . " AS `mysql_parallel_dump_writable` WRITE";
            }
            eval {
               my $sql = 'LOCK TABLES ' . join(', ', @to_lock);
               MKDEBUG && _d('At time', time(), $sql);
               $dbh->do($sql);
               MKDEBUG && _d('At time', time(), 'lock succeeded');
               $done = 1;
            };
            if ( $EVAL_ERROR ) {
               MKDEBUG && _d($EVAL_ERROR);
               my $err = mysql_error_msg($EVAL_ERROR);
               my ($db, $tbl) = $err =~ m/Table '([^.]+)\.([^.]+)' doesn't exist/;
               if ( $db && $tbl ) {
                  MKDEBUG && _d('Removing table', $db, '.', $tbl,
                     'from set', $set);
                  # Remove the nonexistent table and try again.
                  $tables_for_set{$set} = [
                     grep { $_->[0] ne $db || $_->[1] ne $tbl }
                     @{$tables_for_set{$set}}
                  ];
                  info($o, 0, $err);
               }
               else {
                  die "Cannot lock tables: $err";
               }
            }
         } while ( @to_lock && !$done );
      }

      # #####################################################################
      # Flush logs.
      # #####################################################################
      if ( $o->get('flush-log') && !$o->get('dry-run') ) {
         my $sql = 'FLUSH LOGS';
         MKDEBUG && _d($sql);
         $dbh->do($sql);
      }

      my @work_to_do;
      foreach my $db_tbl ( @{$tables_for_set{$set}} ) {
         my $i      = 0;
         my @chunks = get_chunks(
            set => $set,
            db  => $db_tbl->[0],
            tbl => $db_tbl->[1],
            dbh => $dbh,
            %common_modules,
         );
         my $cols   = join(', ', get_columns(
               db  => $db_tbl->[0],
               tbl => $db_tbl->[1],
               dbh => $dbh,
               %common_modules)
         );
         foreach my $chunk ( @chunks ) {
            my $todo = {
               D => $chunk->{D}, # Database name
               N => $chunk->{N}, # Table name
               S => $chunk->{S}, # Set name
               C => $i++,        # Chunk number
               W => $chunk->{W}, # WHERE clause
               E => $chunk->{E}, # Storage engine
               L => $cols,       # SELECT list
            };
            MKDEBUG && _d(Dumper($todo));
            push @work_to_do, $todo;
            $stats_for_set{$set}->{chunks}++;
         }
      }

      # #####################################################################
      # Get the master position.
      # #####################################################################
      if ( $o->get('bin-log-position') && !$o->get('dry-run') ) {
         my $filename = filename($o->get('base-dir'),
            $set, '00_master_data.sql');
         makedir($filename) unless $o->get('dry-run');
         MKDEBUG && _d('Writing to', $filename);
         open my $file, ">", $filename or die $OS_ERROR;
         my %wanted = map { $_ => 1 }
            qw(file position master_host master_port master_log_file
            read_master_log_pos relay_log_file relay_log_pos
            relay_master_log_file exec_master_log_pos);

         my ( $master_pos, $slave_pos );
         eval {
            my $sql = 'SHOW MASTER STATUS';
            MKDEBUG && _d($sql);
            $master_pos = $dbh->selectrow_hashref($sql);
         };
         eval {
            my $sql = 'SHOW SLAVE STATUS';
            MKDEBUG && _d($sql);
            $slave_pos = $dbh->selectrow_hashref($sql);
            print {$file} "CHANGE MASTER TO MASTER_HOST='$slave_pos->{master_host}', "
               . "MASTER_LOG_FILE='$slave_pos->{relay_master_log_file}', "
               . "MASTER_LOG_POS=$slave_pos->{exec_master_log_pos}\n"
               or die $OS_ERROR;
         };
         my %hash;
         foreach my $thing ( $master_pos, $slave_pos ) {
            next unless $thing;
            foreach my $key ( grep { $wanted{$_} } sort keys %$thing ) {
               print $file "-- $key $thing->{$key}\n"
                  or die $OS_ERROR;
            }
         }

         # Put the details of the chunks into the file.
         foreach my $chunk ( @work_to_do ) {
            print $file "-- CHUNK $chunk->{D} $chunk->{N} $chunk->{C} $chunk->{W}\n"
               or die $OS_ERROR;
         }

         close $file or die $OS_ERROR;
      }

      # #####################################################################
      # Design the format for printing out. TODO: modularize.
      # #####################################################################
      my ( $maxdb, $maxtbl, $maxset );
      $maxdb  = max(8, map { length($_->{D}) } @work_to_do);
      $maxtbl = max(5, map { length($_->{N}) } @work_to_do);
      $maxset = max(3, length($set));
      my $format = "%-${maxset}s %-${maxdb}s %-${maxtbl}s %5s %5s %6s %7s";
      info($o, 2, sprintf($format, qw(SET DATABASE TABLE CHUNK TIME STATUS THREADS)));

      # #####################################################################
      # If we need the size for any reason, get it now.
      # #####################################################################
      my $bytes = 0;  # For progress, use $start variable
      my $done  = 0;  # Also for progress measurements
      if ( ($o->get('biggest-first') && !$o->get('set-table'))
           || $o->get('progress') ) {
         TODO:
         foreach my $todo ( @work_to_do ) {
            # TODO: inefficient, nested loops, ugly.  Fix by fixing MySQLDump
            # and MySQLFind, which are not encapsulated right.
            foreach my $stat ( $du->get_table_status($dbh, $q, $todo->{D}) ) {
               if ( $stat->{name} eq $todo->{N} ) {
                  $todo->{Z}  = $stat->{data_length};
                  $bytes     += $stat->{data_length};
                  next TODO;
               }
            }
         }
      }

      # #####################################################################
      # Sort the tables biggest-first.
      # #####################################################################
      if ( $o->get('biggest-first') && !$o->get('set-table') ) {
         @work_to_do = reverse sort { $a->{Z} <=> $b->{Z} } @work_to_do;
      }

      # #####################################################################
      # Assign the work to child processes.  Initially just start --threads
      # number of children.  Each child that exits will trigger a new one to
      # start after that.  This is really a terrible hack -- I wish Perl had
      # decent threading support so I could just queue work for a fixed pool
      # of worker threads!
      # #####################################################################
      my %kids;
      while ( @work_to_do || %kids ) {

         # Wait for the MySQL server to become responsive.
         my $tries = 0;
         while ( !$dbh->ping && $tries++ < $o->get('wait') ) {
            sleep(1);
            eval {
               $dbh = $dp->get_dbh($dp->get_cxn_params($dp->parse_options($o)));
            };
            if ( $EVAL_ERROR ) {
               info($o, 0, 'Waiting: ' . scalar(localtime)
                  . ' ' . mysql_error_msg($EVAL_ERROR));
            }
         }
         if ( $tries >= $o->get('wait') ) {
            die "Too many retries, exiting.\n";
         }

         # Start a new child process.
         while ( @work_to_do && $o->get('threads') > keys %kids ) {
            my $todo = shift @work_to_do;

            # See if this $todo has already been done.
            my $filename  = filename($o->get('base-dir'),
               interp($todo, '%S', '%D', '%N.%6C'));
            if ( -f "$filename.sql" || -f "$filename.sql.gz" ) {
               info($o, 2, "$filename is already done, skipping");
               $done += $todo->{Z} || 0;
               next;
            }

            $todo->{time} = time;
            my $pid = fork();
            die "Can't fork: $OS_ERROR" unless defined $pid;
            if ( $pid ) {              # I'm the parent
               $kids{$pid} = $todo;
            }
            else {                     # I'm the child
               $SIG{CHLD} = 'DEFAULT'; # See bug #1886444
               MKDEBUG && _d("PID", $PID, "got", Dumper($todo));
               my $exit_status = 0;
               $exit_status = do_table(
                  $todo,
                  $filename,
                  $has_triggers,
                  %common_modules,
               ) || $exit_status;
               exit($exit_status);
            }
         }

         # Possibly wait for child.
         my $reaped = 0;
         foreach my $kid ( keys %exited_children ) {
            my $status = $exited_children{$kid};
            my $todo   = $kids{$kid};
            my $stat   = $status->{exit_status};
            if ( !$o->get('dry-run') && !$stat && $backedup_sth ) {
               $backedup_sth->execute(@{$todo}{qw(S D N)});
            }
            my $time = $status->{exit_time} - $todo->{time};
            info($o, 2, sprintf($format, @{$todo}{qw(S D N C)},
               sprintf('%.2f', $time), $stat, scalar(keys %kids)));
            $stats->{ $stat ? 'failure' : 'success' }++;
            $stats->{time} += $time;
            delete $kids{$kid};
            delete $exited_children{$kid};
            $reaped = 1;
            $done += $todo->{Z} || 0;

            if ( $o->get('progress') ) {
               my $pct = $done / $bytes;
               my $now = time();
               my $remaining = ($now - $start) / $pct;
               info($o, 1, sprintf("done: %s/%s %6.2f%% %s remain (%s)",
                     shorten($done),
                     shorten($bytes),
                     $pct * 100,
                     secs_to_time($remaining),
                     ts($now + $remaining))
               );
            }
         }

         if ( !$reaped ) {
            # Don't busy-wait.  But don't wait forever either, as a child
            # may exit and signal while we're not sleeping, so if we sleep
            # forever we may not get the signal.
            MKDEBUG && _d('No children reaped, sleeping');
            sleep(1);
         }
      }

      if ( $o->get('lock-tables') && !$o->get('dry-run') ) {
         my $sql = 'UNLOCK TABLES';
         MKDEBUG && _d($sql);
         $dbh->do($sql);
         $dbh->commit();
      }

      $stats->{wallclock} = time() - $start;
      info($o, 1, sprintf( (@sets_to_do ? '%12s:          ' : '%s:')
                      . '%5d tables, %5d chunks, %5d successes, %2d failures, '
                      . '%6.2f wall-clock time, %6.2f dump time',
                      $set, map { $stats->{$_} || 0 }
                         qw(tables chunks success failure wallclock time) 
                      ));
   }

   # ########################################################################
   # Dump views now.
   # ########################################################################
   if ( @views && !@ARGV && !$o->get('dry-run') ) {
      my $filename = filename($o->get('base-dir'), 'default', '00_views');
      my $fspec = $o->get('gzip')
         ? "| gzip --force --fast > $filename.sql.gz"
         : "> $filename.sql";
      makedir($filename) unless $o->get('dry-run');
      open my $file, $fspec or die $OS_ERROR;
      print {$file} $MySQLDump::before or die $OS_ERROR;
      foreach my $view ( @views ) {
         print {$file} "USE $view->[0];\n",
            $du->dump($dbh, $q, @$view, 'table') or die $OS_ERROR;
      }
      foreach my $view ( @views ) {
         print {$file} "USE $view->[0];\n",
            $du->dump($dbh, $q, @$view, 'view') or die $OS_ERROR;
      }
      print {$file} $MySQLDump::after or die $OS_ERROR;
      close $file or die $OS_ERROR;
   }

   if ( !$o->get('dry-run') ) {
      my $sql = 'UNLOCK TABLES';
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   }

   # ########################################################################
   # Restart the slave if desired.
   # ########################################################################
   if ( $o->get('stop-slave') && !$o->get('dry-run') ) {
      my $sql = 'START SLAVE';
      MKDEBUG && _d($sql);
      $dbh->do($sql);
   }

   $dbh->commit();
   $dbh->disconnect();

   if ( @sets_to_do > 1 ) {
      info($o, 1, sprintf(
         'Final result: %2d sets, %5d tables, %5d chunks, '
         . '%5d successes, %2d failures, '
         . '%6.2f wall-clock time, %6.2f dump time',
         scalar(@sets_to_do),
            map {
               my $thing = $_;
               sum(0, map { $_->{$thing} || 0 } values %stats_for_set);
            } qw(tables chunks success failure wallclock time)
         ));
   }

   # Exit status is 1 if there were any failures.
   return ( sum(0, map { $_->{failure} || 0 } values %stats_for_set) ? 1 : 0 );
}

# ############################################################################
# Subroutines
# ############################################################################

# TODO: modularize.
sub mysql_error_msg {
   my ( $text ) = @_;
   $text =~ s/^.*?failed: (.*?) at \S+ line (\d+).*$/$1 at line $2/s;
   return $text;
}

# Decides on a SELECT list.  For FLOAT and DOUBLE, if lossless floating point
# dumps are desired, wrap the column with REPLACE(FORMAT(col, 17), ',', '').
sub get_columns {
   my ( %args ) = @_;
   foreach my $arg ( qw(db tbl dbh q o tp du) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $o  = $args{o};
   my $q  = $args{q};
   my $tp = $args{tp};
   my $du = $args{du};

   return '*' unless $o->get('lossless-floats');

   my $table = $tp->parse(
      $du->get_create_table($args{dbh}, $q, $args{db}, $args{tbl}));
   my @cols = map {
      $table->{type_for}->{$_} =~ m/float|double/
         ? sprintf("REPLACE(FORMAT(%s, 17), ',', '')", $q->quote($_))
         : $q->quote($_)
   } @{$table->{cols}};
   return @cols;
}

sub get_chunks {
   my ( %args ) = @_;
   foreach my $arg ( qw(db tbl set dbh o tp du q tc) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $o   = $args{o};
   my $q   = $args{q};
   my $tp  = $args{tp};
   my $du  = $args{du};
   my $tc  = $args{tc};
   my $db  = $args{db};
   my $tbl = $args{tbl};
   my $set = $args{set};
   my $dbh = $args{dbh};

   my $table = $tp->parse($du->get_create_table($dbh, $q, $db, $tbl));

   # Decide where to store the file of chunks, which is important for resuming a
   # dump -- the precalculated chunks must be used, not re-calculated, or
   # resuming might go awry.
   my $hashref    = { S => $set, D => $db, N => $tbl };
   my $chunkfile = filename($o->get('base-dir'),
      interp($hashref, '%S', '%D', '%N.chunks'));
   makedir($chunkfile) unless $o->get('dry-run');

   if ( !$o->get('dry-run') && -f $chunkfile ) {
      MKDEBUG && _d('Chunk file', $chunkfile, 'exists, using it');
      open my $fh, "<", $chunkfile or die "Can't open $chunkfile: $OS_ERROR";
      my @todo;
      while ( my $where = <$fh> ) {
         chomp $where;
         push @todo, {
            D => $db,
            N => $tbl,
            S => $set,
            W => $where,
            E => $table->{engine},
         };
      };
      close $fh or die "Can't close $chunkfile: $OS_ERROR";
      return @todo;
   }
   my $cant_chunk = {
      D => $db,
      N => $tbl,
      S => $set,
      W => '1=1',
      E => $table->{engine},
   };
   return $cant_chunk unless $o->get('chunk-size');

   my $rows_per_chunk
      = $tc->size_to_rows($dbh, $db, $tbl, $o->get('chunk-size'), $du);

   # Get the chunk column candidates
   my ($col, undef)   = $tc->get_first_chunkable_column($table);
   return $cant_chunk unless $col;
   my %params = $tc->get_range_statistics($dbh, $db, $tbl, $col);
   return $cant_chunk
      if grep { !defined $params{$_} } qw(min max rows_in_range);

   my @chunks = $tc->calculate_chunks(
      dbh      => $dbh,
      table    => $table,
      col      => $col,
      size     => $rows_per_chunk,
      %params,
   );
   my $fh;
   if ( !$o->get('dry-run') ) {
      open $fh, ">", $chunkfile or die "Can't open $chunkfile: $OS_ERROR";
   }
   my @todo = map {
      if ( !$o->get('dry-run') ) {
         print $fh $_, "\n" or die "Can't print to $chunkfile: $OS_ERROR";
      }
      {
         D => $db,
         N => $tbl,
         S => $set,
         W => $_,
         E => $table->{engine},
      }
   } @chunks;
   if ( !$o->get('dry-run') ) {
      close $fh or die "Can't close $chunkfile: $OS_ERROR";
   }
   return @todo;
}

# Prints a message.
sub info {
   my ( $o, $level, $msg ) = @_;
   if ( $level <= ($o->get('verbose') || 0) ) {
      print $msg, "\n";
   }
}

# TODO: modularize
sub unique {
   my %seen;
   grep { !$seen{$_}++ } @_;
}

# Interpolates % directives from a db/tbl hashref.
sub interp {
   my ( $todo, @strings ) = @_;
   map {
      $_ =~ s/%(\d+)?([SDNCW])/$1 ? sprintf("%0$1d", $todo->{$2})
                                  : $todo->{$2}/ge
   } @strings;
   return @strings;
}

# Actually dumps a table.
sub do_table {
   my ( $todo, $filename, $has_triggers, %args ) = @_;
   foreach my $arg ( qw(o q dp du) ) {
      die "I need a $arg argument" unless $args{$arg};
   }
   my $o   = $args{o};
   my $dp  = $args{dp};
   my $du  = $args{du};
   my $q   = $args{q};

   my $exit_status = 0;
   my $D         = $q->quote($todo->{D});
   my $N         = $q->quote($todo->{N});

   MKDEBUG && $todo->{C} == 0 && _d('Dumping', $D, '.', $N);

   # Since we're forked we need to create our own DBH.  Not doing so leads to
   # re-using the parent's (global) DBH, which leads to really hard-to-find bugs
   # with forking and zombies.  Bleh.
   my $localdbh  = undef;

   if ( $todo->{C} == 0 && $has_triggers && !$o->get('dry-run') ) {
      makedir($filename) unless $o->get('dry-run');
      $localdbh ||= $dp->get_dbh( $dp->get_cxn_params($dp->parse_options($o)) );
      my $trg = $du->dump($localdbh, $q, $todo->{D}, $todo->{N}, 'triggers');
      if ( $trg ) {
         MKDEBUG && _d('Table has triggers');
         my $fspec = $o->get('gzip')
            ? "| gzip --force --fast > $filename.trg.gz"
            : "> $filename.trg";
         open my $file, $fspec or die "Cannot open $fspec: $OS_ERROR";
         print {$file} $trg    or die "Cannot print to $fspec: $OS_ERROR";
         close $file           or die "Cannot close $fspec: $OS_ERROR";
      }
      else {
         MKDEBUG && _d('Table does not have triggers');
      }
   }

   # Dump via SELECT INTO OUTFILE.
   if ( $o->get('tab') ) {
      $localdbh ||= $dp->get_dbh( $dp->get_cxn_params($dp->parse_options($o)) );

      makedir($filename) unless $o->get('dry-run');

      # Dump the schema before the first chunk.
      if ( !$o->get('dry-run') && $todo->{C} == 0 ) {
         # Table definition.
         my $ddl = $du->dump($localdbh, $q, $todo->{D}, $todo->{N}, 'table');
         if ( $ddl ) {
            my $fspec = $o->get('gzip')
               ? "| gzip --force --fast > $filename.sql.gz"
               : "> $filename.sql";
            open my $file, $fspec or die "Couldn't open $fspec: $OS_ERROR";
            print {$file} $ddl    or die "Couldn't print to $fspec: $OS_ERROR";
            close $file           or die "Couldn't close $fspec: $OS_ERROR";
         }
      }

      # Dump the data.
      if ( !$o->get('ignore-engines')->{$todo->{E}} ) { # Don't dump data for these engines...
         my $sql
           = $o->get('csv')
           ?    "SELECT $todo->{L} INTO OUTFILE '$filename.txt' "
              . "FIELDS TERMINATED BY ',' OPTIONALLY ENCLOSED BY '\\\"' "
              . "LINES TERMINATED BY '\\n' FROM $D.$N WHERE $todo->{W}"
           :    "SELECT $todo->{L} INTO OUTFILE '$filename.txt' "
              . "FROM $D.$N WHERE $todo->{W}";
         if ( $o->get('dry-run') ) {
            print $sql, "\n";
         }
         else {
            eval {
               $localdbh->do($sql);
            };
            if ( $EVAL_ERROR ) {
               die mysql_error_msg($EVAL_ERROR) . "\n";
            }
         }
         if ( $o->get('gzip') ) {
            $exit_status = system_call($o,
               'gzip', '--force', '--fast', "$filename.txt");
         }
      }
      else {
         MKDEBUG && _d('Ignoring table because of --ignore-engines');
      }
   }
   else {
      # It's either a custom command, or it's a regular SQL dump and we're going
      # to dump data.

      # If the user left the options alone, we can predict the filename and
      # directory naming convention, and ensure the directories exist.
      # Otherwise the user must ensure the directories exist.
      if ( !@ARGV ) {
         makedir(interp($todo, filename($o->get('base-dir'),
            '%S', '%D', '%N.%6C.sql'))) unless $o->get('dry-run');
      }

      my @args
         = $o->get('ignore-engines')->{$todo->{E}} ? @mysqldump_args_nodata : @mysqldump_args;
      # Do a DROP/CREATE only for the first chunk.
      if ( !@ARGV && $todo->{C} == 0 ) {
         @args = grep { $_ !~ m/--no-create-info/ } @args;
      }

      @args = map { interp($todo, $_) } @args;

      $exit_status = system_call( $o, @args ) || $exit_status;
   }

   $localdbh->disconnect() if $localdbh;
   return $exit_status;
}

# Makes a filename.
sub filename {
   my ( $base_dir, @file_name ) = @_;
   my $filename = File::Spec->catfile($base_dir, @file_name);
   return $filename;
}

{
   # Memoize...
   my %dirs;

   # If the directory doesn't exist, makes the directory.
   sub makedir {
      my ( $filename ) = @_;
      my @dirs = File::Spec->splitdir(dirname($filename));
      foreach my $i ( 0 .. $#dirs ) {
         my $dir = File::Spec->catdir(@dirs[0 .. $i]);
         if ( !$dirs{$dir} ) {
            if ( ! -d $dir ) {
               mkdir($dir, 0777);
            }
            $dirs{$dir}++;
         }
      }
   }
}

# This tries to be a 99% solution by quoting Windows arguments with double
# quotes, and everything else with single quotes. TODO: this does not handle
# embedded single quotes on Unix or double quotes on Windows.
# Unix: hell'o is 'hell'\''o'
sub make_shell_command {
   my @cmd = @_;
   my $char = $OSNAME =~ m/MSWin/ ? q{"} : q{'};
   map {
      # Don't quote every argument.  We need at least the > and | not to be
      # quoted for normal operation, and option names should not be quoted.
      if ( $_ =~ m/[^a-z0-9_.><|-]/ ) {
         $char . $_ . $char;
      }
      else {
         $_;
      }
   } @cmd;
}

sub system_call {
   my ( $o, @cmd ) = @_;
   my $exit_status = 0;
   my $cmd         = join(' ', make_shell_command(@cmd));
   if ( $o->get('dry-run') ) {
      print $cmd, "\n";
   }
   else {
      $exit_status = system($cmd);
      # Must right-shift to get the actual exit status of the command.
      # Otherwise the upstream exit() call that's about to happen will get a
      # larger value than it likes, and will just report zero to waitpid().
      $exit_status = $exit_status >> 8;
   }
   return $exit_status;
}

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-parallel-dump - Dump sets of MySQL tables in parallel.

=head1 SYNOPSIS

  mk-parallel-dump
  mk-parallel-dump --tab --base-dir /path/to/backups/
  mk-parallel-dump --sets order,profile,session --set-table meta.backupset

Do not rely on mk-parallel-dump for your backups unless you have tested it.
You have been warned.

=head1 DESCRIPTION

mk-parallel-dump connects to a MySQL server, finds database and table names,
and dumps them in parallel for speed.  It can be used in several pre-packaged
ways, or as a generic wrapper to call some program in parallel, passing it
parameters for each table.  It supports backup sets and dumping only tables that
have changed since the last dump.

To dump all tables to gzipped files in the current directory, each database with
its own directory, with a global read lock, flushing and recording binary log
positions, each table in a single file:

  mk-parallel-dump

To dump tables elsewhere:

  mk-parallel-dump --base-dir /path/to/elsewhere

To dump to tab-separated files with C<SELECT INTO OUTFILE>, each table with
separate data and SQL files:

  mk-parallel-dump --tab

To dump one or more backup sets (see L<"BACKUP SETS">):

  mk-parallel-dump --sets set1,set2,set3 --set-table meta.backupset

To "write your own command line," use C<--> to indicate where the arguments for
mk-parallel-dump stop and where the arguments for C<mysqldump> (or any other
program) begin.  The following example shows C<mysqldump>, and aside from
simpler options to C<mysqldump>, is basically what happens when you specify no
arguments at all:

  mk-parallel-dump -- mysqldump --skip-lock-tables '%D' '%N' \
     \| gzip --fast -c - \> '%D.%N.gz'

The C<%> modifiers are macros (see L<"MACROS">).  The C<--skip-lock-tables>
argument is very important in that last example, because otherwise both
mk-parallel-dump and C<mysqldump> will lock tables, so C<mysqldump> will hang,
waiting for the locks.  Notice the shell metacharacters C<|> and C<E<gt>> are
escaped so the shell won't interpret them, and they'll get passed through to the
generated command-line.

There's no reason you can't use mk-parallel-dump to do other tasks in
parallel, such as C<OPTIMIZE TABLE>:

  mk-parallel-dump --no-flush-lock -- mysqlcheck --optimize '%D' '%N'

When you use built-in defaults, mk-parallel-dump will relay these arguments
on to every forked copy of C<mysqldump>: L<"--defaults-file">, L<"--host">,
L<"--port">, L<"--socket">, L<"--user">, L<"--password">.  If you write your own
command-line, you will need to specify them manually.

If you specify the L<"--tab"> option, mk-parallel-dump creates separate files
that hold views and triggers, so they can be restored correctly (this is not
currently possible with the C<mysqldump> from MySQL AB, which will restore
triggers before restoring data).  Otherwise it does I<not> back up your entire
database; it dumps tables and data I<only>.  It does not dump view definitions
or stored routines.  However, if you dump the C<mysql> database, you'll be
dumping the stored routines anyway.

Exit status is 0 if everything went well, 1 if any chunks failed, and any
other value indicates an internal error.

mk-parallel-dump doesn't clean out any destination directories before
dumping into them.  You can move away the old destination, then remove it
after a successful dump, with a shell script like the following:

   #!/bin/sh
   CNT=`ls | grep -c old`;
   if [ -d default ]; then mv default default.old.$CNT;
   mk-parallel-dump
   if [ $? != 0 ]
   then
      echo "There were errors, not purging old sets."
   else
      echo "No errors during dump, purging old sets."
      rm -rf default.old.*
   fi

mk-parallel-dump checks whether files have been created before dumping.  If the
file has been created, it skips the table or chunk that would have created the
file.  This makes dumps resumable.  If you don't want this behavior, and instead
you want a full dump, then move away the old files.

=head1 BACKUP SETS

Backup sets are groups of logically related tables you want to backup together.
You specify a set by inserting the table names into a table in the MySQL server
from which you're dumping, and then naming it in the L<"--sets"> option.
mk-parallel-dump always works a set at a time; if you don't specify a set, it
auto-discovers tables, filters them with the various command-line options
(L<"--databases">, etc) and considers them the default set.

The table that stores backup sets should have at least these columns: setname,
priority, db, tbl.  The following is a suggested table structure:

  CREATE TABLE backupset (
    setname  CHAR(10)  NOT NULL,
    priority INT       NOT NULL DEFAULT 0,
    db       CHAR(64)  NOT NULL,
    tbl      CHAR(64)  NOT NULL,
    ts       TIMESTAMP NOT NULL,
    PRIMARY KEY(setname, db, tbl),
    KEY(setname, priority, db, tbl)
  );

Entries are ordered by priority, db, and tbl.  Priority 0 tables are dumped
first, not last.  If it looks like tables are dumped in the wrong order, it's
probably because they're being dumped asynchronously.  The output is printed
when the dump finishes, not when it starts.

If you specify L<"--since">, mk-parallel-dump expects the C<ts> column to
exist, and will update the column to the current date and time when it
successfully dumps a table.

Don't use C<default> as a set name.  It is used when you don't specify any
sets and when you want all tables not explicitly assigned to a set to be
dumped (see L<"--[no]default-set">).

Set names may contain only lowercase letters, numbers, and underscores.

=head1 CHUNKS

mk-parallel-dump can break your tables into chunks when dumping, and put
approximately the amount of data you specify into each chunk.  This is useful to
avoid enormous files for restoration, which can not only take a long time but
may be a lot of extra work for transactional storage engines like InnoDB.  A
huge file can create a huge rollback segment in your tablespace.

To dump in chunks, specify the L<"--chunk-size"> option.  This option is an
integer with an optional suffix.  Without the suffix, it's the number of rows
you want in each chunk.  With the suffix, it's the approximate size of the data.

mk-parallel-dump tries to use index statistics to calculate where the
boundaries between chunks should be.  If the values are not evenly distributed,
some chunks can have a lot of rows, and others may have very few or even none.
Some chunks can exceed the size you want.

When you specify the size with a suffix, the allowed suffixes are k, M and G,
for kibibytes, mebibytes, and gibibytes, respectively.  mk-parallel-dump
doesn't know anything about data size.  It asks MySQL (via C<SHOW TABLE STATUS>)
how long an average row is in the table, and converts your option to a number
of rows.

Not all tables can be broken into chunks.  mk-parallel-dump looks for an
index whose leading column is numeric (integers, real numbers, and date and time
types).  It prefers the primary key if its first column is chunk-able.
Otherwise it chooses the first chunk-able column in the table.

Generating a series of C<WHERE> clauses to divide a table into evenly-sized
chunks is difficult.  If you have any ideas on how to improve the algorithm,
please write to the author (see L<"BUGS">).

=head1 MACROS

mk-parallel-dump can insert C<%> variables into arguments.  The available macros
are as follows:

  MACRO  MEANING
  =====  =================
  %S     The backup set
  %D     The database name
  %N     The table name
  %C     The chunk number
  %W     The WHERE clause

You can place a number between the C<%> and the letter.  The macro replacement
then assumes it's a digit and pads it with leading zeroes (in practice, this is
only useful for C<%C>).

=head1 OUTPUT

Output depends on verbosity.  When L<"--dry-run"> is given, output includes
commands that would be executed.

When L<"--verbose"> is 0, there is normally no output unless there's an error.

When L<"--verbose"> is 1, there is one line of output for each backup set,
showing the set, how many tables and chunks were dumped with what status, how
much time elapsed, and how much time the parallel dump jobs added up to.  A
final line shows sums for all sets, unless there is only one set.

When L<"--verbose"> is 2, there is also one line of output for each table.
Each line is printed when a forked "child" process ends and is removed from
the list of children.  The output shows the backup set, database, table,
seconds spent dumping, the exit status of the forked dump process, and number
of current processes (including the one just reaped; so this typically shows
"how many are running in parallel").  A status of 0 indicates success:

  SET     DATABASE TABLE         TIME STATUS THREADS
  default mysql    db               0      0       4
  default mysql    columns_priv     0      0       4
  default mysql    help_category    0      0       3

=head1 SPEED OF PARALLEL DUMPS

How much faster is it to dump in parallel?  That depends on your hardware and
data.  You may be able dump files twice as fast, or more if you have lots of
disks and CPUs.  Here are some user-contributed figures.

The following table is for a 3.6GHz Xeon machine with 4 processors and a RAID-10
array of 15k disks, directly attached to the server with a fibre channel.  Most
of the space is in one huge table that wasn't dumped in parallel:

  COMMAND                      SIZE  TIME
  --------------------------  -----  ----
  mk-parallel-dump            1.4GB   269
  mysqldump                   1.4GB   345

On the same machine, in a database with lots of roughly equal-sized tables:

  COMMAND                      SIZE  TIME
  --------------------------  -----  ----
  mk-parallel-dump            117MB     7
  mysqldump                   117MB    37

It doesn't always work that well.  A dual 2.80GHz Xeon server with a RAID-5
array of three 7200RPM SATA disk drives running MySQL 5.0.38 on GNU/Linux
achieved the following dump times:

  COMMAND                      SIZE  TIME
  --------------------------  -----  ----
  mk-parallel-dump            3.0GB  2596
  mysqldump | gzip --fast     3.0GB  3195

While dumping two threads in parallel, this machine was at an average of 74%
CPU utilization and 12% I/O wait.  This machine doesn't have enough disks and
CPUs to do that many things at once, so it's not going to speed up much.

Dumping lots of tiny tables by forking of lots of C<mysqldump> processes isn't
usually much faster, because of the overhead of starting C<mysqldump>,
connecting, inspecting the table, and dumping it.  Note that tab-separated
dumps are typically much faster and don't suffer as much from the effects of
many tiny tables, because they're not done via C<mysqldump>.

See also L<http://www.paragon-cs.com/wordpress/?p=52> for a test of parallel
dumping and restoring.

=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

L<"--lock-tables"> and L<"--[no]flush-lock"> are mutually exclusive.

L<"--sets"> and L<"--set-per-database"> are mutually exclusive.

=over

=item --ask-pass

Prompt for a password when connecting to MySQL.

=item --base-dir

type: string

The base directory in which files will be stored.

If you use pre-canned options, such as L<"--tab">, mk-parallel-dump knows what
the eventual filenames will be, and can place all the files in this directory.
It will also create any parent directories that don't exist, if needed (see
also L<"--umask">).

The default is the current working directory.

If you write your own command line, mk-parallel-dump cannot know which
arguments in the command line are filenames, and thus doesn't know the
eventual destination of the dump files.  It does not try to create parent
directories in this case.

=item --[no]biggest-first

default: yes

Process tables in descending order of size (biggest to smallest).

This strategy gives better parallelization.  Suppose there are 8 threads and
the last table is huge.  We will finish everything else and then be running
single-threaded while that one finishes.  If that one runs first, then we will
have the max number of threads running at a time for as long as possible.

This option is ignored when L<"--set-table"> is given.

=item --[no]bin-log-position

default: yes

Dump the master/slave position.

Dump binary log positions from both C<SHOW MASTER STATUS> and C<SHOW SLAVE
STATUS>, whichever can be retrieved from the server.  The data is dumped to a
file named F<00_master_data.sql>.  This is done for each backup set.

The file also contains details of each table dumped, including the WHERE clauses
used to dump it in chunks.

=item --charset

short form: -A; type: string

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

=item --chunk-size

type: string

Number of rows or data size to dump per file.

Specifies that the table should be dumped in segments of approximately the size
given.  The syntax is either a plain integer, which is interpreted as a number
of rows per chunk, or an integer with a suffix of G, M, or k, which is
interpreted as the size of the data to be dumped in each chunk.  See L<"CHUNKS">
for more details.

=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 --csv

Do L<"--tab"> dump in CSV format (implies L<"--tab">).

Changes L<"--tab"> options so the dump file is in comma-separated values
(CSV) format.  The SELECT INTO OUTFILE statement looks like the following, and
can be re-loaded with the same options:

   SELECT * INTO OUTFILE %D.%N.%6C.txt
   FIELDS TERMINATED BY ',' OPTIONALLY ENCLOSED BY '\"'
   LINES TERMINATED BY '\n' FROM %D.%N;

=item --databases

short form: -d; type: hash

Dump only this comma-separated list of databases.

=item --databases-regex

type: string

Dump only databases whose names match this Perl regex.

=item --[no]default-set

When L<"--sets"> given, dump tables not in any set.

The result will be a C<default> set consisting of tables not explicitly
included
in any set.

=item --defaults-file

short form: -F; type: string

Only read mysql options from the given file.  You must give an absolute
pathname.

=item --dry-run

Print commands instead of executing them.

=item --[no]flush-lock

Use C<FLUSH TABLES WITH READ LOCK>.

This is enabled by default unless you're dumping sets (see L<"--sets">).  This
lock is taken once, at the beginning of the whole process, and is never
released.  If you want to lock only the tables you're dumping, use
L<"--lock-tables">.  

=item --flush-log

Execute C<FLUSH LOGS> when getting binlog positions.

This is done for each backup set.  This option is NOT enabled by default because
it causes the MySQL server to rotate its error log, potentially overwriting
error messages.

=item --[no]gzip

default: yes

Compress files with gzip.

This is enabled by default unless your platform is Win32.  By default, this
causes the standard SQL dumps to be piped to gzip's C<STDIN> and the result is
redirected to the destination file.  If this option isn't enabled, by default
C<mysqldump>'s C<--result-file> parameter is used to direct the dump to the
destination file.  When using L<"--tab">, this option causes gzip to be called
separately on each resulting file after it is dumped (because C<SELECT INTO
OUTFILE> cannot be directed to a pipe).

=item --help

Show help and exit.

=item --host

short form: -h; type: string

Connect to host.

=item --ignore-databases

type: Hash

Ignore this comma-separated list of databases.

=item --ignore-engines

type: Hash; default: FEDERATED,MRG_MyISAM

Dump no data for this comma-separated list of storage engines.

The schema file will be dumped as usual.  This prevents dumping data for
Federated tables and Merge tables.

=item --ignore-tables

type: Hash

Ignore this comma-separated list of table names.

Table names may be qualified with the database name.

=item --lock-tables

Use C<LOCK TABLES> (disables L<"--[no]flush-lock">).

Disables L<"--[no]flush-lock"> (unless it was explicitly set) and locks tables
with C<LOCK TABLES READ>.  Enabled by default when L<"--sets"> is specified.
The lock is taken and released with every set of tables dumped.

=item --lossless-floats

Dump float types with extra precision for lossless restore (requires L<"--tab">).

Wraps these types with a call to C<FORMAT()> with 17 digits of precision.
According to the comments in Google's patches, this will give lossless dumping
and reloading in most cases.  (I shamelessly stole this technique from them.  I
don't know enough about floating-point math to have an opinion).

This works only with L<"--tab">.

=item --password

short form: -p; type: string

Password to use when connecting.

=item --port

short form: -P; type: int

Port number to use for connection.

=item --progress

Display progress messages.

Progress is displayed each time a table or chunk of a table finishes dumping.
Progress is calculated by measuring the data size of each table, and assuming
all bytes are created equal.  The output is the completed and total bytes, the
percent completed, estimated time remaining, and estimated completion time.

=item --quiet

short form: -q

Quiet output; disables L<"--verbose">.

=item --set-per-database

Dump each database as a separate set.

Each set is named the same as the database.  Implies L<"--lock-tables">.

=item --set-table

type: string

The database.table in which backup sets are kept.

As mentioned earlier, you can manually specify the ordering of tables in a
backup set.  Therefore L<"--[no]biggest-first"> has no effect when this option
is given.

=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 --sets

type: array

Dump this comma-separated list of backup sets.

Requires L<"--set-table">.  See L<"BACKUP SETS">.  The special C<default> set
is reserved; don't use it as a set name.

=item --since

type: time

Dump only tables modified since this long ago, or not dumped since this long
ago.

Specifies how 'old' a table must be before mk-parallel-dump will consider it.

When L<"--sets"> is not specified, mk-parallel-dump uses C<SHOW TABLE STATUS>
instead of C<SHOW TABLES> to get a list of tables in each database, and compares
the time to the C<Update_time> column in the output.  If the C<Update_time>
column is not C<NULL> and is older than the specified interval ago, it will not
be dumped.  Thus, it means "dump tables that have changed since X amount of
time" (presumably the last regular backup).  This means the table will always be
dumped if it uses InnoDB or another storage engine that doesn't report the
C<Update_time>.

When L<"--sets"> is specified, the L<"--set-table"> table determines when a
table was last dumped, and the meaning of L<"--since"> reverses; it becomes
"dump tables not dumped in X amount of time."

=item --socket

short form: -S; type: string

Socket file to use for connection.

=item --stop-slave

Issue C<STOP SLAVE> on server before dumping data.

This ensures that the data is not changing during the dump.  Issues C<START
SLAVE> after the dump is complete.

If the slave is not running, throws an error and exits.  This is to prevent
possibly bad things from happening if the slave is not running because of a
problem, or because someone intentionally stopped the slave for maintenance or
some other purpose.

=item --tab

Dump tab-separated (sets L<"--umask"> 0).

Dump via C<SELECT INTO OUTFILE>, which is similar to what C<mysqldump> does with
the L<"--tab"> option, but you're not constrained to a single database at a
time.

Before you use this option, make sure you know what C<SELECT INTO OUTFILE> does!
I recommend using it only if you're running mk-parallel-dump on the same
machine as the MySQL server, but there is no protection if you don't.

The files will be gzipped after dumping if L<"--[no]gzip"> is enabled.  This
option sets L<"--umask"> to zero so auto-created directories are writable by
the MySQL server.

Triggers are dumped into C<.trg> files, and views are postponed until the end of
the dump, then dumped all together into the C<00_views.sql> file.  This allows
restoring data before the triggers, which is important for restoring data
accurately.  Views must be postponed until the end and dumped together so they
can be restored correctly; interdependencies between views and tables may
prevent correct restoration otherwise.

=item --tables

short form: -t; type: hash

Dump only this comma-separated list of table names.

Table names may be qualified with the database name.

=item --tables-regex

type: string

Dump only tables whose names match this Perl regex.

=item --threads

type: int; default: 2

Number of threads to dump concurrently.

Specifies the number of parallel processes to run.  The default is 2 (this is
mk-parallel-dump, after all -- 1 is not parallel).  On GNU/Linux machines,
the default is the number of times 'processor' appears in F</proc/cpuinfo>.  On
Windows, the default is read from the environment.  In any case, the default is
at least 2, even when there's only a single processor.

=item --umask

type: string

Set the program's C<umask> to this octal value.

This is useful when you want created files and directories to be readable or
writable by other users (for example, the MySQL server itself).

=item --user

short form: -u; type: string

User for login if not current user.

=item --verbose

short form: -v; cumulative: yes; default: 1

Be verbose; can specify multiple times.

See L<"OUTPUT">.

=item --version

Show version and exit.

=item --wait

short form: -w; type: time; default: 5m

Wait limit when the server is down.

If the MySQL server crashes during dumping, waits until the server comes back
and then continues with the rest of the tables.  C<mk-parallel-dump> will
check the server every second until this time is exhausted, at which point it
will give up and exit.

This implements Peter Zaitsev's "safe dump" request: sometimes a dump on a
server that has corrupt data will kill the server.  mk-parallel-dump will
wait for the server to restart, then keep going.  It's hard to say which table
killed the server, so no tables will be retried.  Tables that were being
concurrently dumped when the crash happened will not be retried.  No additional
locks will be taken after the server restarts; it's assumed this behavior is
useful only on a server you're not trying to dump while it's in production.

=back

=head1 ENVIRONMENT

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

   MKDEBUG=1 mk-....

=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.

This program works best on GNU/Linux.  Filename quoting might not work well on
Microsoft Windows if you have spaces or funny characters in your database or
table names.

=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 SEE ALSO

See also L<mk-parallel-restore>.

=head1 VERSION

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

=cut
