#!/usr/bin/env perl

# This is mk-slave-prefetch, a program to pipeline relay logs on a MySQL slave.
#
# 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.8';
our $DISTRIB = '3722';
our $SVN_REV = sprintf("%d", (q$Revision: 3706 $ =~ m/(\d+)/g, 0));

use English qw(-no_match_vars);
$OUTPUT_AUTOFLUSH = 1;

# ###########################################################################
# OptionParser package 3695
# ###########################################################################
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]<"?([^">]+)"?>';

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 { split(/: /, $_) } 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
# ###########################################################################

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

# ###########################################################################
# DSNParser package 3577
# ###########################################################################
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}};
   my $prop_autokey = $self->prop('autokey');

   foreach my $dsn_part ( split(/,/, $dsn) ) {
      if ( my ($prop_key, $prop_val) = $dsn_part =~  m/^(.)=(.*)$/ ) {
         $given_props{$prop_key} = $prop_val;
      }
      elsif ( $prop_autokey ) {
         MKDEBUG && _d('Interpreting', $dsn_part, 'as',
            $prop_autokey, '=', $dsn_part);
         $given_props{$prop_autokey} = $dsn_part;
      }
      else {
         MKDEBUG && _d('Bad DSN part:', $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";
   }
   if ( (my $key = $self->prop('autokey')) ) {
      $usage .= "  If the DSN is a bareword, the word is treated as the '$key' 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
# ###########################################################################

# ###########################################################################
# LogParser package 3186
# ###########################################################################
package LogParser;

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

use constant MKDEBUG => $ENV{MKDEBUG};

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

my $general_log_first_line = qr{
   \A
   (?:(\d{6}\s+\d{1,2}:\d\d:\d\d)|\t)? # Timestamp
   \t
   (?:\s*(\d+))                        # Thread ID
   \s
   (.*)                                # Everything else
   \Z
}xs;

my $general_log_any_line = qr{
   \A(
      Connect
      |Field\sList
      |Init\sDB
      |Query
      |Quit
   )
   (?:\s+(.*\Z))?
}xs;

my $slow_log_ts_line = qr/^# Time: (\d{6}\s+\d{1,2}:\d\d:\d\d)/;
my $slow_log_uh_line = qr/# User\@Host: ([^\[]+|\[[^[]+\]).*?@ (\S*) \[(.*)\]/;

my $binlog_line_1 = qr{^# at (\d+)};
my $binlog_line_2 = qr/^#(\d{6}\s+\d{1,2}:\d\d:\d\d)\s+server\s+id\s+(\d+)\s+end_log_pos\s+(\d+)\s+(\S+)\s*([^\n]*)$/;
my $binlog_line_2_rest = qr{Query\s+thread_id=(\d+)\s+exec_time=(\d+)\s+error_code=(\d+)};

sub parse_event {
   my ( $self, $fh, $code, $mode ) = @_;
   my $event; # Don't initialize, that'll cause a loop.

   my $done = 0;
   my $type = 0; # 0 = comments, 1 = USE and SET etc, 2 = the actual query
   my $line = defined $self->{last_line} ? $self->{last_line} : <$fh>;
   $mode  ||= '';

   LINE:
   while ( !$done && defined $line ) {
      MKDEBUG && _d('type:', $type, $line);
      my $handled_line = 0;

      if ( !$mode && $line =~ m/^# [A-Z]/ ) {
         MKDEBUG && _d('Setting mode to slow log');
         $mode ||= 'slow';
      }

      if ( $line =~ m/Version:.+ started with:/ ) {
         MKDEBUG && _d('Chomping out header lines');
         <$fh>; # Tcp port: etc
         <$fh>; # Column headers
         $line = <$fh>;
         $type = 0;
         redo LINE;
      }

      elsif ( $mode ne 'slow'
         && (my ( $ts, $id, $rest ) = $line =~ m/$general_log_first_line/s)
      ) {
         MKDEBUG && _d('Beginning of general log event');
         $handled_line = 1;
         $mode ||= 'log';
         $self->{last_line} = undef;
         if ( $type == 0 ) {
            MKDEBUG && _d('Type 0');
            my ( $cmd, $arg ) = $rest =~ m/$general_log_any_line/;
            $event = {
               ts  => $ts || '',
               id  => $id,
               cmd => $cmd,
               arg => $arg || '',
            };
            if ( $cmd ne 'Query' ) {
               MKDEBUG && _d('Not a query, done with this event');
               $done = 1;
               chomp $event->{arg} if $event->{arg};
            }
            $type = 2;
         }
         else {
            MKDEBUG && _d('Saving line for next invocation');
            $self->{last_line} = $line;
            $done = 1;
            chomp $event->{arg} if $event->{arg};
         }
      }

      elsif ( $mode eq 'slow' ) {
         if ( $line =~ m/^# No InnoDB statistics available/ ) {
            $handled_line = 1;
            MKDEBUG && _d('Ignoring line');
            $line = <$fh>;
            $type = 0;
            next LINE;
         }

         elsif ( my ( $time ) = $line =~ m/$slow_log_ts_line/ ) {
            $handled_line = 1;
            MKDEBUG && _d('Beginning of slow log event');
            $self->{last_line} = undef;
            if ( $type == 0 ) {
               MKDEBUG && _d('Type 0');
               $event->{ts} = $time;
               if ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/ ) {
                  @{$event}{qw(user host ip)} = ($user, $host, $ip);
               }
            }
            else {
               MKDEBUG && _d('Saving line for next invocation');
               $self->{last_line} = $line;
               $done = 1;
            }
            $type = 0;
         }

         elsif ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/ ) {
            $handled_line = 1;
            if ( $type == 0 ) {
               MKDEBUG && _d('Type 0');
               @{$event}{qw(user host ip)} = ($user, $host, $ip);
            }
            else {
               MKDEBUG && _d('Saving line for next invocation');
               $self->{last_line} = $line;
               $done = 1;
            }
            $type = 0;
         }

         elsif ( $line =~ m/^# / && (my %hash = $line =~ m/(\w+):\s+(\S+)/g ) ) {

            if ( $type == 0 ) {
               if ( $line =~ m/^#.+;/ ) {
                  MKDEBUG && _d('Commented event line ends header');
               }
               else {
                  $handled_line = 1;
                  MKDEBUG && _d('Splitting line into fields');
                  @{$event}{keys %hash} = values %hash;
               }
            }
            elsif ( $type == 1 && $line =~ m/^#.+;/ ) {
               MKDEBUG && _d('Commented event line after type 1 line');
               $handled_line = 0;
            }
            else {
               $handled_line = 1;
               MKDEBUG && _d('Saving line for next invocation');
               $self->{last_line} = $line;
               $done = 1;
            }
            $type = 0;
         }
      }

      if ( !$handled_line ) {
         $event->{cmd} = 'Query';
         if ( $mode eq 'slow' && $line =~ m/;\s+\Z/ ) {
            MKDEBUG && _d('Line is the end of a query within event');
            if ( my ( $db ) = $line =~ m/^use (.*);/i ) {
               MKDEBUG && _d('Setting event DB to', $db);
               $event->{db} = $db;
               $type = 1;
            }
            elsif ( $type < 2 && (my ( $setting ) = $line =~ m/^(SET .*);\s+\Z/ ) ) {
               MKDEBUG && _d('Setting a property for event');
               push @{$event->{settings}}, $setting;
               $type = 1;
            }
            else {
               MKDEBUG && _d('Line is a continuation of prev line');
               if ( $line =~ m/^# / ) {
                  MKDEBUG && _d('Line is a commented event line');
                  $line =~ s/.+: (.+);\n/$1/;
                  $event->{cmd} = 'Admin';
               }
               $event->{arg} .= $line;
               $type = 2;
            }
         }
         else {
            MKDEBUG && _d('Line is a continuation of prev line');
            $event->{arg} .= $line;
            $type = 2;
         }
      }

      $event->{NR} = $NR;

      $line = <$fh> unless $done;
   }

   if ( !defined $line ) {
      MKDEBUG && _d('EOF found');
      $self->{last_line} = undef;
   }

   if ( $mode && $mode eq 'slow' ) {
      MKDEBUG && _d('Slow log, trimming');
      $event->{arg} =~ s/;\s*\Z// if $event->{arg};
   }

   $code->($event) if $event && $code;
   return $event;
}

sub parse_slowlog_event {
   my ( $self, $fh, $misc, @callbacks ) = @_;
   my $num_events = 0;

   my @pending;
   local $INPUT_RECORD_SEPARATOR = ";\n#";
   my $trimlen    = length($INPUT_RECORD_SEPARATOR);
   my $pos_in_log = tell($fh);
   my $stmt;

   EVENT:
   while ( defined($stmt = shift @pending) or defined($stmt = <$fh>) ) {
      my @properties = ('cmd', 'Query', 'pos_in_log', $pos_in_log);
      $pos_in_log = tell($fh);

      if ( $stmt =~ s{
            ^(?:
            Tcp\sport:\s+\d+
            |
            /.*Version.*started
            |
            Time\s+Id\s+Command
            ).*\n
         }{}gmxo
      ){
         my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt);
         if ( @chunks > 1 ) {
            $stmt = shift @chunks;
            unshift @pending, @chunks;
         }
      }

      $stmt = '#' . $stmt unless $stmt =~ m/\A#/;
      $stmt =~ s/;\n#?\Z//;


      my ($got_ts, $got_uh, $got_ac, $got_db, $got_set);
      my $pos = 0;
      my $len = length($stmt);
      my $found_arg = 0;
      LINE:
      while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match.
         $pos     = pos($stmt);  # Be careful not to mess this up!
         my $line = $1;          # Necessary for /g and pos() to work.

         if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/oi) {

            if ( !$got_ts
               && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)
               && ++$got_ts
            ) {
               push @properties, 'ts', $time;
               if ( !$got_uh
                  && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o )
                  && ++$got_uh
               ) {
                  push @properties, 'user', $user, 'host', $host, 'ip', $ip;
               }
            }

            elsif ( !$got_uh
                  && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o )
                  && ++$got_uh
            ) {
               push @properties, 'user', $user, 'host', $host, 'ip', $ip;
            }

            elsif ( !$got_ac
                  && $line =~ m/^# (?:administrator command:.*)$/
                  && ++$got_ac
            ) {
               push @properties, 'cmd', 'Admin', 'arg', $line;
               $found_arg++;
            }

            elsif ( my @temp = $line =~ m/(\w+):\s+(\d+(?:\.\d+)?|\S+)/g ) {
               push @properties, @temp;
            }

            elsif ( !$got_db
                  && (my ( $db ) = $line =~ m/^USE ([^;]+)/i )
                  && ++$got_db
            ) {
               push @properties, 'db', $db;
            }

            elsif ( !$got_set
                  && ( my ( $setting ) = $line =~ m/^SET\s+([^;]*)/i )
                  && ++$got_set
            ) {
               push @properties, split(/,|\s*=\s*/, $setting);
            }

            if ( !$found_arg && $pos == $len ) {
               local $INPUT_RECORD_SEPARATOR = ";\n";
               if ( defined(my $l = <$fh>) ) {
                  chomp $l;
                  push @properties, 'cmd', 'Admin', 'arg', '#' . $l;
                  $found_arg++;
               }
               else {
                  next EVENT;
               }
            }
         }
         else {
            push @properties, 'arg', substr($stmt, $pos - length($line));
            last LINE;
         }
      }

      my $event = { @properties };
      foreach my $callback ( @callbacks ) {
         last unless $event = $callback->($event);
      }
      ++$num_events;
      last EVENT unless @pending;
   }
   return $num_events;
}

