#!/usr/bin/env perl

# This is mk-slave-restart, a program to watch replication and try to
# restart slaves on errors.
#
# This program is copyright 2007-2008 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.9';
our $DISTRIB = '2442';
our $SVN_REV = sprintf("%d", (q$Revision: 2311 $ =~ m/(\d+)/g, 0));

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

package Quoter;

use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

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

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

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

1;

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

# ###########################################################################
# OptionParser package 2300
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package OptionParser;

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, @opts ) = @_;
   my %key_seen;
   my %long_seen;
   my %key_for;
   my %defaults;
   my @mutex;
   my @atleast1;
   my %long_for;
   my %disables;
   my %copyfrom;
   my @allowed_with;
   unshift @opts,
      { s => 'help',    d => 'Show this help message' },
      { s => 'version', d => 'Output version information and exit' };
   foreach my $opt ( @opts ) {
      if ( ref $opt ) {
         my ( $long, $short ) = $opt->{s} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
         $opt->{k} = $short || $long;
         $key_for{$long} = $opt->{k};
         $long_for{$opt->{k}} = $long;
         $long_for{$long} = $long;
         $opt->{l} = $long;
         die "Duplicate option $opt->{k}" if $key_seen{$opt->{k}}++;
         die "Duplicate long option $opt->{l}" if $long_seen{$opt->{l}}++;
         $opt->{t} = $short;
         $opt->{n} = $opt->{s} =~ m/!/;
         $opt->{g} ||= 'o';
         if ( (my ($y) = $opt->{s} =~ m/=([mdHhAaz])/) ) {
            MKDEBUG && _d("Option $opt->{k} type: $y");
            $opt->{y} = $y;
            $opt->{s} =~ s/=./=s/;
         }
         if ( $opt->{d} =~ m/required/ ) {
            $opt->{r} = 1;
            MKDEBUG && _d("Option $opt->{k} is required");
         }
         if ( (my ($def) = $opt->{d} =~ m/default\b(?: ([^)]+))?/) ) {
            $defaults{$opt->{k}} = defined $def ? $def : 1;
            MKDEBUG && _d("Option $opt->{k} has a default");
         }
         if ( (my ($dis) = $opt->{d} =~ m/(disables .*)/) ) {
            $disables{$opt->{k}} = [ $class->get_participants($dis) ];
            MKDEBUG && _d("Option $opt->{k} $dis");
         }
      }
      else { # It's an instruction.

         if ( $opt =~ m/at least one|mutually exclusive|one and only one/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $long_for{$_};
               } $class->get_participants($opt);
            if ( $opt =~ m/mutually exclusive|one and only one/ ) {
               push @mutex, \@participants;
               MKDEBUG && _d(@participants, ' are mutually exclusive');
            }
            if ( $opt =~ m/at least one|one and only one/ ) {
               push @atleast1, \@participants;
               MKDEBUG && _d(@participants, ' require at least one');
            }
         }
         elsif ( $opt =~ m/default to/ ) {
            my @participants = map {
                  die "No such option '$_' in $opt" unless $long_for{$_};
                  $key_for{$_};
               } $class->get_participants($opt);
            $copyfrom{$participants[0]} = $participants[1];
            MKDEBUG && _d(@participants, ' copy from each other');
         }
         elsif ( $opt  =~ m/allowed with/ ) {
            my @participants = map {
                  die "No such option '$_' while processing $opt"
                     unless $long_for{$_};
                  $key_for{$_};
               } $class->get_participants($opt);
            push @allowed_with, \@participants;
         }

      }
   }

   foreach my $dis ( keys %disables ) {
      $disables{$dis} = [
            map {
               if ( !defined $long_for{$_} ) {
                  die "No such option '$_' while processing $dis";
               }
               $long_for{$_};
            } @{$disables{$dis}}
      ];
   }

   my $self = {
      specs        => [ grep { ref $_ } @opts ],
      notes        => [],
      instr        => [ grep { !ref $_ } @opts ],
      mutex        => \@mutex,
      defaults     => \%defaults,
      long_for     => \%long_for,
      atleast1     => \@atleast1,
      disables     => \%disables,
      key_for      => \%key_for,
      copyfrom     => \%copyfrom,
      strict       => 1,
      groups       => [ { k => 'o', d => 'Options' } ],
      allowed_with => \@allowed_with,
   };

   return bless $self, $class;
}

sub get_participants {
   my ( $self, $str ) = @_;
   my @participants;
   foreach my $thing ( $str =~ m/(--?[\w-]+)/g ) {
      if ( (my ($long) = $thing =~ m/--(.+)/) ) {
         push @participants, $long;
      }
      else {
         foreach my $short ( $thing =~ m/([^-])/g ) {
            push @participants, $short;
         }
      }
   }
   MKDEBUG && _d("Participants for $str: ", @participants);
   return @participants;
}