sub parse_binlog_event {
   my ( $self, $fh, $code ) = @_;
   my $event;

   my $term  = $self->{term} || ";\n"; # Corresponds to DELIMITER
   my $tpat  = quotemeta $term;
   local $RS = $term;
   my $line  = <$fh>;

   LINE: {
      return unless $line;

      if ( $line =~ m/^DELIMITER/m ) {
         my($del)      = $line =~ m/^DELIMITER ([^\n]+)/m;
         $self->{term} = $del;
         local $RS     = $del;
         $line         = <$fh>; # Throw away DELIMITER line
         MKDEBUG && _d('New record separator:', $del);
         redo LINE;
      }

      $line =~ s/$tpat\Z//;

      if ( my ( $offset ) = $line =~ m/$binlog_line_1/m ) {
         $self->{last_line} = undef;
         $event = {
            offset => $offset,
         };
         my ( $ts, $sid, $end, $type, $rest ) = $line =~ m/$binlog_line_2/m;
         @{$event}{qw(ts server_id end type)} = ($ts, $sid, $end, $type);
         (my $arg = $line) =~ s/\n*^#.*\n//gm; # Remove comment lines
         $event->{arg} = $arg;
         if ( $type eq 'Xid' ) {
            my ($xid) = $rest =~ m/(\d+)/;
            $event->{xid} = $xid;
         }
         elsif ( $type eq 'Query' ) {
            @{$event}{qw(id time code)} = $rest =~ m/$binlog_line_2_rest/;
         }
         else {
            die "Unknown event type $type"
               unless $type =~ m/Rotate|Start|Execute_load_query|Append_block|Begin_load_query|Rand|User_var|Intvar/;
         }
      }
      else {
         $event = {
            arg => $line,
         };
      }
   }

   if ( !defined $line ) {
      delete $self->{term};
   }

   $code->($event) if $event && $code;
   return $event;
}

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