sub parse {
   my ( $self, %defaults ) = @_;
   my @specs = @{$self->{specs}};
   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);

   my %opt_seen;
   my %vals = %{$self->{defaults}};
   @vals{keys %defaults} = values %defaults;
   foreach my $spec ( @specs ) {
      $vals{$spec->{k}} = undef unless defined $vals{$spec->{k}};
      $opt_seen{$spec->{k}} = 1;
   }

   foreach my $key ( keys %defaults ) {
      die "Cannot set default for non-existent option '$key'\n"
         unless $opt_seen{$key};
   }

   Getopt::Long::Configure('no_ignore_case', 'bundling');
   GetOptions( map { $_->{s} => \$vals{$_->{k}} } @specs )
      or $self->error('Error parsing options');

   if ( $vals{version} ) {
      my $prog = $self->prog;
      printf("%s  Ver %s Distrib %s Changeset %s\n",
         $prog, $main::VERSION, $main::DISTRIB, $main::SVN_REV)
         or die "Cannot print: $OS_ERROR";
      exit(0);
   }

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

   foreach my $dis ( grep { defined $vals{$_} } keys %{$self->{disables}} ) {
      my @disses = map { $self->{key_for}->{$_} } @{$self->{disables}->{$dis}};
      MKDEBUG && _d("Unsetting options: ", @disses);
      @vals{@disses} = map { undef } @disses;
   }

   foreach my $spec ( grep { $_->{r} } @specs ) {
      if ( !defined $vals{$spec->{k}} ) {
         $self->error("Required option --$spec->{l} must be specified");
      }
   }

   foreach my $mutex ( @{$self->{mutex}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$mutex;
      if ( @set > 1 ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$mutex}[ 0 .. scalar(@$mutex) - 2] );
         $note .= " and --$self->{long_for}->{$mutex->[-1]}"
               . " are mutually exclusive.";
         $self->error($note);
      }
   }

   foreach my $required ( @{$self->{atleast1}} ) {
      my @set = grep { defined $vals{$self->{key_for}->{$_}} } @$required;
      if ( !@set ) {
         my $note = join(', ',
            map { "--$self->{long_for}->{$_}" }
                @{$required}[ 0 .. scalar(@$required) - 2] );
         $note .= " or --$self->{long_for}->{$required->[-1]}";
         $self->error("Specify at least one of $note");
      }
   }

   foreach my $spec ( grep { $_->{y} && defined $vals{$_->{k}} } @specs ) {
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'm' ) {
         my ( $num, $suffix ) = $val =~ m/(\d+)([a-z])?$/;
         if ( !$suffix ) {
            my ( $s ) = $spec->{d} =~ m/\(suffix (.)\)/;
            $suffix = $s || 's';
            MKDEBUG && _d("No suffix given; using $suffix for $spec->{k} "
               . "(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
            $vals{$spec->{k}} = $val;
            MKDEBUG && _d("Setting option $spec->{k} to $val");
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
      elsif ( $spec->{y} eq 'd' ) {
         MKDEBUG && _d("Parsing option $spec->{y} as a DSN");
         my $from_key = $self->{copyfrom}->{$spec->{k}};
         my $default = {};
         if ( $from_key ) {
            MKDEBUG && _d("Option $spec->{y} DSN copies from option $from_key");
            $default = $self->{dsn}->parse($self->{dsn}->as_string($vals{$from_key}));
         }
         $vals{$spec->{k}} = $self->{dsn}->parse($val, $default);
      }
      elsif ( $spec->{y} eq 'z' ) {
         my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
         if ( defined $num ) {
            if ( $factor ) {
               $num *= $factor_for{$factor};
               MKDEBUG && _d("Setting option $spec->{y} to num * factor");
            }
            $vals{$spec->{k}} = ($pre || '') . $num;
         }
         else {
            $self->error("Invalid --$spec->{l} argument");
         }
      }
   }

   foreach my $spec ( grep { $_->{y} } @specs ) {
      MKDEBUG && _d("Treating option $spec->{k} as a list");
      my $val = $vals{$spec->{k}};
      if ( $spec->{y} eq 'H' || (defined $val && $spec->{y} eq 'h') ) {
         $vals{$spec->{k}} = { map { $_ => 1 } split(',', ($val || '')) };
      }
      elsif ( $spec->{y} eq 'A' || (defined $val && $spec->{y} eq 'a') ) {
         $vals{$spec->{k}} = [ split(',', ($val || '')) ];
      }
   }

   foreach my $allowed_opts ( @{ $self->{allowed_with} } ) {
      my $opt = $allowed_opts->[0];
      next if !defined $vals{$opt};
      my %defined_opts = map { $_ => 1 } grep { defined $vals{$_} } keys %vals;
      delete @defined_opts{ @$allowed_opts };
      foreach my $defined_opt ( keys %defined_opts ) {
         MKDEBUG
            && _d("Unsetting options: $defined_opt (not allowed with $opt)");
         $vals{$defined_opt} = undef;
      }
   }

   return %vals;
}

sub error {
   my ( $self, $note ) = @_;
   $self->{__error__} = 1;
   push @{$self->{notes}}, $note;
}

sub prog {
   (my $prog) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
   return $prog || $PROGRAM_NAME;
}

sub prompt {
   my ( $self ) = @_;
   my $prog   = $self->prog;
   my $prompt = $self->{prompt} || '<options>';
   return "Usage: $prog $prompt\n";
}

sub descr {
   my ( $self ) = @_;
   my $prog = $self->prog;
   my $descr  = $prog . ' ' . ($self->{descr} || '')
          . "  For more details, please use the --help option, "
          . "or try 'perldoc $prog' for complete documentation.";
   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g);
   $descr =~ s/ +$//mg;
   return $descr;
}

sub usage_or_errors {
   my ( $self, %opts ) = @_;
   if ( $opts{help} ) {
      print $self->usage(%opts)
         or die "Cannot print: $OS_ERROR";
      exit(0);
   }
   elsif ( $self->{__error__} ) {
      print $self->errors()
         or die "Cannot print: $OS_ERROR";
      exit(0);
   }
}

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

sub usage {
   my ( $self, %vals ) = @_;
   my @specs = @{$self->{specs}};

   my $maxl = max(map { length($_->{l}) + ($_->{n} ? 4 : 0)} @specs);

   my $maxs = max(0,
      map { length($_->{l}) + ($_->{n} ? 4 : 0)}
      grep { $_->{t} } @specs);

   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();
   foreach my $g ( @{$self->{groups}} ) {
      $usage .= "\n$g->{d}:\n";
      foreach my $spec (
         sort { $a->{l} cmp $b->{l} } grep { $_->{g} eq $g->{k} } @specs )
      {
         my $long  = $spec->{n} ? "[no]$spec->{l}" : $spec->{l};
         my $short = $spec->{t};
         my $desc  = $spec->{d};
         if ( $spec->{y} && $spec->{y} 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 @instr = @{$self->{instr}}) ) {
      $usage .= join("\n", map { "  $_" } @instr) . "\n";
   }
   if ( $self->{dsn} ) {
      $usage .= "\n" . $self->{dsn}->usage();
   }
   $usage .= "\nOptions and values after processing arguments:\n";
   foreach my $spec ( sort { $a->{l} cmp $b->{l} } @specs ) {
      my $val   = $vals{$spec->{k}};
      my $type  = $spec->{y} || '';
      my $bool  = $spec->{s} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
      $val      = $bool                     ? ( $val ? 'TRUE' : 'FALSE' )
                : !defined $val             ? '(No value)'
                : $type eq 'd'              ? $self->{dsn}->as_string($val)
                : $type =~ m/H|h/           ? join(',', sort keys %$val)
                : $type =~ m/A|a/           ? join(',', @$val)
                :                             $val;
      $usage .= sprintf("  --%-${lcol}s  %s\n", $spec->{l}, $val);
   }
   return $usage;
}

sub pod_to_spec {
   my ( $self, $file ) = @_;

   my %types = (
      'time' => 'm',
      'int'  => 'i',
      string => 's',
      hash   => 'h',
      Hash   => 'H',
      array  => 'a',
      Array  => 'A',
      size   => 'z',
      DSN    => 'd',
      float  => 'f',
   );

   my @spec = ();
   my @special_options = ();
   $file ||= __FILE__;
   open my $fh, "<", $file or die "Can't open $file: $OS_ERROR";
   my $para;
   my $option;

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

   while ( $para = <$fh> ) {
      MKDEBUG && _d($para);
      last if $para =~ m/^=over/;
      chomp $para;
      $para =~ s/\s+/ /g;
      $para =~ s/$POD_link_re/$1/go;
      push @special_options, $para;
   }

   do {
      if ( ($option) = $para =~ m/^=item --(.*)/ ) {
         MKDEBUG && _d($para);
         my %props;
         $para = <$fh>;
         if ( $para =~ m/: / ) {
            $para =~ s/\s+\Z//g;
            %props = map { split(/: /, $_) } split(/; /, $para);
            if ( $props{'short form'} ) {
               $props{'short form'} =~ s/-//;
            }
            $para = <$fh>;
         }
         $para =~ s/\s+\Z//g;
         $para =~ s/\s+/ /g;
         $para =~ s/$POD_link_re/$1/go;
         if ( $para =~ m/^[^.]+\.$/ ) {
            $para =~ s/\.$//;
         }
         push @spec, {
            s => $option
               . ( $props{'short form'} ? '|' . $props{'short form'} : '' )
               . ( $props{'negatable'}  ? '!'                        : '' )
               . ( $props{'cumulative'} ? '+'                        : '' )
               . ( $props{type}         ? '=' . $types{$props{type}} : '' ),
            d => $para
               . (defined $props{default} ? " (default $props{default})" : ''),
         };
      }
      while ( $para = <$fh> ) {
         last unless $para;

         if ( $option ) {
            if ( my ($line)
                  = $para =~ m/(allowed with --$option[:]?.*?)\./ ) {
               1 while ( $line =~ s/$POD_link_re/$1/go );
               push @special_options, $line;
            }
         }

         if ( $para =~ m/^=head1/ ) {
            $para = undef; # Can't 'last' out of a do {} block.
            last;
         }
         last if $para =~ m/^=item --/;
      }
   } while ( $para );

   close $fh;
   return @spec, @special_options;
}

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

sub groups {
   my ( $self, @groups ) = @_;
   push @{$self->{groups}}, @groups;
}

sub _d {
   my ( $line ) = (caller(0))[2];
   print "# OptionParser:$line $PID ", @_, "\n";
}

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

1;

# ###########################################################################
# End OptionParser package
# ###########################################################################

# ###########################################################################
# VersionParser package 2215
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package VersionParser;

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 ( $line ) = (caller(0))[2];
   print "# VersionParser:$line $PID ", @_, "\n";
}

1;

# ###########################################################################
# End VersionParser package
# ###########################################################################