# ###########################################################################
# QueryRewriter package 3383
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package QueryRewriter;

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

our $verbs   = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT
                  |UPDATE|DELETE|REPLACE|^SET|UNION|^START}xi;
my $quote_re = qr/"(?:(?!(?<!\\)").)*"|'(?:(?!(?<!\\)').)*'/; # Costly!
my $bal;
$bal         = qr/
                  \(
                  (?:
                     (?> [^()]+ )    # Non-parens without backtracking
                     |
                     (??{ $bal })    # Group with matching parens
                  )*
                  \)
                 /x;

my $olc_re = qr/(?:--|#)[^'"\r\n]*(?=[\r\n]|\Z)/;  # One-line comments
my $mlc_re = qr#/\*[^!].*?\*/#sm;                  # But not /*!version */

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

sub strip_comments {
   my ( $self, $query ) = @_;
   $query =~ s/$olc_re//go;
   $query =~ s/$mlc_re//go;
   return $query;
}

sub shorten {
   my ( $self, $query, $length ) = @_;
   $query =~ s{
      \A(
         (?:INSERT|REPLACE)
         (?:\s+LOW_PRIORITY|DELAYED|HIGH_PRIORITY|IGNORE)?
         (?:\s\w+)*\s+\S+\s+VALUES\s*\(.*?\)
      )
      \s*,\s*\(.*?(ON\s+DUPLICATE|\Z)}
      {$1 /*... omitted ...*/$2}xsi;

   return $query unless $query =~ m/IN\s*\(\s*(?!select)/i;

   if ( $length && length($query) > $length ) {
      my ($left, $mid, $right) = $query =~ m{
         (\A.*?\bIN\s*\()     # Everything up to the opening of IN list
         ([^\)]+)             # Contents of the list
         (\).*\Z)             # The rest of the query
      }xsi;
      if ( $left ) {
         my $targ = $length - length($left) - length($right);
         my @vals = split(/,/, $mid);
         my @left = shift @vals;
         my @right;
         my $len  = length($left[0]);
         while ( @vals && $len < $targ / 2 ) {
            $len += length($vals[0]) + 1;
            push @left, shift @vals;
         }
         while ( @vals && $len < $targ ) {
            $len += length($vals[-1]) + 1;
            unshift @right, pop @vals;
         }
         $query = $left . join(',', @left)
                . (@right ? ',' : '')
                . " /*... omitted " . scalar(@vals) . " items ...*/ "
                . join(',', @right) . $right;
      }
   }

   return $query;
}

sub fingerprint {
   my ( $self, $query ) = @_;

   $query =~ m#\ASELECT /\*!40001 SQL_NO_CACHE \*/ \* FROM `# # mysqldump query
      && return 'mysqldump';
   $query =~ m#/\*\w+\.\w+:[0-9]/[0-9]\*/#     # mk-table-checksum, etc query
      && return 'maatkit';
   $query =~ m/\A# administrator command: /
      && return $query;
   $query =~ m/\A\s*(call\s+\S+)\(/i
      && return lc($1); # Warning! $1 used, be careful.
   if ( my ($beginning) = $query =~ m/\A((?:INSERT|REPLACE)(?: IGNORE)? INTO .+? VALUES \(.*?\)),\(/i ) {
      $query = $beginning; # Shorten multi-value INSERT statements ASAP
   }

   $query =~ s/$olc_re//go;
   $query =~ s/$mlc_re//go;
   $query =~ s/\Ause \S+\Z/use ?/i       # Abstract the DB in USE
      && return $query;

   $query =~ s/\\["']//g;                # quoted strings
   $query =~ s/".*?"/?/sg;               # quoted strings
   $query =~ s/'.*?'/?/sg;               # quoted strings
   $query =~ s/[0-9+-][0-9a-f.xb+-]*/?/g;# Anything vaguely resembling numbers
   $query =~ s/[xb.+-]\?/?/g;            # Clean up leftovers
   $query =~ s/\A\s+//;                  # Chop off leading whitespace
   chomp $query;                         # Kill trailing whitespace
   $query =~ tr[ \n\t\r\f][ ]s;          # Collapse whitespace
   $query = lc $query;
   $query =~ s/\bnull\b/?/g;             # Get rid of NULLs
   $query =~ s{                          # Collapse IN and VALUES lists
               \b(in|values?)(?:[\s,]*\([\s?,]*\))+
              }
              {$1(?+)}gx;
   $query =~ s{                          # Collapse UNION
               \b(select\s.*?)(?:(\sunion(?:\sall)?)\s\1)+
              }
              {$1 /*repeat$2*/}xg;
   $query =~ s/\blimit \?(?:, ?\?| offset \?)?/limit ?/; # LIMIT
   return $query;
}

sub distill {
   my ( $self, $query, %args ) = @_;
   my $qp = $args{qp} || $self->{QueryParser};
   die "I need a qp argument" unless $qp;

   $query =~ m/\A\s*call\s+(\S+)\(/i
      && return "CALL $1"; # Warning! $1 used, be careful.
   $query =~ m/\A# administrator/
      && return "ADMIN";
   $query =~ m/\A\s*use\s+/
      && return "USE";

   my @verbs = $query =~ m/\b($verbs)\b/gio;
   @verbs    = do {
      my $last = '';
      grep { my $pass = $_ ne $last; $last = $_; $pass } map { uc } @verbs;
   };
   my $verbs = join(q{ }, @verbs);
   $verbs =~ s/( UNION SELECT)+/ UNION/g;

   my @tables = map {
      $_ =~ s/`//g;
      $_ =~ s/(_?)[0-9]+/$1?/g;
      $_;
   } $qp->get_tables($query);

   @tables = do {
      my $last = '';
      grep { my $pass = $_ ne $last; $last = $_; $pass } @tables;
   };

   $query = join(q{ }, $verbs, @tables);
   return $query;
}

sub convert_to_select {
   my ( $self, $query ) = @_;
   return unless $query;
   $query =~ s{
                 \A.*?
                 update\s+(.*?)
                 \s+set\b(.*?)
                 (?:\s*where\b(.*?))?
                 (limit\s*[0-9]+(?:\s*,\s*[0-9]+)?)?
                 \Z
              }
              {__update_to_select($1, $2, $3, $4)}exsi
      || $query =~ s{
                    \A.*?
                    (?:insert|replace)\s+
                    .*?\binto\b(.*?)\(([^\)]+)\)\s*
                    values?\s*(\(.*?\))\s*
                    (?:\blimit\b|on\s*duplicate\s*key.*)?\s*
                    \Z
                 }
                 {__insert_to_select($1, $2, $3)}exsi
      || $query =~ s{
                    \A.*?
                    delete\s+(.*?)
                    \bfrom\b(.*)
                    \Z
                 }
                 {__delete_to_select($1, $2)}exsi;
   $query =~ s/\s*on\s+duplicate\s+key\s+update.*\Z//si;
   $query =~ s/\A.*?(?=\bSELECT\s*\b)//ism;
   return $query;
}

sub convert_select_list {
   my ( $self, $query ) = @_;
   $query =~ s{
               \A\s*select(.*?)\bfrom\b
              }
              {$1 =~ m/\*/ ? "select 1 from" : "select isnull(coalesce($1)) from"}exi;
   return $query;
}

sub __delete_to_select {
   my ( $delete, $join ) = @_;
   if ( $join =~ m/\bjoin\b/ ) {
      return "select 1 from $join";
   }
   return "select * from $join";
}

sub __insert_to_select {
   my ( $tbl, $cols, $vals ) = @_;
   MKDEBUG && _d('Args:', @_);
   my @cols = split(/,/, $cols);
   MKDEBUG && _d('Cols:', @cols);
   $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens
   my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g;
   MKDEBUG && _d('Vals:', @vals);
   if ( @cols == @vals ) {
      return "select * from $tbl where "
         . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols));
   }
   else {
      return "select * from $tbl limit 1";
   }
}

sub __update_to_select {
   my ( $from, $set, $where, $limit ) = @_;
   return "select $set from $from "
      . ( $where ? "where $where" : '' )
      . ( $limit ? " $limit "      : '' );
}

sub wrap_in_derived {
   my ( $self, $query ) = @_;
   return unless $query;
   return $query =~ m/\A\s*select/i
      ? "select 1 from ($query) as x limit 1"
      : $query;
}

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

# ###########################################################################
# Daemon package 3647
# ###########################################################################

package Daemon;

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

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

use constant MKDEBUG => $ENV{MKDEBUG};

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

   if ( $self->{PID_file} && -f $self->{PID_file} ) {
      die "The PID file $self->{PID_file} already exists"
   }

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

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

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

   $self->{child} = 1;

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

   $self->_make_PID_file();

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

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

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

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

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

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

   if ( -f $self->{PID_file} ) {
      die "The PID file $self->{PID_file} already exists"
   }

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

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

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

sub DESTROY {
   my ( $self ) = @_;
   $self->_remove_PID_file() if $self->{child} || $self->{rm_PID_file};
   return;
}

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

1;

# ###########################################################################
# End Daemon package
# ###########################################################################

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

# TODO:
#   * filter: Throw away non-replicated DBs/tables
#   * Optionally read the binlog from the server's master.  advantages: can run
#     tool on another server than the slave.
#   * need to change --statistics to print only N top queries

use Data::Dumper;
use English qw(-no_match_vars);
use List::Util qw(min max sum);
use Time::HiRes qw(gettimeofday);
use sigtrap qw(handler finish untrapped normal-signals);

use constant MKDEBUG => $ENV{MKDEBUG};

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

my $o;
my %query_stats;
my %stats;
my %slave;
my $last_chk = 0;
my $oktorun  = 1;
my $now;
my $end;
my $sentinel;
my $time;
my $window;

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

   my $dp = new DSNParser();
   $o     = new OptionParser(
      strict      => 0,
      prompt      => '[OPTION...] [FILE]',
      description => q{pipelines relay logs to pre-warm the slave's caches.},
   );
   $o->get_specs();
   $o->get_opts();

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

   if ( $o->get('run-time') ) {
      $o->set('run-time', max($o->get('run-time'), 1));
   }

   my ($chk_int, $chk_min, $chk_max) = @{$o->get('check-interval')};
   if ( grep { !defined $_ || $_ !~ m/^\d+$/ } ($chk_int, $chk_min, $chk_max) )
   {
      $o->save_error("You must specify three elements for --checkint");
   }
   elsif ( $chk_int > $chk_max || $chk_int < $chk_min
           || $chk_max < $chk_min || $chk_min < 0 ) {
      $o->save_error("You specified an invalid range for --checkint");
   }

   if ( @ARGV > 1 ) {
      $o->save_error("You can specify only one FILE");
   }

   $o->usage_or_errors();

   # ########################################################################
   # Set frequently used opts to vars to avoid sub calling overhead.
   # ########################################################################
   # These opts are used in the main while().
   my $permit_regexp = $o->get('permit-regexp');
   my $reject_regexp = $o->get('reject-regexp');
   my $progress      = $o->get('progress');
   my $execute       = $o->get('execute');
   my $print         = $o->get('print');
   # These opts are mostly used in subs.
   $window           = $o->get('window');
   $sentinel         = $o->get('sentinel');
   $time             = $o->get('run-time');

   # ########################################################################
   # First things first: if --stop was given, create the sentinel file.
   # ########################################################################
   if ( $o->get('stop') ) {
      open my $file, ">", $sentinel
         or die "Cannot open $sentinel: $OS_ERROR\n";
      print $file "Remove this file to permit mk-slave-prefetch to run\n"
         or die "Cannot write to $sentinel: $OS_ERROR\n";
      close $file
         or die "Cannot close $sentinel: $OS_ERROR\n";
      print "Successfully created file $sentinel\n";
      return 0;
   }

   # ########################################################################
   # Initialize the query stats from the file on the commandline, if any.
   # ######################################################################## 
   my %query_errors;
   if ( @ARGV ) {
      open my $fh, "<", $ARGV[0] or die $OS_ERROR;
      my ($type, $rest);
      while ( my $line = <$fh> ) {
         ($type, $rest) = $line =~ m/^# (query|stats): (.*)$/;
         next unless $type;
         if ( $type eq 'query' ) {
            $query_stats{$rest} = { seen => 1, samples => [] };
         }
         else {
            my ( $seen, $exec, $sum, $avg )
               = $rest =~ m/seen=(\S+) exec=(\S+) sum=(\S+) avg=(\S+)/;
            if ( $seen ) {
               $query_stats{$rest}->{samples}
                  = [ map { $avg } (1 ..  $o->get('query-samp-size')) ];
               $query_stats{$rest}->{avg} = $avg;
            }
         }
      }
      close $fh or die $OS_ERROR;
   }

   # ########################################################################
   # Get the database connection and set it up as desired: Lowercase all
   # column names for fetchrow_hashref. Don't disconnect on fork.  Disable
   # the query cache.
   # ########################################################################
   if ( $o->get('ask-pass') ) {
      my $pass = OptionParser::prompt_noecho("Enter password: ");
      $o->set('pass', $pass);
   }
   my %opts = $o->opt_values();
   my $dbh = $dp->get_dbh(
      $dp->get_cxn_params(\%opts), { AutoCommit => 1 });
   $dbh->{FetchHashKeyName} = 'NAME_lc';
   $dbh->{InactiveDestroy}  = 1;
   $dbh->do('/*!40001 set @@session.query_cache_type=OFF */');

   # ########################################################################
   # Daemonize only after (potentially) asking for passwords for --askpass.
   # ########################################################################
   my $daemon;
   if ( $o->get('daemonize') ) {
      $daemon = new Daemon(o=>$o);
      $daemon->daemonize();
      MKDEBUG && _d('I am a daemon now');
   }

   # ########################################################################
   # Ready to work now.
   # ########################################################################
   my $qr = new QueryRewriter();
   my $lp = new LogParser();
   my $vp = new VersionParser();

   my $have_subqueries = $vp->version_ge($dbh, '4.1.0');

   my ($datadir) = ($dbh->selectrow_array('show variables like "datadir"'))[1];
   MKDEBUG && _d('Data directory', $datadir);

   $now = time();
   $end = $now + ( $time || 0 );  # When we should exit

   eval {
      while ( oktorun() ) {
         %slave = get_status($dbh);

         my $pos  = 0; # Current position we're reading in relay log.
         my $next = 0; # Start of next relay log event.
         my $ts   = 0; # Last seen timestamp.

         if ( $slave{running} ) {
            my $cmd = "mysqlbinlog -l "
                    . $o->get('tmpdir')
                    . " --start-pos=$slave{pos} $datadir/$slave{file}"
                    . (MKDEBUG ? ' 2>/dev/null' : '');
            # Ensure file is readable
            if ( !-r "$datadir/$slave{file}" ) {
               die("$datadir/$slave{file} doesn't exist or isn't readable");
            }
            MKDEBUG && _d($cmd);
            open my $fh, "$cmd |" or die $OS_ERROR; # Succeeds even on error
            if ( $CHILD_ERROR ) {
               die("$cmd returned exit code " . ($CHILD_ERROR >> 8)
                  . '.  Try running the command manually or using MKDEBUG=1.');
            }
            $stats{mysqlbinlog}++;

            my $i = 0;
            EVENT:
            while ( oktorun(1) && (my $event = $lp->parse_binlog_event($fh)) ) {
               $stats{events}++;
               $pos  = $event->{offset} || $pos;
               $next = max($next, $pos + ($event->{end} || 0));
               MKDEBUG && _d('i:', $i, 'pos:', $pos, 'next:', $next,
                  'slave:', $slave{pos});
               $i++;

               if ( $progress && $stats{events} % $progress == 0 ) {
                  print("# $slave{file} $pos ",
                     join(' ', map { "$_:$stats{$_}" } keys %stats), "\n");
               }

               # If it's a LOAD DATA INFILE, rm the temp file.
               if ( $event->{arg}
                    && (my ($file) = $event->{arg} =~ m/INFILE ('[^']+')/i) ) {
                  $stats{load_data_infile}++;
                  if ( !unlink($file) ) {
                     MKDEBUG && _d('Could not unlink', $file);
                     $stats{could_not_unlink}++;
                  }
                  next EVENT;
               }

               # Stay ahead of the slave.
               next EVENT if not_far_enough_ahead($pos);

               # Time to check the slave's status again?
               if ( $pos > $slave{pos} && ($i - $last_chk) >= $chk_int ) {
                  %slave    = get_status($dbh);
                  $last_chk = $i;
                  $chk_int  = $pos <= $slave{pos} # The slave caught up to us
                     ? max($chk_min, $chk_int / 2)
                     : min($chk_max, $chk_int * 2);
                  next EVENT if not_far_enough_ahead($pos);
               }

               # But don't get too far ahead or too close to the end of
               # the binlog.
               while ( oktorun(1)
                       && (too_far_ahead($pos) || too_close_to_io($pos)) ) {
                  # Don't increment stats if the slave didn't catch up while we
                  # slept. TODO: if the slave is very caught up to the I/O, this
                  # will be a problem.
                  if ( wait_for_master($dbh, \%slave, $pos-$window+1) > 0 ) {
                     if ( too_far_ahead($pos) ) {
                        MKDEBUG && _d('Event', $pos, 'too far ahead of',
                           $slave{pos});
                        $stats{too_far_ahead}++;
                     }
                     elsif ( too_close_to_io($pos) ) {
                        MKDEBUG && _d('Event', $pos, 'too close to I/O thread',
                                      '(', $slave{pos}, '+', $slave{lag}, ')');
                        $stats{too_close_to_io_thread}++;
                     }
                  }
                  else {
                     MKDEBUG && _d('SQL thread did not advance');
                  }

                  %slave    = get_status($dbh);
                  $last_chk = $i;
               }

               if ( $event->{arg} ) {
                  $event->{arg} = $qr->strip_comments($event->{arg});
               }

               if ( ($event->{arg}||'')
                    !~ m/\A\s*(?:set [t@]|use|insert|update|delete|replace)/i) {
                  MKDEBUG && _d('Event arg: ',
                     (defined $event->{arg}
                        ?  substr($event->{arg}, 0, 50)
                        : 'undef'));
                  MKDEBUG && _d('Skipping this event because not allowable');
                  $stats{event_not_allowed}++;
                  next EVENT;
               }

               if ( ($reject_regexp && $event->{arg} =~ m/$reject_regexp/o)
                    || ($permit_regexp && $event->{arg} !~ m/$permit_regexp/o) )
               {
                  MKDEBUG && _d('Skipping because of permit/reject regexp');
                  $stats{event_filtered_out}++;
                  next EVENT;
               }

               # If the event is SET TIMESTAMP and we've already set the
               # timestamp to that value, skip it.
               if ( (my ($newts) = $event->{arg} =~ m/SET TIMESTAMP=(\d+)/) ) {
                  if ( $newts == $ts ) {
                     MKDEBUG && _d('Already saw timestamp', $newts);
                     $stats{same_timestamp}++;
                     next EVENT;
                  }
                  else {
                     $ts = $newts;
                  }
               }

               # Convert the event to a SELECT and print/execute it.
               my $select = $qr->convert_to_select($event->{arg});
               if ( $select =~ m/\A\s*(?:set|select|use)/i ) {
                  my $fingerprint = $qr->fingerprint(
                     $event->{arg}, {prefixes => $o->get('num-prefix')});
                  if ( (my $avg = get_avg($fingerprint))
                       < $o->get('max-query-time') ) {

                     # Safeguard as much as possible against really enormous
                     # result sets.
                     my $sql = $qr->convert_select_list($select);
                     if ( $have_subqueries && !have_seen_query($fingerprint)) {
                        # Wrap in a "derived table," but only if it hasn't been
                        # seen before.  This way, really short queries avoid the
                        # overhead of creating the temp table.
                        $sql = $qr->wrap_in_derived($sql);
                     }

                     # Do it!
                     MKDEBUG && _d($sql);
                     $stats{do_query}++;
                     if ( $execute ) {
                        eval {
                           my $start = gettimeofday();
                           $dbh->do($sql);
                           store_avg($fingerprint, gettimeofday() - $start);
                        };
                        if ( $EVAL_ERROR ) {
                           $stats{query_error}++;
                           if ( ($o->get('errors') == 2) || MKDEBUG ) {
                              _d($EVAL_ERROR);
                              _d('SQL was:', $event->{arg});
                           }
                           elsif ( $o->get('errors') == 1 ) {
                              $query_errors{$fingerprint}++;
                           }
                        }
                     }
                     elsif ( $print ) {
                        print $sql, ";\n";
                     }
                  }
                  else {
                     # The query's average execution time is longer than the
                     # specified limit, so we skip it and just wait for the
                     # master to pass it by.
                     MKDEBUG && _d('Avg time', $avg, 'too long for',
                        $fingerprint);
                     $stats{query_too_long}++;
                     wait_for_master($dbh, \%slave, $pos + 1);
                     %slave    = get_status($dbh);
                     $last_chk = $i;
                  }
               }
               else {
                  $stats{query_not_rewritten}++;
                  _d($event->{arg}) if MKDEBUG || $o->get('print-nonrewritten');
               }
            }

            MKDEBUG && _d('Closing filehandle');

            # Unfortunately, mysqlbinlog does NOT like me to close the pipe
            # before reading all data from it.  It hangs and prints angry
            # messages about a closed file.  So I'll find the mysqlbinlog
            # process created by the open() and kill it.
            my $procs = `ps -eaf | grep mysqlbinlog`;
            MKDEBUG && _d($procs);
            if ( my ($line) = $procs =~ m/^(.*?\d\s+$cmd)$/m ) {
               chomp $line;
               MKDEBUG && _d($line);
               if ( my ( $proc ) = $line =~ m/(\d+)/ ) {
                  MKDEBUG && _d('Will kill process', $proc);
                  kill(15, $proc);
               }
            }

            if ( !close($fh) ) {
               if ( $OS_ERROR ) {
                  warn "Error closing mysqlbinlog pipe: $OS_ERROR\n";
               }
               else {
                  MKDEBUG && _d('Exit status', $CHILD_ERROR,'from mysqlbinlog');
               }
            }
         }

         if ( oktorun() ) {
            $stats{sleep}++;
            sleep(1);
         }
      }
   };
   if ( $EVAL_ERROR ) {
      print $EVAL_ERROR;
   }

   # Print statistics
   if ( $o->get('statistics') ) {
      # Print operations in order of descending count, with percentage.
      my $maxlen = max(0, map { length($_) } keys %stats);
      my $total  = sum(0, values %stats);
      printf("# %-${maxlen}s \%10s %10s\n", qw(Action Count Pct));
      my $fmt = "# %-${maxlen}s \%10d %10.2f\n";
      foreach my $key (reverse sort { $stats{$a} <=> $stats{$b} } keys %stats) {
         printf($fmt, $key, $stats{$key}, $stats{$key} / $total * 100);
      }

      # Print normalized queries, their average exec times, times seen and times
      # executed.  Sort in order of times seen descending.
      foreach my $query (
         reverse sort {
            $query_stats{$a}->{seen} <=> $query_stats{$b}->{seen}
         } keys %query_stats
      ) {
         my $stats = $query_stats{$query};
         print
            "# query: ", $query, "\n# stats: ",
            join(' ',
               (map { "$_=" . ($stats->{$_} || '0') } qw(seen exec sum avg))),
            "\n";
      }
   }

   # Print normalized versions of the queries that caused errors.
   if ( $o->get('errors') == 1 ) {
      foreach my $query (
         reverse sort {
            $query_errors{$a} <=> $query_errors{$b} } keys %query_errors
      ) {
         print "# error $query_errors{$query} times: ", $query, "\n";
      }
   }

   return 0;
}

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

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

# It's ok to run if we haven't been told to stop, we haven't exceeded the
# time.  The parameter adds the further restriction that the slave must be
# running.
sub oktorun {
   my ( $only_if_slave_running ) = @_;
   $now = time();
   return (!$only_if_slave_running || $slave{running})
      && !-f $sentinel
      && ((!$time || $now < $end) && $oktorun);
}

# Whether we are far enough ahead of the slave.
sub not_far_enough_ahead {
   my ( $pos ) = @_;
   my $offset = $o->get('offset');
   if ( $pos < $slave{pos} + $offset ) {
      MKDEBUG && _d($pos, 'is not', $offset, 'ahead of', $slave{pos});
      $stats{not_far_enough_ahead}++;
      return 1;
   }
   return 0;
}

# Whether we are too far ahead of the slave.
sub too_far_ahead {
   my ( $pos ) = @_;
   return ($pos > $slave{pos} + $window);
}

# Whether we are too close to where the I/O thread is writing.
sub too_close_to_io {
   my ( $pos ) = @_;
   return $slave{lag} && $pos >= $slave{pos} + $slave{lag} - $o->get('io-log');
}

sub wait_for_master {
   my ( $dbh, $slave, $pos ) = @_;
   $stats{master_pos_wait}++;
   my $sql = "SELECT COALESCE(MASTER_POS_WAIT('$slave->{mfile}', "
      . ($slave->{mpos} + ($pos - $slave->{pos})) . ", 1), 0)";
   MKDEBUG && _d($sql);
   my $start = gettimeofday();
   my ($events) = $dbh->selectrow_array($sql);
   MKDEBUG && _d('Waited', (gettimeofday - $start), 'and got', $events);
   return $events;
}

# The average is weighted so we don't quit trying a statement when we have
# only a few samples.  So if we want to collect 16 samples and the first one
# is huge, it will be weighted as 1/16th of its size.
sub store_avg {
   my ( $query, $time ) = @_;
   MKDEBUG && _d('Execution time:', $query, $time);
   $query_stats{$query}->{samples} ||= [];
   my $samples = $query_stats{$query}->{samples};
   push @$samples, $time;
   if ( @$samples > $o->get('query-sample-size') ) {
      shift @$samples;
   }
   $query_stats{$query}->{avg} = sum(@$samples) / $o->get('query-sample-size');
   $query_stats{$query}->{exec}++;
   $query_stats{$query}->{sum} += $time;
   MKDEBUG && _d('Average time:', $query_stats{$query}->{avg});
}

sub have_seen_query {
   my ( $query ) = @_;
   return $query_stats{$query}->{seen};
}

sub get_avg {
   my ( $query ) = @_;
   $query_stats{$query}->{seen}++;
   return $query_stats{$query}->{avg} || 0;
}

sub get_status {
   my ( $dbh ) = @_;
   $stats{show_slave_status}++;
   my $status = $dbh->selectrow_hashref("SHOW SLAVE STATUS");
   if ( !$status || ! %$status ) {
      die "No output from SHOW SLAVE STATUS.\n";
   }
   my %status = (
      running => ($status->{slave_sql_running} || '') eq 'Yes',
      file    => $status->{relay_log_file},
      pos     => $status->{relay_log_pos},
                 # If the slave SQL thread is executing from the same log the
                 # I/O thread is reading from, in general (except when the
                 # master or slave starts a new binlog or relay log) we can tell
                 # how many bytes the SQL thread lags the I/O thread.
      lag     => $status->{master_log_file} eq $status->{relay_master_log_file}
               ? $status->{read_master_log_pos} - $status->{exec_master_log_pos}
               : 0,
      mfile   => $status->{relay_master_log_file},
      mpos    => $status->{exec_master_log_pos},
   );
   MKDEBUG && _d(Dumper(\%status));
   return %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-slave-prefetch - Pipeline relay logs on a MySQL slave to pre-warm caches.

=head1 SYNOPSIS

 mk-slave-prefetch
 mk-slave-prefetch --statistics > /path/to/saved/statistics
 mk-slave-prefetch /path/to/saved/statistics

=head1 DESCRIPTION

mk-slave-prefetch reads the slave's relay log slightly ahead of where the
slave's SQL thread is reading, converts statements into C<SELECT>, and
executes them.  In theory, this should help alleviate the effects of the
slave's single-threaded SQL execution.  It will help take advantage of
multiple CPUs and disks by pre-reading the data from disk, so the data is
already in the cache when the slave SQL thread executes the un-modified
version of the statement.

Statements that can't be converted into C<SELECT> are ignored.  However, there
is always a chance of bugs.  It would be a very good idea to connect as a
read-only user.  Here is an example of how to grant the necessary privileges:

   GRANT SELECT, REPLICATION CLIENT, REPLICATION SLAVE ON *.*
   TO 'prefetch'@'%' IDENTIFIED BY 'sp33dmeup!';

C<mk-slave-prefetch> learns how long it takes statements to execute, and doesn't
try to execute those that take a very long time.  You can ask it to print what
it has learned after it executes.  You can also specify a filename on the
command line.  The file should contain the statistics printed by a previous
run.  These will be used to pre-populate the statistics so it doesn't have to
re-learn.

This program is based on concepts I heard Paul Tuckfield explain at the November
2006 MySQL Camp un-conference.  However, the code is my own work.  I have not
seen any other implementation of Paul's idea.

=head1 DOES IT WORK?

Does it work?  Does it actually speed up the slave?

That depends on your workload, hardware, and other factors.  It might work when
the following are true:

=over

=item *

The slave's data is much larger than memory, and the workload is mostly randomly
scattered small (single-row is ideal) changes.

=item *

There are lots of high-concurrency C<UPDATE> and C<DELETE> statements on the
master.

=item *

The slave SQL thread is I/O-bound, but the slave overall has plenty of spare I/O
capacity (definitely more than one disk spindle).

=item *

The slave uses InnoDB or another storage engine with row-level locking.

=back

It does B<not> speed up replication on my slaves, which mostly have large
queries like C<INSERT .. SELECT .. GROUP BY>.  In my benchmarks it seemed to
make no difference at all, positive or negative.

On the wrong workload or slave configuration, this technique might actually make
the slaves slower.  Your mileage will vary.

User-contributed benchmarks are welcome.

=head1 DOWNLOADING

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

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

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

=head1 OPTIONS

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

=over

=item --ask-pass

Prompt for a password when connecting to MySQL.

=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 --check-interval

type: Array; default: 16,1,1024

How often to check the slave: init,min,max.  This many relay log events should
pass before checking the output of C<SHOW SLAVE STATUS>.  The syntax is a
three-number range: initial, minimum, and maximum.  You should be able to leave
this at the defaults.

C<mk-slave-prefetch> varies the check interval in powers of two, depending on
whether it decides the check was necessary.

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

Fork to the background and detach from the shell.  POSIX
operating systems only.

=item --database

short form: -D; type: string

The database to use for the connection.  The initial connection will be to this
database, but mk-slave-prefetch will issue C<USE> statements as required by the
binary log events.

=item --defaults-file

short form: -F; type: string

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

=item --errors

cumulative: yes

Print queries that caused errors.  If specified once, at exit; if twice, in
realtime.

If you specify this option once, you will see a report at the end of the script
execution, showing the normalized queries and the number of times they were
seen.  If you specify this option twice, you will see the errors printed out as
they occur, but no normalized report at the end of execution.

=item --[no]execute

default: yes

Execute the transformed queries to warm the caches.

=item --help

Show help and exit.

=item --host

short form: -h; type: string

Connect to host.

=item --io-lag

type: size; default: 1k

How many bytes to lag the slave I/O thread.  This helps avoid C<mysqlbinlog>
reading right off the end of the relay log file.

=item --log

type: string

Print all output to this file when daemonized.

=item --max-query-time

type: float; default: 1

Do not run queries longer than this many seconds; fractions allowed.  If
C<mk-slave-prefetch> predicts the query will take longer to execute, it will
skip the query.  This is based on the theory that pre-warming the cache is most
beneficial for short queries.

C<mk-slave-prefetch> learns how long queries require to execute.  It keeps an
average over the last L<"--query-sample-size"> samples of each query.  The
averages are based on an abstracted version of the query, with specific
parameters replaced by placeholders.  The result is a sort of "fingerprint"
for the query, not executable SQL.  You can see the learned statistics with the
L<"--statistics"> option.

You can pre-load query fingerprints, and average execution times, from a file.
This way you don't have to wait for C<mk-slave-prefetch> to learn all over
every time you start it.  Just specify the file on the command line.  The
format should be the same as the output from L<"--statistics">.

You might also want to filter out some statements completely, or let only some
statements through.  See the L<"--reject-regexp"> and L<"--permit-regexp">
options.

If C<mk-slave-prefetch> hasn't seen a query's fingerprint before, and thus
doesn't know how long it will take to execute, it wraps it in a subuery, like
this:

   SELECT 1 FROM ( <query> ) AS X LIMIT 1;

This helps avoid fetching a lot of data back to the client when a query is
very large.  It requires a version of MySQL that supports subqueries (version
4.1 and newer).  If yours doesn't, the subquery trick can't be used, so the
query might fetch a lot of data back to the client.

Once a query's fingerprint has been seen, so it's known that the query isn't
enormously slow, C<mk-slave-prefetch> just rewrites the C<SELECT> list for
efficiency.  (Avoiding the subquery reduces the query's overhead for short
queries).  The rewritten query will then look like the following;

   SELECT ISNULL(COALESCE(<columns>)) FROM ...

=item --num-prefix

Abstract away numeric table name prefixes.  This causes the following two
queries to "fingeprint" to the same thing:

  select from 1_2_users;
  select from 2_3_users;

=item --offset

type: size; default: 128

How many bytes C<mk-slave-prefetch> will try to stay in front of the slave SQL
thread.  It will not execute log events it doesn't think are at least this far
ahead of the SQL thread.  See also L<"--window">.

=item --password

short form: -p; type: string

Password to use when connecting.

=item --permit-regexp

type: string

Permit queries matching this Perl regexp.  This is a filter for log events.  The
regular expression is matched against the raw log event, before any
transformations are applied.  If specified, this option will permit only log
events matching the regular expression.

=item --pid

type: string

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

=item --port

short form: -P; type: int

Port number to use for connection.

=item --print

Print the transformed relay log events to standard output.

=item --print-nonrewritten

Print queries that could not be transformed into C<SELECT>.

=item --progress

type: int

Print progress information every X events.  The information is the current log
file and position, plus a summary of the statistics gathered.

=item --query-sample-size

type: int; default: 4

Average query exec time over this many queries.  The last C<N> queries with a
given fingerprint are averaged together to get the average query execution time
(see L<"--max-query-time">).  

=item --reject-regexp

type: string

Reject queries matching this Perl regexp.  Similar to L<"--permit-regexp">, but
has the opposite effect: log events must B<not> match the regular expression.

=item --run-time

type: time

How long C<mk-slave-prefetch> should run before exiting.  The default is to run forever.

=item --sentinel

type: string; default: /tmp/mk-slave-prefetch-sentinel

Exit if this file exists.

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

short form: -S; type: string

Socket file to use for connection.

=item --statistics

Print execution statistics after exiting.  The statistics are in two sections:
counters, and queries.  The counters simply count the number of times events
occur.  You may see the following counters:

   NAME                    MEANING
   ======================  =======================================
   mysqlbinlog             Executed mysqlbinlog to read log events.
   events                  The total number of relay log events.
   not_far_enough_ahead    An event was not at least --offset
                           bytes ahead of the SQL thread.
   too_far_ahead           An event was more than --offset
                           + --window bytes ahead of the SQL thread.
   too_close_to_io_thread  An event was less than --iolag bytes
                           away from the I/O thread's position.
   event_not_allowed       An event wasn't a SET, USE, INSERT,
                           UPDATE, DELETE or REPLACE query.
   event_filtered_out      An event was filtered out because of
                           --permitregexp or --rejectregexp.
   same_timestamp          A SET TIMESTAMP event was ignored because
                           it had the same timestamp as the last one.
   do_query                A transformed event was executed
                           or printed.
   query_error             An executed query had an error.
   query_too_long          An event was not executed because its
                           average query length exceeded
                           --maxquerytime.
   query_not_rewritten     A query could not be rewritten to a
                           SELECT.
   master_pos_wait         The tool waited for the SQL thread to
                           catch up.
   show_slave_status       The tool queried SHOW SLAVE STATUS.
   load_data_infile        The tool found a LOAD DATA INFILE query
                           and unlinked (deleted) the temp file.
   could_not_unlink        The tool failed to unlink a temp file.
   sleep                   The tool slept for a second because the 
                           slave's SQL thread was not running, or
                           because it read past the end of the log.

After the counters, C<mk-slave-prefetch> prints information about each query
fingerprint it has seen, two lines per fingerprint.  The first line contains
the query's fingerprint.  The second line contains the number of times the
fingerprint was seen, number of times executed, the sum of the execution
times, and the average execution time over the last L<"--query-sample-size">
samples.

=item --stop

Stop running instances by creating the L<"--sentinel"> file.

=item --tmpdir

type: string; default: /dev/null

Where to create temp files for C<LOAD DATA INFILE> queries.  The default will
cause C<mysqlbinlog> to skip the file and the associated C<LOAD DATA INFILE>
command entirely.

If C<mk-slave-prefetch> sees a C<LOAD DATA INFILE> command (which it won't, if
this is left at the default), it will try to remove the temporary file, then
skip the event.

=item --user

short form: -u; type: string

User for login if not current user.

=item --version

Show version and exit.

=item --window

type: size; default: 4k

The max bytes ahead of the slave C<mk-slave-prefetch> should get.  Defines the
window within which C<mk-slave-prefetch> considers a query OK to execute.  The
window begins at the slave SQL thread's last known position plus L<"--offset">
bytes, and extends for the specified number of bytes.

If C<mk-slave-prefetch> sees a log event that is too far in the future, it will
increment the C<too_far_ahead> counter and wait for the slave SQL thread to
catch up (which increments the C<master_pos_wait> counter).  If an event isn't
far enough ahead of the SQL thread, it will be discarded and the
C<not_far_enough_ahead> counter increments.

Watching the mentioned statistics can help you understand how to tune the
window.  You want C<mk-slave-prefetch> to run just ahead of the SQL thread, not
throwing out a lot of events for being too far ahead or not far enough ahead.

=back

=head1 SYSTEM REQUIREMENTS

You need Perl, DBI, DBD::mysql, and some core packages that ought to be
installed in any reasonably new version of Perl.

=head1 ENVIRONMENT

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

   MKDEBUG=1 mk-....

=head1 BUGS

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

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

=head1 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright 2007-2009 Baron Schwartz.
Feedback and improvements are welcome.

THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA  02111-1307  USA.

=head1 AUTHOR

Baron Schwartz.

=head1 VERSION

This manual page documents Ver 1.0.8 Distrib 3722 $Revision: 3706 $.

=cut