# ###########################################################################
# DSNParser package 2215
# ###########################################################################
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 %vals;
   my %opts = %{$self->{opts}};
   if ( $dsn !~ m/=/ && (my $p = $self->prop('autokey')) ) {
      MKDEBUG && _d("Interpreting $dsn as $p=$dsn");
      $dsn = "$p=$dsn";
   }
   my %hash = map { m/^(.)=(.*)$/g } split(/,/, $dsn);
   foreach my $key ( keys %opts ) {
      MKDEBUG && _d("Finding value for $key");
      $vals{$key} = $hash{$key};
      if ( !defined $vals{$key} && defined $prev->{$key} && $opts{$key}->{copy} ) {
         $vals{$key} = $prev->{$key};
         MKDEBUG && _d("Copying value for $key from previous DSN");
      }
      if ( !defined $vals{$key} ) {
         $vals{$key} = $defaults->{$key};
         MKDEBUG && _d("Copying value for $key from defaults");
      }
   }
   foreach my $key ( keys %hash ) {
      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 $vals{$key};
      }
   }
   return \%vals;
}

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"
      . "  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=mysql';
   }
   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;
   MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, ' {',
      join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ), '}');
   my $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
   if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
      my $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";
      }
   }
   my $setvars = $self->prop('setvars');
   if ( $cxn_string =~ m/mysql/i && $setvars ) {
      my $sql = "SET $setvars";
      MKDEBUG && _d("$dbh: $sql");
      $dbh->do($sql);
   }
   MKDEBUG && _d('DBH info: ',
      $dbh,
      Dumper($dbh->selectrow_hashref(
         'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
      ' Connection info: ', ($dbh->{mysql_hostinfo} || 'undef'),
      ' 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 _d {
   my ( $line ) = (caller(0))[2];
   @_ = map { defined $_ ? $_ : 'undef' } @_;
   print "# DSNParser:$line $PID ", @_, "\n";
}

1;

# ###########################################################################
# End DSNParser package
# ###########################################################################

# ###########################################################################
# MasterSlave package 2215
# ###########################################################################
use strict;
use warnings FATAL => 'all';

package MasterSlave;

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

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   bless {}, shift;
}

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

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

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

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

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

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

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

sub find_slave_hosts {
   my ( $self, $dsn_parser, $dbh, $dsn, $method ) = @_;
   $method ||= '';
   MKDEBUG && _d('Looking for slaves on ', $dsn_parser->as_string($dsn));

   my @slaves;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sub get_master_status {
   my ( $self, $dbh ) = @_;
   if ( !$self->{not_a_master}->{$dbh} ) {
      my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS}
            ||= $dbh->prepare('SHOW MASTER STATUS');
      MKDEBUG && _d($dbh, 'SHOW MASTER STATUS');
      $sth->execute();
      my ($ms) = @{$sth->fetchall_arrayref({})};

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

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

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

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

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

sub catchup_to_master {
   my ( $self, $slave, $master, $time ) = @_;
   $self->stop_slave($master);
   $self->stop_slave($slave);
   my $slave_status  = $self->get_slave_status($slave);
   my $slave_pos     = $self->repl_posn($slave_status);
   my $master_status = $self->get_master_status($master);
   my $master_pos    = $self->repl_posn($master_status);
   MKDEBUG && _d("Master position: ", $self->pos_to_string($master_pos),
      " Slave position: ", $self->pos_to_string($slave_pos));
   if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) {
      MKDEBUG && _d('Waiting for slave to catch up to master');
      $self->start_slave($slave, $master_pos);
      eval {
         $self->wait_for_master($master, $slave, $time, 0, $master_status);
      };
      if ( $EVAL_ERROR ) {
         MKDEBUG && _d($EVAL_ERROR);
         if ( $EVAL_ERROR =~ m/MASTER_POS_WAIT returned NULL/ ) {
            $slave_status = $self->get_slave_status($slave);
            if ( !$self->slave_is_running($slave_status) ) {
               $slave_pos = $self->repl_posn($slave_status);
               if ( $self->pos_cmp($slave_pos, $master_pos) != 0 ) {
                  die "$EVAL_ERROR but slave has not caught up to master";
               }
               MKDEBUG && _d('Slave is caught up to master and stopped');
            }
            else {
               die "$EVAL_ERROR but slave was still running";
            }
         }
         else {
            die $EVAL_ERROR;
         }
      }
   }
}

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

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

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

}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

sub _d {
   my ( $line ) = (caller(0))[2];
   print "# MasterSlave:$line $PID ", @_, "\n";
}

1;

# ###########################################################################
# End MasterSlave package
# ###########################################################################

# ###########################################################################
# Daemon package 2228
# ###########################################################################

package Daemon;

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

use POSIX;
use English qw(-no_match_vars);

use constant MKDEBUG => $ENV{MKDEBUG};

sub new {
   my ( $class, %args ) = @_;
   my $self = { %args };
   $self->{reopen_STDIN}  ||= '/dev/null';
   $self->{reopen_STDOUT} ||= '/dev/null';
   $self->{reopen_STDERR} ||= '&STDOUT';

   $self->{PID_file}        = undef;

   return bless $self, $class;
}

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

   defined( my $pid = fork ) or die "Can't fork: $OS_ERROR";
   exit if $pid;
   POSIX::setsid() or die "Can't start a new session: $OS_ERROR";

   chdir '/' or die "Can't chdir to /: $OS_ERROR";

   open STDIN,  "$self->{reopen_STDIN}",
      or die "Cannot reopen STDIN $self->{reopen_STDIN}: $OS_ERROR";
   open STDOUT, ">$self->{reopen_STDOUT}"
      or die "Cannot reopen STDOUT >$self->{reopen_STDOUT}: $OS_ERROR";
   open STDERR, ">$self->{reopen_STDERR}"
      or die "Cannot reopen STDERR >$self->{reopen_STDERR}: $OS_ERROR";


   return;
}

sub create_PID_file {
   my ( $self, $PID_file ) = @_;
   return if !$PID_file;
   $self->{PID_file} = $PID_file; # save for unlink in DESTORY()
   open my $PID_FILE, "+> $self->{PID_file}"
      or die "Cannot open PID file '$self->{PID_file}': $OS_ERROR";
   print $PID_FILE $PID;
   close $PID_FILE
      or die "Cannot close PID file '$self->{PID_file}': $OS_ERROR";
   return;
}

sub remove_PID_file {
   my ( $self ) = @_;
   if ( defined $self->{PID_file} ) {
      unlink $self->{PID_file}
         or warn "Cannot remove PID file '$self->{PID_file}': $OS_ERROR";
   }
   return;
}

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

1;

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

package main;

use English qw(-no_match_vars);
use IO::File;
use List::Util qw(min max);
use Time::HiRes qw(sleep);
use sigtrap qw(handler finish untrapped normal-signals);

use constant MKDEBUG => $ENV{MKDEBUG};

$OUTPUT_AUTOFLUSH = 1;

# ############################################################################
# Get configuration information.
# ############################################################################

my $dp = new DSNParser();
my $vp = new VersionParser();

my @opt_spec   = OptionParser::pod_to_spec();
my $opt_parser = new OptionParser(@opt_spec);
$opt_parser->{prompt} = '<options>';
$opt_parser->{descr}  = 'watches one or more MySQL replication slaves for '
                      . 'errors, and tries to restart replication if it stops.';
my %opts = $opt_parser->parse();
$dp->prop('setvars', $opts{setvars});

$opts{v} = 0 if $opts{q};

if ( !$opts{help} ) {
   if ( $opts{untilmaster} ) {
      if ( $opts{untilmaster} !~ m/^[.\w-]+,\d+$/ ) {
         $opt_parser->error("Invalid --untilmaster argument, must be file,pos");
      }
   }
   if ( $opts{untilrelay} ) {
      if ( $opts{untilrelay} !~ m/^[.\w-]+,\d+$/ ) {
         $opt_parser->error("Invalid --untilrelay argument, must be file,pos");
      }
   }
}

# --stop disables --monitor unless --monitor is explicitly given
if ( defined $opts{stop} ) {
   # Have to disable monitor because it is enabled by default.
   # Problem is: $opts{monitor} is always set: 'yes' by default
   # when not given on cmd line, '1' when given on cmd line.
   # That's why here we must check that it eq '1', i.e. that it was
   # explicitly given.
   $opts{monitor} = 0 unless $opts{monitor} eq '1';
}


$opt_parser->usage_or_errors(%opts);

# ############################################################################
# First things first: if --stop was given, create the sentinel file.
# ############################################################################
if ( $opts{stop} ) {
   MKDEBUG && _d("Creating sentinel file $opts{sentinel}");
   my $file = IO::File->new($opts{sentinel}, ">>")
      or die "Cannot open $opts{sentinel}: $OS_ERROR\n";
   print $file "Remove this file to permit mk-slave-restart to run\n"
      or die "Cannot write to $opts{sentinel}: $OS_ERROR\n";
   close $file
      or die "Cannot close $opts{sentinel}: $OS_ERROR\n";
   print STDOUT "Successfully created file $opts{sentinel}\n"
      unless $opts{q};
   # Exit unlesss --monitor is given.
   if ( !$opts{monitor} ) {
      MKDEBUG && _d("Nothing more to do, quitting");
      exit(0);
   }
   else {
      # Wait for all other running instances to quit, assuming they have the
      # same --interval as this invocation.  Then remove the file and
      # continue.
      MKDEBUG && _d("Waiting for other instances to quit");
      sleep($opts{M});
      MKDEBUG && _d("Unlinking $opts{sentinel}");
      unlink $opts{sentinel}
         or die "Cannot unlink $opts{sentinel}: $OS_ERROR";
   }
}

# ############################################################################
# Lookup tables of things to do when a problem is detected.
# ############################################################################

my @error_patterns = (
   [ qr/You have an error in your SQL/         => 'refetch_relay_log' ],
   [ qr/Could not parse relay log event entry/ => 'refetch_relay_log' ],
   [ qr/Incorrect key file for table/          => 'repair_table'      ],
   # This must be the last one.  It's a catch-all rule: skip and restart.
   [ qr/./                                     => 'skip'              ],
);

# TODO: let the user specify more patterns and actions.

# ############################################################################
# Connect and go to work.
# ############################################################################
if ( $opts{askpass} ) {
   $opts{p} = OptionParser::prompt_noecho("Enter password: ");
}
my $dbh = $dp->get_dbh($dp->get_cxn_params(\%opts), { AutoCommit => 1, } );

$dbh->{InactiveDestroy}  = 1;         # Don't disconnect on fork/daemonize

# Daemonize only after connecting and doing --askpass.
my $daemon;
if ( $opts{daemonize} ) {
   my $outfile = MKDEBUG
                 ? '/tmp/' . OptionParser::prog() . '.debug'
                 : '/dev/null';
   $daemon = new Daemon( reopen_STDOUT => "$outfile" )
      or die "Cannot daemonize: $OS_ERROR";
   $daemon->daemonize();
   if ( defined $opts{pid} ) {
      $daemon->create_PID_file( $opts{pid} );
   } 
   # I'm a daemon now.
   $opts{v} = MKDEBUG ? 4 : 0;
}

my $exit_status = 0;
my %children;
my @servers_to_watch;
my $q = new Quoter();

# Despite the name, recursing to slaves actually begins at the specified
# server, so the named server may also be watched, if it's a slave.
my $ms = new MasterSlave();
$ms->recurse_to_slaves(
   {  dbh        => $dbh,
      dsn        => \%opts,
      dsn_parser => $dp,
      recurse    => $opts{r} || 0,
      callback   => sub {
         my ( $dsn, $dbh, $level ) = @_;
         # Test whether we want to watch this server.
         eval {
            my $stat = $ms->get_slave_status($dbh);
            if ( $stat ) {
               push @servers_to_watch, { dsn => $dsn, dbh => $dbh };
            }
            else {
               die "could not find slave status on this server\n";
            }
         };
         if ( $EVAL_ERROR ) {
            chomp $EVAL_ERROR;
            MKDEBUG && _d('Not watching ', $dp->as_string($dsn),
               ' because ', $EVAL_ERROR);
         }
      },
      skip_callback => sub {
         my ( $dsn, $dbh, $level ) = @_;
         print STDERR "Skipping ", $dp->as_string($dsn), "\n";
      },
   }
);

# Watch each server found.
my $must_fork = @servers_to_watch > 1;
foreach my $host ( @servers_to_watch ) {

   $host->{dbh}->{InactiveDestroy}  = 1;         # Don't disconnect on fork

   # Fork, but only if there might be more than one host to watch.
   my $pid = $must_fork ? fork() : undef;
   if ( !$must_fork || (defined($pid) && $pid == 0) ) {
      # I either forked and I'm a child, or I didn't fork... confusing, eh?
      watch_server($host->{dsn}, $host->{dbh}, $must_fork);
   }
   elsif ( $must_fork && !defined($pid) ) {
      die("Unable to fork!");
   }
   # I already exited if I'm a child, so I'm the parent.  (Or maybe I never
   # forked).
   $children{$dp->as_string($host->{dsn})} = $pid if $must_fork;
}

MKDEBUG && _d('Child PIDs: ' . join(', ', values %children));
# Wait for the children to exit.
foreach my $host ( keys %children ) {
   MKDEBUG && _d('Waiting to reap ', $host);
   my $pid = waitpid($children{$host}, 0);
   $exit_status ||= $CHILD_ERROR >> 8;
}

$dp->disconnect($dbh);
exit($exit_status);

# ############################################################################
# Subroutines.
# ############################################################################

# Actually watch a server.  If many instances are being watched, this is
# fork()ed.
sub watch_server {
   my ( $dsn, $dbh, $was_forked ) = @_;

   MKDEBUG && _d('Watching server ', $dp->as_string($dsn),
      " forked=$was_forked");

   my $start_sql = $vp->version_ge($dbh, '4.0.5')
                 ? 'START SLAVE' : 'SLAVE START';
   if ( $opts{untilmaster} ) {
      my ( $file, $pos ) = split(',', $opts{untilmaster});
      $start_sql .= " UNTIL MASTER_LOG_FILE = '$file', MASTER_LOG_POS = $pos";
   }
   elsif ( $opts{untilrelay} ) {
      my ( $file, $pos ) = split(',', $opts{untilrelay});
      $start_sql .= " UNTIL RELAY_LOG_FILE = '$file', RELAY_LOG_POS = $pos";
   }

   my $set_skip   = $dbh->prepare(
                    "SET GLOBAL SQL_SLAVE_SKIP_COUNTER = $opts{k}");
   my $start      = $dbh->prepare($start_sql);
   my $stop       = $dbh->prepare('STOP SLAVE');
   my $chmt       = $dbh->prepare(
                    'CHANGE MASTER TO MASTER_LOG_FILE=?, MASTER_LOG_POS=?');

   # ########################################################################
   # These are actions to take when an error is found.
   # ########################################################################
   my %actions = (
      refetch_relay_log => sub {
         my ( $stat, $dbh ) = @_;
         MKDEBUG && _d('Found relay log corruption');
         # Can't do CHANGE MASTER TO with a running slave.
         $stop->execute();
         $chmt->execute(
            @{$stat}{qw(relay_master_log_file exec_master_log_pos)});
      },
      skip => sub {
         my ( $stat, $dbh ) = @_;
         MKDEBUG && _d('Found non-relay-log error');
         $set_skip->execute();
      },
      repair_table => sub {
         my ( $stat, $dbh ) = @_;
         MKDEBUG && _d('Found corrupt table');
         # [ qr/Incorrect key file for table './foo/bar.MYI'
         my ( $db, $tbl ) = $stat->{last_error} =~ m!([^/]+)/(.*?)\.MYI!;
         if ( $db && $tbl ) {
            my $sql = "REPAIR TABLE " . $q->quote($db, $tbl);
            MKDEBUG && _d($sql);
            $dbh->do($sql);
         }
      },
   );

   my $exit_time = time() + ($opts{t} || 0);
   my $sleep = $opts{s};
   my ($last_log, $last_pos);

   my $stat = {}; # Will hold SHOW SLAVE STATUS
   STAT:
   while ($stat && (!$opts{t} || time() < $exit_time) && !-f $opts{sentinel}) {
      my $increase_sleep = 1;
      $stat = $ms->get_slave_status($dbh);
      if ( !$stat ) {
         print STDERR "No SLAVE STATUS output found on ",
            $dp->as_string($dsn), "\n";
         next STAT;
      }

      if ( !$last_log
         || $last_log ne $stat->{relay_log_file}   # Avoid infinite loops
         || $last_pos != $stat->{relay_log_pos}
      ) {
         $stat->{slave_sql_running} ||= 'No';
         $stat->{last_error}        ||= '';
         $stat->{last_errno}        ||= 0;

         if ( $opts{untilmaster} && pos_ge($stat, 'master') ) {
            die "Slave has advanced past $opts{untilmaster} on master.\n";
         }
         elsif ( $opts{untilrelay} && pos_ge($stat, 'relay') ) {
            die "Slave has advanced past $opts{untilrelay} in relay logs.\n";
         }

         if ( $stat->{slave_sql_running} eq 'No' ) {
            # Print the time, error, etc
            if ( $opts{v} ) {
               my $err = '';
               if ( $opts{v} > 1 ) {
                  ($err = $stat->{last_error} || '' ) =~ s/\s+/ /g;
                  if ( $opts{L} ) {
                     $err = substr($err, 0, $opts{L});
                  }
               }
               printf("%s %s %s %11d %d %s\n",
                  ts(time),
                  $dp->as_string($dsn),
                  $stat->{relay_log_file},
                  $stat->{relay_log_pos},
                  $stat->{last_errno} || 0,
                  $err
               );
            }

            if ( $opts{e} && !exists($opts{e}->{$stat->{last_errno}}) ) {
               die "Error $stat->{last_errno} is not in --error-numbers.\n";
            }
            elsif ( $opts{E} && $stat->{last_error}
                  && $stat->{last_error} !~ m/$opts{E}/ )
            {
               die "Error does not match --error-text.\n";
            }
            elsif ( $stat->{last_error} || $opts{always} ) {

               # What kind of error is it?
               foreach my $pat ( @error_patterns ) {
                  if ( $stat->{last_error} =~ m/$pat->[0]/ ) {
                     $actions{$pat->[1]}->($stat, $dbh);
                     last;
                  }
               }

               $start->execute();
               $increase_sleep = 0;

               # Only set this on events I tried to restart.  Otherwise there
               # could be a race condition: I see it, I record it, but it hasn't
               # caused an error yet; so I won't try to restart it when it does.
               # (The point of this is to avoid trying to restart the same event
               # twice in case another race condition happens -- I restart it,
               # then check the server and it hasn't yet cleared the error
               # message and restarted the SQL thread).
               $last_log = $stat->{relay_log_file};
               $last_pos = $stat->{relay_log_pos};
            }
            else {
               MKDEBUG && _d('The slave is stopped, but without error');
               $increase_sleep = 1;
            }
         }
      }

      # Adjust sleep time.
      if ( $increase_sleep ) {
         $sleep = min($opts{M}, $sleep * 2);
      }
      else {
         $sleep = max($opts{m}, $sleep / 2);
      }

      # Errors are very likely to follow each other in quick succession.  NOTE:
      # this policy has a side effect with respect to $sleep.  Suppose $sleep is
      # 512 and mk-slave-restart finds an error; now $sleep is 256, but
      # mk-slave-restart sleeps only 1 (the initial value of --sleep).  Suppose
      # there is no error when it wakes up after 1 second, because 1 was too
      # short.  Now it doubles $sleep, back to 512.  $sleep has the same value
      # it did before the error was ever found.
      print $dp->as_string($dsn), " sleeping $sleep\n" if $opts{v} > 2;
      sleep($increase_sleep ? $sleep : min($sleep, $opts{s}));
   }

   MKDEBUG && _d('All done with server ', $dp->as_string($dsn));
   if ( $was_forked ) {
      $dp->disconnect($dbh);
      exit(0);
   }
}

# Determines if the $stat's log coordinates are greater than or equal to the
# desired coordinates. $which is 'master' or 'relay'
sub pos_ge {
   my ( $stat, $which ) = @_;
   my $fmt  = '%s/%020d';
   my $curr = $which eq 'master'
      ? sprintf($fmt, @{$stat}{qw(relay_master_log_file exec_master_log_pos)})
      : sprintf($fmt, @{$stat}{qw(relay_log_file relay_log_pos)});
   my $stop = sprintf($fmt, split(',', $opts{"until$which"}));
   return $curr ge $stop;
}

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

sub _d {
   my ( $line ) = (caller(0))[2];
   print "# main:$line ", @_, "\n";
}

# Catches signals for exiting gracefully.
sub finish {
   my ($signal) = @_;
   print STDERR "Exiting on SIG$signal.\n";
   if ( %children ) {
      kill 9, values %children;
      print STDERR "Signaled ", join(', ', values %children), "\n";
   }
   exit(1);
}

# ############################################################################
# Documentation.
# ############################################################################

=pod

=head1 NAME

mk-slave-restart - Watch and restart MySQL replication after errors.

=head1 SYNOPSIS

 mk-slave-restart --verbose

=head1 DESCRIPTION

mk-slave-restart watches one or more MySQL replication slaves and tries to skip
statements that cause errors.  It polls slaves intelligently with an
exponentially varying sleep time.  You can specify errors to skip and run the
slaves until a certain binlog position.

Note: it has come to my attention that Yahoo! had or has an internal tool
called fix_repl, described to me by a past Yahoo! employee and mentioned in
the first edition of High Performance MySQL.  Apparently this tool does the
same thing.  Make no mistake, though: this is not a way to "fix replication."
In fact I would not even encourage its use on a regular basis; I use it only
when I have an error I know I just need to skip past.

Indiscriminate use of this tool can easily screw up a server you might have
had a chance to truly fix.  You have been warned.

=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

=over

=item --always

Start slaves even when no error.

Always (re)start the slave processes, even when there is no error.  With this
option enabled, C<mk-slave-restart> will not let you stop the slave if you want
to!

=item --askpass

Prompt for a password when connecting to MySQL.

=item --charset

short form: -A; type: string

Default character set.

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

=item --daemonize

Fork to background and detach (POSIX only).

This probably doesn't work on Microsoft Windows.

=item --database

short form: -D; type: string

Database to use.

=item --defaults-file

short form: -F; type: string

Only read mysql options from the given file.

=item --error-length

short form: -L; type: int

Max length of error message to print.

When L<"--verbose"> is set high enough to print the error, this option will
truncate the error text to the specified length.  This can be useful to prevent
wrapping on the terminal.

=item --error-numbers

short form: -e; type: int

Only restart this comma-separated list of errors.

Makes mk-slave-restart only try to restart if the error number is in this
comma-separated list of errors.  If it sees an error not in the list, it will
exit.

The error number is in the C<last_errno> column of C<SHOW SLAVE STATUS>.

=item --error-text

short form: -E; type: string

Only restart errors that match this pattern.

A Perl regular expression against which the error text, if any, is matched.  If
the error text exists and matches, mk-slave-restart will try to restart the
slave.  If it exists but doesn't match, mk-slave-restart will exit.

The error text is in the C<last_error> column of C<SHOW SLAVE STATUS>.

=item --host

short form: -h; type: string

Connect to host.

=item --maxsleep

short form: -M; type: float; default: 64

Maximum sleep seconds.

The maximum time mk-slave-restart will sleep before polling the slave again.
See L<"SLEEP">.

=item --minsleep

short form: -m; type: float; default: 0.015625

The minimum time mk-slave-restart will sleep before polling the slave again.
See L<"SLEEP">.

=item --monitor

default: yes

Whether to monitor the slave.

Unless you specify --monitor explicitly, L<"--stop"> will disable it.

=item --password

short form: -p; type: string

Password to use when connecting.

=item --pid

type: string 

Create the given PID file when daemonized.

For example, '--daemonize --pid /tmp/mk-slave-restart.pid' would cause
mk-slave-restart to create the PID file /tmp/mk-slave-restart.pid.

/var/run/ is usually not writable by non-root users, therefore /tmp/ is a
more reliable alternative.

The PID file is removed when the daemonized instance of mk-slave-restart exits.

=item --port

short form: -P; type: int

Port number to use for connection.

=item --quiet

short form: -q

Suppresses normal output (disables L<"--verbose">).

=item --recurse

short form: -r; type: int; default: 0

Number of levels to recurse.

This option specifies that instead of just watching the server specified on
the command-line, C<mk-slave-restart> should try to find its slaves and watch
them too, up to the specified depth.  The default depth of 0 means "just watch
the slave specified."

This works if you have configured your slaves to show up in C<SHOW SLAVE HOSTS>.
The minimal configuration for this is the C<report_host> parameter, but there
are other "report" parameters as well for the port, username, and password.

If C<SHOW SLAVE HOSTS> doesn't return anything, C<mk-slave-restart> examines
C<SHOW PROCESSLIST> and tries to determine which connections are from
slaves, then connect to them.  This is less likely to work than C<SHOW SLAVE
HOSTS>, but it works sometimes when that doesn't.

Recursion works by finding all slaves when the program starts, then watching
them.  If there is more than one slave, C<mk-slave-restart> uses C<fork()> to
monitor them.

=item --sentinel

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

Exit if this file exists.

=item --setvars

type: string; default: wait_timeout=10000

Set these MySQL variables.

Specify any variables you want to be set immediately after connecting to MySQL.
These will be included in a C<SET> command.

=item --skipcount

short form: -k; type: int; default: 1

Number of statements to skip when restarting the slave.

=item --sleep

short form: -s; type: int; default: 1

Initial sleep seconds between checking the slave.

See L<"SLEEP">.

=item --socket

short form: -S; type: string

Socket file to use for connection.

=item --stop

Stop running instances by creating the sentinel file.

Causes C<mk-slave-restart> to create the sentinel file specified by
L<"--sentinel">.  This should have the effect of stopping all running
instances which are watching the same sentinel file.  If L<"--monitor"> isn't
specified, C<mk-slave-restart> will exit after creating the file.  If it is
specified, C<mk-slave-restart> will wait the interval given by
L<"--maxsleep">, then remove the file and continue working.

You might find this handy to stop cron jobs gracefully if necessary, or to
replace one running instance with another.  For example, if you want to stop
and restart C<mk-slave-restart> every hour (just to make sure that it is
restarted every hour, in case of a server crash or some other problem), you
could use a C<crontab> line like this:

 0 * * * * mk-slave-restart --monitor --stop --sentinel /tmp/mk-slave-restartup

The non-default L<"--sentinel"> will make sure the hourly C<cron> job stops
only instances previously started with the same options (that is, from the
same C<cron> job).

See also L<"--sentinel">.

=item --time

short form: -t; type: time

Time to run before exiting.

Causes C<mk-slave-restart> to stop after the specified time has elapsed.
Optional suffix: s=seconds, m=minutes, h=hours, d=days; if no suffix, s is used.

=item --untilmaster

type: string

Run until this master log file and position.

Start the slave, and retry if it fails, until it reaches the given replication
coordinates.  The coordinates are the logfile and position on the master, given
by relay_master_log_file, exec_master_log_pos.  The argument must be in the
format "file,pos".  Separate the filename and position with a single comma and
no space.

This will also cause an UNTIL clause to be given to START SLAVE.

After reaching this point, the slave should be stopped and mk-slave-restart
will exit.

=item --untilrelay

type: string

Run until this relay log file and position.

Like L<"--untilmaster">, but in the slave's relay logs instead.  The coordinates
are given by relay_log_file, relay_log_pos.

=item --user

short form: -u; type: string

User for login if not current user.

=item --verbose

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

Be verbose; can specify multiple times.

Verbosity 1 outputs connection information, a timestamp, relay_log_file,
relay_log_pos, and last_errno.

Verbosity 2 adds last_error.  See also L<"--error-length">.

Verbosity 3 prints the current sleep time each time mk-slave-restart sleeps.

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

If you specify --verbose, mk-slave-restart prints a line every time it sees
the slave has an error.  See L<"--verbose"> for details.

=head1 SLEEP

mk-slave-restart sleeps intelligently between polling the slave.  The current
sleep time varies.

=over

=item *

The initial sleep time is given by L<"--sleep">.

=item *

If it checks and finds an error, it halves the previous sleep time.

=item *

If it finds no error, it doubles the previous sleep time.

=item *

The sleep time is bounded below by L<"--minsleep"> and above by L<"--maxsleep">.

=item *

Immediately after finding an error, mk-slave-restart assumes another error is
very likely to happen next, so it sleeps the current sleep time or the initial
sleep time, whichever is less.

=back

=head1 EXIT STATUS

Successful exit status is 0.  Any other value represents the exit status of
the Perl process itself, or of the last forked process that exited if there
were multiple servers to monitor.

=head1 COMPATIBILITY

mk-slave-restart should work on many versions of MySQL.  Lettercase of many
output columns from SHOW SLAVE STATUS has changed over time, so it treats them
all as lowercase.

=head1 ENVIRONMENT

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

   MKDEBUG=1 mk-....

When L<"--daemonize"> is given and this variable is set, output is directed to a
debug file in C</tmp>.

=head1 BUGS

Please use Google Code Issues and Groups to report bugs or request support:
L<http://code.google.com/p/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 SEE ALSO

See also L<mk-table-checksum>, L<mk-table-sync>, L<mk-slave-delay>.

=head1 COPYRIGHT, LICENSE AND WARRANTY

This program is copyright 2007-2008 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.9 Distrib 2442 $Revision: 2311 $.

=cut
