diff --git a/bin/pt-replica-restart b/bin/pt-replica-restart
new file mode 100755
index 00000000..0dea71fc
--- /dev/null
+++ b/bin/pt-replica-restart
@@ -0,0 +1,6449 @@
+#!/usr/bin/env perl
+
+# This program is part of Percona Toolkit: http://www.percona.com/software/
+# See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal
+# notices and disclaimers.
+
+use strict;
+use warnings FATAL => 'all';
+
+# This tool is "fat-packed": most of its dependent modules are embedded
+# in this file.  Setting %INC to this file for each module makes Perl aware
+# of this so it will not try to load the module from @INC.  See the tool's
+# documentation for a full list of dependencies.
+BEGIN {
+   $INC{$_} = __FILE__ for map { (my $pkg = "$_.pm") =~ s!::!/!g; $pkg } (qw(
+      Percona::Toolkit
+      Quoter
+      OptionParser
+      Lmo::Utils
+      Lmo::Meta
+      Lmo::Object
+      Lmo::Types
+      Lmo
+      VersionParser
+      DSNParser
+      MasterSlave
+      Daemon
+      HTTP::Micro
+      VersionCheck
+   ));
+}
+
+# ###########################################################################
+# Percona::Toolkit package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Percona/Toolkit.pm
+#   t/lib/Percona/Toolkit.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Percona::Toolkit;
+
+our $VERSION = '3.6.0';
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Carp qw(carp cluck);
+use Data::Dumper qw();
+
+require Exporter;
+our @ISA         = qw(Exporter);
+our @EXPORT_OK   = qw(
+   have_required_args
+   Dumper
+   _d
+);
+
+sub have_required_args {
+   my ($args, @required_args) = @_;
+   my $have_required_args = 1;
+   foreach my $arg ( @required_args ) {
+      if ( !defined $args->{$arg} ) {
+         $have_required_args = 0;
+         carp "Argument $arg is not defined";
+      }
+   }
+   cluck unless $have_required_args;  # print backtrace
+   return $have_required_args;
+}
+
+sub Dumper {
+   local $Data::Dumper::Indent    = 1;
+   local $Data::Dumper::Sortkeys  = 1;
+   local $Data::Dumper::Quotekeys = 0;
+   Data::Dumper::Dumper(@_);
+}
+
+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 Percona::Toolkit package
+# ###########################################################################
+
+# ###########################################################################
+# Quoter package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Quoter.pm
+#   t/lib/Quoter.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Quoter;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Data::Dumper;
+$Data::Dumper::Indent    = 1;
+$Data::Dumper::Sortkeys  = 1;
+$Data::Dumper::Quotekeys = 0;
+
+sub new {
+   my ( $class, %args ) = @_;
+   return bless {}, $class;
+}
+
+sub quote {
+   my ( $self, @vals ) = @_;
+   foreach my $val ( @vals ) {
+      $val =~ s/`/``/g;
+   }
+   return join('.', map { '`' . $_ . '`' } @vals);
+}
+
+sub quote_val {
+   my ( $self, $val, %args ) = @_;
+
+   return 'NULL' unless defined $val;          # undef = NULL
+   return "''" if $val eq '';                  # blank string = ''
+   return $val if $val =~ m/^0x[0-9a-fA-F]+$/  # quote hex data
+                  && !$args{is_char};          # unless is_char is true
+
+   return $val if $args{is_float};
+
+   $val =~ s/(['\\])/\\$1/g;
+   return "'$val'";
+}
+
+sub split_unquote {
+   my ( $self, $db_tbl, $default_db ) = @_;
+   my ( $db, $tbl ) = split(/[.]/, $db_tbl);
+   if ( !$tbl ) {
+      $tbl = $db;
+      $db  = $default_db;
+   }
+   for ($db, $tbl) {
+      next unless $_;
+      s/\A`//;
+      s/`\z//;
+      s/``/`/g;
+   }
+
+   return ($db, $tbl);
+}
+
+sub literal_like {
+   my ( $self, $like ) = @_;
+   return unless $like;
+   $like =~ s/([%_])/\\$1/g;
+   return "'$like'";
+}
+
+sub join_quote {
+   my ( $self, $default_db, $db_tbl ) = @_;
+   return unless $db_tbl;
+   my ($db, $tbl) = split(/[.]/, $db_tbl);
+   if ( !$tbl ) {
+      $tbl = $db;
+      $db  = $default_db;
+   }
+   $db  = "`$db`"  if $db  && $db  !~ m/^`/;
+   $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/;
+   return $db ? "$db.$tbl" : $tbl;
+}
+
+sub serialize_list {
+   my ( $self, @args ) = @_;
+   PTDEBUG && _d('Serializing', Dumper(\@args));
+   return unless @args;
+
+   my @parts;
+   foreach my $arg  ( @args ) {
+      if ( defined $arg ) {
+         $arg =~ s/,/\\,/g;      # escape commas
+         $arg =~ s/\\N/\\\\N/g;  # escape literal \N
+         push @parts, $arg;
+      }
+      else {
+         push @parts, '\N';
+      }
+   }
+
+   my $string = join(',', @parts);
+   PTDEBUG && _d('Serialized: <', $string, '>');
+   return $string;
+}
+
+sub deserialize_list {
+   my ( $self, $string ) = @_;
+   PTDEBUG && _d('Deserializing <', $string, '>');
+   die "Cannot deserialize an undefined string" unless defined $string;
+
+   my @parts;
+   foreach my $arg ( split(/(?<!\\),/, $string) ) {
+      if ( $arg eq '\N' ) {
+         $arg = undef;
+      }
+      else {
+         $arg =~ s/\\,/,/g;
+         $arg =~ s/\\\\N/\\N/g;
+      }
+      push @parts, $arg;
+   }
+
+   if ( !@parts ) {
+      my $n_empty_strings = $string =~ tr/,//;
+      $n_empty_strings++;
+      PTDEBUG && _d($n_empty_strings, 'empty strings');
+      map { push @parts, '' } 1..$n_empty_strings;
+   }
+   elsif ( $string =~ m/(?<!\\),$/ ) {
+      PTDEBUG && _d('Last value is an empty string');
+      push @parts, '';
+   }
+
+   PTDEBUG && _d('Deserialized', Dumper(\@parts));
+   return @parts;
+}
+
+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 Quoter package
+# ###########################################################################
+
+# ###########################################################################
+# OptionParser package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/OptionParser.pm
+#   t/lib/OptionParser.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package OptionParser;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use List::Util qw(max);
+use Getopt::Long;
+use Data::Dumper;
+
+my $POD_link_re = '[LC]<"?([^">]+)"?>';
+
+sub new {
+   my ( $class, %args ) = @_;
+   my @required_args = qw();
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+
+   my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
+   $program_name ||= $PROGRAM_NAME;
+   my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
+
+   my %attributes = (
+      'type'       => 1,
+      'short form' => 1,
+      'group'      => 1,
+      'default'    => 1,
+      'cumulative' => 1,
+      'negatable'  => 1,
+      'repeatable' => 1,  # means it can be specified more than once
+   );
+
+   my $self = {
+      head1             => 'OPTIONS',        # These args are used internally
+      skip_rules        => 0,                # to instantiate another Option-
+      item              => '--(.*)',         # Parser obj that parses the
+      attributes        => \%attributes,     # DSN OPTIONS section.  Tools
+      parse_attributes  => \&_parse_attribs, # don't tinker with these args.
+
+      %args,
+
+      strict            => 1,  # disabled by a special rule
+      program_name      => $program_name,
+      opts              => {},
+      got_opts          => 0,
+      short_opts        => {},
+      defaults          => {},
+      groups            => {},
+      allowed_groups    => {},
+      errors            => [],
+      rules             => [],  # desc of rules for --help
+      mutex             => [],  # rule: opts are mutually exclusive
+      atleast1          => [],  # rule: at least one opt is required
+      disables          => {},  # rule: opt disables other opts
+      defaults_to       => {},  # rule: opt defaults to value of other opt
+      DSNParser         => undef,
+      default_files     => [
+         "/etc/percona-toolkit/percona-toolkit.conf",
+         "/etc/percona-toolkit/$program_name.conf",
+         "$home/.percona-toolkit.conf",
+         "$home/.$program_name.conf",
+      ],
+      types             => {
+         string => 's', # standard Getopt type
+         int    => 'i', # standard Getopt type
+         float  => 'f', # standard Getopt type
+         Hash   => 'H', # hash, formed from a comma-separated list
+         hash   => 'h', # hash as above, but only if a value is given
+         Array  => 'A', # array, similar to Hash
+         array  => 'a', # array, similar to hash
+         DSN    => 'd', # DSN
+         size   => 'z', # size with kMG suffix (powers of 2^10)
+         time   => 'm', # time, with an optional suffix of s/h/m/d
+      },
+   };
+
+   return bless $self, $class;
+}
+
+sub get_specs {
+   my ( $self, $file ) = @_;
+   $file ||= $self->{file} || __FILE__;
+   my @specs = $self->_pod_to_specs($file);
+   $self->_parse_specs(@specs);
+
+   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
+   my $contents = do { local $/ = undef; <$fh> };
+   close $fh;
+   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
+      PTDEBUG && _d('Parsing DSN OPTIONS');
+      my $dsn_attribs = {
+         dsn  => 1,
+         copy => 1,
+      };
+      my $parse_dsn_attribs = sub {
+         my ( $self, $option, $attribs ) = @_;
+         map {
+            my $val = $attribs->{$_};
+            if ( $val ) {
+               $val    = $val eq 'yes' ? 1
+                       : $val eq 'no'  ? 0
+                       :                 $val;
+               $attribs->{$_} = $val;
+            }
+         } keys %$attribs;
+         return {
+            key => $option,
+            %$attribs,
+         };
+      };
+      my $dsn_o = new OptionParser(
+         description       => 'DSN OPTIONS',
+         head1             => 'DSN OPTIONS',
+         dsn               => 0,         # XXX don't infinitely recurse!
+         item              => '\* (.)',  # key opts are a single character
+         skip_rules        => 1,         # no rules before opts
+         attributes        => $dsn_attribs,
+         parse_attributes  => $parse_dsn_attribs,
+      );
+      my @dsn_opts = map {
+         my $opts = {
+            key  => $_->{spec}->{key},
+            dsn  => $_->{spec}->{dsn},
+            copy => $_->{spec}->{copy},
+            desc => $_->{desc},
+         };
+         $opts;
+      } $dsn_o->_pod_to_specs($file);
+      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
+   }
+
+   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
+      $self->{version} = $1;
+      PTDEBUG && _d($self->{version});
+   }
+
+   return;
+}
+
+sub DSNParser {
+   my ( $self ) = @_;
+   return $self->{DSNParser};
+};
+
+sub get_defaults_files {
+   my ( $self ) = @_;
+   return @{$self->{default_files}};
+}
+
+sub _pod_to_specs {
+   my ( $self, $file ) = @_;
+   $file ||= $self->{file} || __FILE__;
+   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";
+
+   my @specs = ();
+   my @rules = ();
+   my $para;
+
+   local $INPUT_RECORD_SEPARATOR = '';
+   while ( $para = <$fh> ) {
+      next unless $para =~ m/^=head1 $self->{head1}/;
+      last;
+   }
+
+   while ( $para = <$fh> ) {
+      last if $para =~ m/^=over/;
+      next if $self->{skip_rules};
+      chomp $para;
+      $para =~ s/\s+/ /g;
+      $para =~ s/$POD_link_re/$1/go;
+      PTDEBUG && _d('Option rule:', $para);
+      push @rules, $para;
+   }
+
+   die "POD has no $self->{head1} section" unless $para;
+
+   do {
+      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
+         chomp $para;
+         PTDEBUG && _d($para);
+         my %attribs;
+
+         $para = <$fh>; # read next paragraph, possibly attributes
+
+         if ( $para =~ m/: / ) { # attributes
+            $para =~ s/\s+\Z//g;
+            %attribs = map {
+                  my ( $attrib, $val) = split(/: /, $_);
+                  die "Unrecognized attribute for --$option: $attrib"
+                     unless $self->{attributes}->{$attrib};
+                  ($attrib, $val);
+               } split(/; /, $para);
+            if ( $attribs{'short form'} ) {
+               $attribs{'short form'} =~ s/-//;
+            }
+            $para = <$fh>; # read next paragraph, probably short help desc
+         }
+         else {
+            PTDEBUG && _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;
+         PTDEBUG && _d('Short help:', $para);
+
+         die "No description after option spec $option" if $para =~ m/^=item/;
+
+         if ( my ($base_option) =  $option =~ m/^\[no\](.*)/ ) {
+            $option = $base_option;
+            $attribs{'negatable'} = 1;
+         }
+
+         push @specs, {
+            spec  => $self->{parse_attributes}->($self, $option, \%attribs),
+            desc  => $para
+               . (defined $attribs{default} ? " (default $attribs{default})" : ''),
+            group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
+            attributes => \%attribs
+         };
+      }
+      while ( $para = <$fh> ) {
+         last unless $para;
+         if ( $para =~ m/^=head1/ ) {
+            $para = undef; # Can't 'last' out of a do {} block.
+            last;
+         }
+         last if $para =~ m/^=item /;
+      }
+   } while ( $para );
+
+   die "No valid specs in $self->{head1}" unless @specs;
+
+   close $fh;
+   return @specs, @rules;
+}
+
+sub _parse_specs {
+   my ( $self, @specs ) = @_;
+   my %disables; # special rule that requires deferred checking
+
+   foreach my $opt ( @specs ) {
+      if ( ref $opt ) { # It's an option spec, not a rule.
+         PTDEBUG && _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 ) {
+            PTDEBUG && _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_repeatable} = $opt->{attributes}->{repeatable} ? 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;
+         PTDEBUG && _d($long, 'type:', $type);
+
+
+         $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ );
+
+         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
+            $self->{defaults}->{$long} = defined $def ? $def : 1;
+            PTDEBUG && _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;
+            PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
+         }
+
+         $self->{opts}->{$long} = $opt;
+      }
+      else { # It's an option rule, not a spec.
+         PTDEBUG && _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;
+            PTDEBUG && _d(@participants, 'are mutually exclusive');
+         }
+         if ( $opt =~ m/at least one|one and only one/ ) {
+            $rule_ok = 1;
+            push @{$self->{atleast1}}, \@participants;
+            PTDEBUG && _d(@participants, 'require at least one');
+         }
+         if ( $opt =~ m/default to/ ) {
+            $rule_ok = 1;
+            $self->{defaults_to}->{$participants[0]} = $participants[1];
+            PTDEBUG && _d($participants[0], 'defaults to', $participants[1]);
+         }
+         if ( $opt =~ m/restricted to option groups/ ) {
+            $rule_ok = 1;
+            my ($groups) = $opt =~ m/groups ([\w\s\,]+)/;
+            my @groups = split(',', $groups);
+            %{$self->{allowed_groups}->{$participants[0]}} = map {
+               s/\s+//;
+               $_ => 1;
+            } @groups;
+         }
+         if( $opt =~ m/accepts additional command-line arguments/ ) {
+            $rule_ok = 1;
+            $self->{strict} = 0;
+            PTDEBUG && _d("Strict mode disabled by rule");
+         }
+
+         die "Unrecognized option rule: $opt" unless $rule_ok;
+      }
+   }
+
+   foreach my $long ( keys %disables ) {
+      my @participants = $self->_get_participants($disables{$long});
+      $self->{disables}->{$long} = \@participants;
+      PTDEBUG && _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;
+   }
+   PTDEBUG && _d('Participants for', $str, ':', @participants);
+   return @participants;
+}
+
+sub opts {
+   my ( $self ) = @_;
+   my %opts = %{$self->{opts}};
+   return %opts;
+}
+
+sub short_opts {
+   my ( $self ) = @_;
+   my %short_opts = %{$self->{short_opts}};
+   return %short_opts;
+}
+
+sub set_defaults {
+   my ( $self, %defaults ) = @_;
+   $self->{defaults} = {};
+   foreach my $long ( keys %defaults ) {
+      die "Cannot set default for nonexistent option $long"
+         unless exists $self->{opts}->{$long};
+      $self->{defaults}->{$long} = $defaults{$long};
+      PTDEBUG && _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}++;
+   }
+   elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) {
+      my $next_opt = $1;
+      if (    exists $self->{opts}->{$next_opt}
+           || exists $self->{short_opts}->{$next_opt} ) {
+         $self->save_error("--$long requires a string value");
+         return;
+      }
+      else {
+         if ($opt->{is_repeatable}) {
+            push @{$opt->{value}} , $val;
+         }
+         else {
+            $opt->{value} = $val;
+         }
+      }
+   }
+   else {
+      if ($opt->{is_repeatable}) {
+         push @{$opt->{value}} , $val;
+      }
+      else {
+         $opt->{value} = $val;
+      }
+   }
+   $opt->{got} = 1;
+   PTDEBUG && _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] =~/^--config=/ ) {
+      $ARGV[0] = substr($ARGV[0],9);
+      $ARGV[0] =~ s/^'(.*)'$/$1/;
+      $ARGV[0] =~ s/^"(.*)"$/$1/;
+      $self->_set_option('config', shift @ARGV);
+   }
+   if ( @ARGV && $ARGV[0] eq "--config" ) {
+      shift @ARGV;
+      $self->_set_option('config', shift @ARGV);
+   }
+   if ( $self->has('config') ) {
+      my @extra_args;
+      foreach my $filename ( split(',', $self->get('config')) ) {
+         eval {
+            push @extra_args, $self->_read_config_file($filename);
+         };
+         if ( $EVAL_ERROR ) {
+            if ( $self->got('config') ) {
+               die $EVAL_ERROR;
+            }
+            elsif ( PTDEBUG ) {
+               _d($EVAL_ERROR);
+            }
+         }
+      }
+      unshift @ARGV, @extra_args;
+   }
+
+   Getopt::Long::Configure('no_ignore_case', 'bundling');
+   GetOptions(
+      map    { $_->{spec} => sub { $self->_set_option(@_); } }
+      grep   { $_->{long} ne 'config' } # --config is handled specially above.
+      values %{$self->{opts}}
+   ) or $self->save_error('Error parsing options');
+
+   if ( exists $self->{opts}->{version} && $self->{opts}->{version}->{got} ) {
+      if ( $self->{version} ) {
+         print $self->{version}, "\n";
+         exit 0;
+      }
+      else {
+         print "Error parsing version.  See the VERSION section of the tool's documentation.\n";
+         exit 1;
+      }
+   }
+
+   if ( @ARGV && $self->{strict} ) {
+      $self->save_error("Unrecognized command-line options @ARGV");
+   }
+
+   foreach my $mutex ( @{$self->{mutex}} ) {
+      my @set = grep { $self->{opts}->{$_}->{got} } @$mutex;
+      if ( @set > 1 ) {
+         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
+                      @{$mutex}[ 0 .. scalar(@$mutex) - 2] )
+                 . ' and --'.$self->{opts}->{$mutex->[-1]}->{long}
+                 . ' are mutually exclusive.';
+         $self->save_error($err);
+      }
+   }
+
+   foreach my $required ( @{$self->{atleast1}} ) {
+      my @set = grep { $self->{opts}->{$_}->{got} } @$required;
+      if ( @set == 0 ) {
+         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
+                      @{$required}[ 0 .. scalar(@$required) - 2] )
+                 .' or --'.$self->{opts}->{$required->[-1]}->{long};
+         $self->save_error("Specify at least one of $err");
+      }
+   }
+
+   $self->_check_opts( keys %{$self->{opts}} );
+   $self->{got_opts} = 1;
+   return;
+}
+
+sub _check_opts {
+   my ( $self, @long ) = @_;
+   my $long_last = scalar @long;
+   while ( @long ) {
+      foreach my $i ( 0..$#long ) {
+         my $long = $long[$i];
+         next unless $long;
+         my $opt  = $self->{opts}->{$long};
+         if ( $opt->{got} ) {
+            if ( exists $self->{disables}->{$long} ) {
+               my @disable_opts = @{$self->{disables}->{$long}};
+               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
+               PTDEBUG && _d('Unset options', @disable_opts,
+                  'because', $long,'disables them');
+            }
+
+            if ( exists $self->{allowed_groups}->{$long} ) {
+
+               my @restricted_groups = grep {
+                  !exists $self->{allowed_groups}->{$long}->{$_}
+               } keys %{$self->{groups}};
+
+               my @restricted_opts;
+               foreach my $restricted_group ( @restricted_groups ) {
+                  RESTRICTED_OPT:
+                  foreach my $restricted_opt (
+                     keys %{$self->{groups}->{$restricted_group}} )
+                  {
+                     next RESTRICTED_OPT if $restricted_opt eq $long;
+                     push @restricted_opts, $restricted_opt
+                        if $self->{opts}->{$restricted_opt}->{got};
+                  }
+               }
+
+               if ( @restricted_opts ) {
+                  my $err;
+                  if ( @restricted_opts == 1 ) {
+                     $err = "--$restricted_opts[0]";
+                  }
+                  else {
+                     $err = join(', ',
+                               map { "--$self->{opts}->{$_}->{long}" }
+                               grep { $_ }
+                               @restricted_opts[0..scalar(@restricted_opts) - 2]
+                            )
+                          . ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long};
+                  }
+                  $self->save_error("--$long is not allowed with $err");
+               }
+            }
+
+         }
+         elsif ( $opt->{is_required} ) {
+            $self->save_error("Required option --$long must be specified");
+         }
+
+         $self->_validate_type($opt);
+         if ( $opt->{parsed} ) {
+            delete $long[$i];
+         }
+         else {
+            PTDEBUG && _d('Temporarily failed to parse', $long);
+         }
+      }
+
+      die "Failed to parse options, possibly due to circular dependencies"
+         if @long == $long_last;
+      $long_last = @long;
+   }
+
+   return;
+}
+
+sub _validate_type {
+   my ( $self, $opt ) = @_;
+   return unless $opt;
+
+   if ( !$opt->{type} ) {
+      $opt->{parsed} = 1;
+      return;
+   }
+
+   my $val = $opt->{value};
+
+   if ( $val && $opt->{type} eq 'm' ) {  # type time
+      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
+      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
+      if ( !$suffix ) {
+         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
+         $suffix = $s || 's';
+         PTDEBUG && _d('No suffix given; using', $suffix, 'for',
+            $opt->{long}, '(value:', $val, ')');
+      }
+      if ( $suffix =~ m/[smhd]/ ) {
+         $val = $suffix eq 's' ? $num            # Seconds
+              : $suffix eq 'm' ? $num * 60       # Minutes
+              : $suffix eq 'h' ? $num * 3600     # Hours
+              :                  $num * 86400;   # Days
+         $opt->{value} = ($prefix || '') . $val;
+         PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
+      }
+      else {
+         $self->save_error("Invalid time suffix for --$opt->{long}");
+      }
+   }
+   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
+      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
+      my $prev = {};
+      my $from_key = $self->{defaults_to}->{ $opt->{long} };
+      if ( $from_key ) {
+         PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
+         if ( $self->{opts}->{$from_key}->{parsed} ) {
+            $prev = $self->{opts}->{$from_key}->{value};
+         }
+         else {
+            PTDEBUG && _d('Cannot parse', $opt->{long}, 'until',
+               $from_key, 'parsed');
+            return;
+         }
+      }
+      my $defaults = $self->{DSNParser}->parse_options($self);
+      if (!$opt->{attributes}->{repeatable}) {
+          $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
+      } else {
+          my $values = [];
+          for my $dsn_string (@$val) {
+              push @$values, $self->{DSNParser}->parse($dsn_string, $prev, $defaults);
+          }
+          $opt->{value} = $values;
+      }
+   }
+   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
+      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
+      $self->_parse_size($opt, $val);
+   }
+   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
+      $opt->{value} = { map { $_ => 1 } split(/(?<!\\),\s*/, ($val || '')) };
+   }
+   elsif ( $opt->{type} eq 'A' || (defined $val && $opt->{type} eq 'a') ) {
+      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
+   }
+   else {
+      PTDEBUG && _d('Nothing to validate for option',
+         $opt->{long}, 'type', $opt->{type}, 'value', $val);
+   }
+
+   $opt->{parsed} = 1;
+   return;
+}
+
+sub get {
+   my ( $self, $opt ) = @_;
+   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
+   die "Option $opt does not exist"
+      unless $long && exists $self->{opts}->{$long};
+   return $self->{opts}->{$long}->{value};
+}
+
+sub got {
+   my ( $self, $opt ) = @_;
+   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
+   die "Option $opt does not exist"
+      unless $long && exists $self->{opts}->{$long};
+   return $self->{opts}->{$long}->{got};
+}
+
+sub has {
+   my ( $self, $opt ) = @_;
+   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
+   return defined $long ? exists $self->{opts}->{$long} : 0;
+}
+
+sub set {
+   my ( $self, $opt, $val ) = @_;
+   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
+   die "Option $opt does not exist"
+      unless $long && exists $self->{opts}->{$long};
+   $self->{opts}->{$long}->{value} = $val;
+   return;
+}
+
+sub save_error {
+   my ( $self, $error ) = @_;
+   push @{$self->{errors}}, $error;
+   return;
+}
+
+sub errors {
+   my ( $self ) = @_;
+   return $self->{errors};
+}
+
+sub usage {
+   my ( $self ) = @_;
+   warn "No usage string is set" unless $self->{usage}; # XXX
+   return "Usage: " . ($self->{usage} || '') . "\n";
+}
+
+sub descr {
+   my ( $self ) = @_;
+   warn "No description string is set" unless $self->{description}; # XXX
+   my $descr  = ($self->{description} || $self->{program_name} || '')
+              . "  For more details, please use the --help option, "
+              . "or try 'perldoc $PROGRAM_NAME' "
+              . "for complete documentation.";
+   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g)
+      unless $ENV{DONT_BREAK_LINES};
+   $descr =~ s/ +$//mg;
+   return $descr;
+}
+
+sub usage_or_errors {
+   my ( $self, $file, $return ) = @_;
+   $file ||= $self->{file} || __FILE__;
+
+   if ( !$self->{description} || !$self->{usage} ) {
+      PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
+      my %synop = $self->_parse_synopsis($file);
+      $self->{description} ||= $synop{description};
+      $self->{usage}       ||= $synop{usage};
+      PTDEBUG && _d("Description:", $self->{description},
+         "\nUsage:", $self->{usage});
+   }
+
+   if ( $self->{opts}->{help}->{got} ) {
+      print $self->print_usage() or die "Cannot print usage: $OS_ERROR";
+      exit 0 unless $return;
+   }
+   elsif ( scalar @{$self->{errors}} ) {
+      print $self->print_errors() or die "Cannot print errors: $OS_ERROR";
+      exit 1 unless $return;
+   }
+
+   return;
+}
+
+sub print_errors {
+   my ( $self ) = @_;
+   my $usage = $self->usage() . "\n";
+   if ( (my @errors = @{$self->{errors}}) ) {
+      $usage .= join("\n  * ", 'Errors in command-line arguments:', @errors)
+              . "\n";
+   }
+   return $usage . "\n" . $self->descr();
+}
+
+sub print_usage {
+   my ( $self ) = @_;
+   die "Run get_opts() before print_usage()" unless $self->{got_opts};
+   my @opts = values %{$self->{opts}};
+
+   my $maxl = max(
+      map {
+         length($_->{long})               # option long name
+         + ($_->{is_negatable} ? 4 : 0)   # "[no]" if opt is negatable
+         + ($_->{type} ? 2 : 0)           # "=x" where x is the opt type
+      }
+      @opts);
+
+   my $maxs = max(0,
+      map {
+         length($_)
+         + ($self->{opts}->{$_}->{is_negatable} ? 4 : 0)
+         + ($self->{opts}->{$_}->{type} ? 2 : 0)
+      }
+      values %{$self->{short_opts}});
+
+   my $lcol = max($maxl, ($maxs + 3));
+   my $rcol = 80 - $lcol - 6;
+   my $rpad = ' ' x ( 80 - $rcol );
+
+   $maxs = max($lcol - 3, $maxs);
+
+   my $usage = $self->descr() . "\n" . $self->usage();
+
+   my @groups = reverse sort grep { $_ ne 'default'; } keys %{$self->{groups}};
+   push @groups, 'default';
+
+   foreach my $group ( reverse @groups ) {
+      $usage .= "\n".($group eq 'default' ? 'Options' : $group).":\n\n";
+      foreach my $opt (
+         sort { $a->{long} cmp $b->{long} }
+         grep { $_->{group} eq $group }
+         @opts )
+      {
+         my $long  = $opt->{is_negatable} ? "[no]$opt->{long}" : $opt->{long};
+         my $short = $opt->{short};
+         my $desc  = $opt->{desc};
+
+         $long .= $opt->{type} ? "=$opt->{type}" : "";
+
+         if ( $opt->{type} && $opt->{type} eq 'm' ) {
+            my ($s) = $desc =~ m/\(suffix (.)\)/;
+            $s    ||= 's';
+            $desc =~ s/\s+\(suffix .\)//;
+            $desc .= ".  Optional suffix s=seconds, m=minutes, h=hours, "
+                   . "d=days; if no suffix, $s is used.";
+         }
+         $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol}(?!\W))(?:\s+|(?<=\W)|$)/g);
+         $desc =~ s/ +$//mg;
+         if ( $short ) {
+            $usage .= sprintf("  --%-${maxs}s -%s  %s\n", $long, $short, $desc);
+         }
+         else {
+            $usage .= sprintf("  --%-${lcol}s  %s\n", $long, $desc);
+         }
+      }
+   }
+
+   $usage .= "\nOption types: s=string, i=integer, f=float, h/H/a/A=comma-separated list, d=DSN, z=size, m=time\n";
+
+   if ( (my @rules = @{$self->{rules}}) ) {
+      $usage .= "\nRules:\n\n";
+      $usage .= join("\n", map { "  $_" } @rules) . "\n";
+   }
+   if ( $self->{DSNParser} ) {
+      $usage .= "\n" . $self->{DSNParser}->usage();
+   }
+   $usage .= "\nOptions and values after processing arguments:\n\n";
+   foreach my $opt ( sort { $a->{long} cmp $b->{long} } @opts ) {
+      my $val   = $opt->{value};
+      my $type  = $opt->{type} || '';
+      my $bool  = $opt->{spec} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
+      $val      = $bool              ? ( $val ? 'TRUE' : 'FALSE' )
+                : !defined $val      ? '(No value)'
+                : $type eq 'd'       ? $self->{DSNParser}->as_string($val)
+                : $type =~ m/H|h/    ? join(',', sort keys %$val)
+                : $type =~ m/A|a/    ? join(',', @$val)
+                :                    $val;
+      $usage .= sprintf("  --%-${lcol}s  %s\n", $opt->{long}, $val);
+   }
+   return $usage;
+}
+
+sub prompt_noecho {
+   shift @_ if ref $_[0] eq __PACKAGE__;
+   my ( $prompt ) = @_;
+   local $OUTPUT_AUTOFLUSH = 1;
+   print STDERR $prompt
+      or die "Cannot print: $OS_ERROR";
+   my $response;
+   eval {
+      require Term::ReadKey;
+      Term::ReadKey::ReadMode('noecho');
+      chomp($response = <STDIN>);
+      Term::ReadKey::ReadMode('normal');
+      print "\n"
+         or die "Cannot print: $OS_ERROR";
+   };
+   if ( $EVAL_ERROR ) {
+      die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR";
+   }
+   return $response;
+}
+
+sub _read_config_file {
+   my ( $self, $filename ) = @_;
+   open my $fh, "<", $filename or die "Cannot open $filename: $OS_ERROR\n";
+   my @args;
+   my $prefix = '--';
+   my $parse  = 1;
+
+   LINE:
+   while ( my $line = <$fh> ) {
+      chomp $line;
+      next LINE if $line =~ m/^\s*(?:\#|\;|$)/;
+      $line =~ s/\s+#.*$//g;
+      $line =~ s/^\s+|\s+$//g;
+      if ( $line eq '--' ) {
+         $prefix = '';
+         $parse  = 0;
+         next LINE;
+      }
+
+      if (  $parse
+            && !$self->has('version-check')
+            && $line =~ /version-check/
+      ) {
+         next LINE;
+      }
+
+      if ( $parse
+         && (my($opt, $arg) = $line =~ m/^\s*([^=\s]+?)(?:\s*=\s*(.*?)\s*)?$/)
+      ) {
+         push @args, grep { defined $_ } ("$prefix$opt", $arg);
+      }
+      elsif ( $line =~ m/./ ) {
+         push @args, $line;
+      }
+      else {
+         die "Syntax error in file $filename at line $INPUT_LINE_NUMBER";
+      }
+   }
+   close $fh;
+   return @args;
+}
+
+sub read_para_after {
+   my ( $self, $file, $regex ) = @_;
+   open my $fh, "<", $file or die "Can't open $file: $OS_ERROR";
+   local $INPUT_RECORD_SEPARATOR = '';
+   my $para;
+   while ( $para = <$fh> ) {
+      next unless $para =~ m/^=pod$/m;
+      last;
+   }
+   while ( $para = <$fh> ) {
+      next unless $para =~ m/$regex/;
+      last;
+   }
+   $para = <$fh>;
+   chomp($para);
+   close $fh or die "Can't close $file: $OS_ERROR";
+   return $para;
+}
+
+sub clone {
+   my ( $self ) = @_;
+
+   my %clone = map {
+      my $hashref  = $self->{$_};
+      my $val_copy = {};
+      foreach my $key ( keys %$hashref ) {
+         my $ref = ref $hashref->{$key};
+         $val_copy->{$key} = !$ref           ? $hashref->{$key}
+                           : $ref eq 'HASH'  ? { %{$hashref->{$key}} }
+                           : $ref eq 'ARRAY' ? [ @{$hashref->{$key}} ]
+                           : $hashref->{$key};
+      }
+      $_ => $val_copy;
+   } qw(opts short_opts defaults);
+
+   foreach my $scalar ( qw(got_opts) ) {
+      $clone{$scalar} = $self->{$scalar};
+   }
+
+   return bless \%clone;
+}
+
+sub _parse_size {
+   my ( $self, $opt, $val ) = @_;
+
+   if ( lc($val || '') eq 'null' ) {
+      PTDEBUG && _d('NULL size for', $opt->{long});
+      $opt->{value} = 'null';
+      return;
+   }
+
+   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);
+   my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
+   if ( defined $num ) {
+      if ( $factor ) {
+         $num *= $factor_for{$factor};
+         PTDEBUG && _d('Setting option', $opt->{y},
+            'to num', $num, '* factor', $factor);
+      }
+      $opt->{value} = ($pre || '') . $num;
+   }
+   else {
+      $self->save_error("Invalid size for --$opt->{long}: $val");
+   }
+   return;
+}
+
+sub _parse_attribs {
+   my ( $self, $option, $attribs ) = @_;
+   my $types = $self->{types};
+   return $option
+      . ($attribs->{'short form'} ? '|' . $attribs->{'short form'}   : '' )
+      . ($attribs->{'negatable'}  ? '!'                              : '' )
+      . ($attribs->{'cumulative'} ? '+'                              : '' )
+      . ($attribs->{'type'}       ? '=' . $types->{$attribs->{type}} : '' );
+}
+
+sub _parse_synopsis {
+   my ( $self, $file ) = @_;
+   $file ||= $self->{file} || __FILE__;
+   PTDEBUG && _d("Parsing SYNOPSIS in", $file);
+
+   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
+   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
+   my $para;
+   1 while defined($para = <$fh>) && $para !~ m/^=head1 SYNOPSIS/;
+   die "$file does not contain a SYNOPSIS section" unless $para;
+   my @synop;
+   for ( 1..2 ) {  # 1 for the usage, 2 for the description
+      my $para = <$fh>;
+      push @synop, $para;
+   }
+   close $fh;
+   PTDEBUG && _d("Raw SYNOPSIS text:", @synop);
+   my ($usage, $desc) = @synop;
+   die "The SYNOPSIS section in $file is not formatted properly"
+      unless $usage && $desc;
+
+   $usage =~ s/^\s*Usage:\s+(.+)/$1/;
+   chomp $usage;
+
+   $desc =~ s/\n/ /g;
+   $desc =~ s/\s{2,}/ /g;
+   $desc =~ s/\. ([A-Z][a-z])/.  $1/g;
+   $desc =~ s/\s+$//;
+
+   return (
+      description => $desc,
+      usage       => $usage,
+   );
+};
+
+sub set_vars {
+   my ($self, $file) = @_;
+   $file ||= $self->{file} || __FILE__;
+
+   my %user_vars;
+   my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef;
+   if ( $user_vars ) {
+      foreach my $var_val ( @$user_vars ) {
+         my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/;
+         die "Invalid --set-vars value: $var_val\n" unless $var && defined $val;
+         $user_vars{$var} = {
+            val     => $val,
+            default => 0,
+         };
+      }
+   }
+
+   my %default_vars;
+   my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/);
+   if ( $default_vars ) {
+      %default_vars = map {
+         my $var_val = $_;
+         my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/;
+         die "Invalid --set-vars value: $var_val\n" unless $var && defined $val;
+         $var => {
+            val     => $val,
+            default => 1,
+         };
+      } split("\n", $default_vars);
+   }
+
+   my %vars = (
+      %default_vars, # first the tool's defaults
+      %user_vars,    # then the user's which overwrite the defaults
+   );
+   PTDEBUG && _d('--set-vars:', Dumper(\%vars));
+   return \%vars;
+}
+
+sub _d {
+   my ($package, undef, $line) = caller 0;
+   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
+        map { defined $_ ? $_ : 'undef' }
+        @_;
+   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
+}
+
+if ( PTDEBUG ) {
+   print STDERR '# ', $^X, ' ', $], "\n";
+   if ( my $uname = `uname -a` ) {
+      $uname =~ s/\s+/ /g;
+      print STDERR "# $uname\n";
+   }
+   print STDERR '# Arguments: ',
+      join(' ', map { my $a = "_[$_]_"; $a =~ s/\n/\n# /g; $a; } @ARGV), "\n";
+}
+
+1;
+}
+# ###########################################################################
+# End OptionParser package
+# ###########################################################################
+
+# ###########################################################################
+# Lmo::Utils package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Lmo/Utils.pm
+#   t/lib/Lmo/Utils.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Lmo::Utils;
+
+use strict;
+use warnings qw( FATAL all );
+require Exporter;
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+BEGIN {
+   @ISA = qw(Exporter);
+   @EXPORT = @EXPORT_OK = qw(
+      _install_coderef
+      _unimport_coderefs
+      _glob_for
+      _stash_for
+   );
+}
+
+{
+   no strict 'refs';
+   sub _glob_for {
+      return \*{shift()}
+   }
+
+   sub _stash_for {
+      return \%{ shift() . "::" };
+   }
+}
+
+sub _install_coderef {
+   my ($to, $code) = @_;
+
+   return *{ _glob_for $to } = $code;
+}
+
+sub _unimport_coderefs {
+   my ($target, @names) = @_;
+   return unless @names;
+   my $stash = _stash_for($target);
+   foreach my $name (@names) {
+      if ($stash->{$name} and defined(&{$stash->{$name}})) {
+         delete $stash->{$name};
+      }
+   }
+}
+
+1;
+}
+# ###########################################################################
+# End Lmo::Utils package
+# ###########################################################################
+
+# ###########################################################################
+# Lmo::Meta package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Lmo/Meta.pm
+#   t/lib/Lmo/Meta.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Lmo::Meta;
+use strict;
+use warnings qw( FATAL all );
+
+my %metadata_for;
+
+sub new {
+   my $class = shift;
+   return bless { @_ }, $class
+}
+
+sub metadata_for {
+   my $self    = shift;
+   my ($class) = @_;
+
+   return $metadata_for{$class} ||= {};
+}
+
+sub class { shift->{class} }
+
+sub attributes {
+   my $self = shift;
+   return keys %{$self->metadata_for($self->class)}
+}
+
+sub attributes_for_new {
+   my $self = shift;
+   my @attributes;
+
+   my $class_metadata = $self->metadata_for($self->class);
+   while ( my ($attr, $meta) = each %$class_metadata ) {
+      if ( exists $meta->{init_arg} ) {
+         push @attributes, $meta->{init_arg}
+               if defined $meta->{init_arg};
+      }
+      else {
+         push @attributes, $attr;
+      }
+   }
+   return @attributes;
+}
+
+1;
+}
+# ###########################################################################
+# End Lmo::Meta package
+# ###########################################################################
+
+# ###########################################################################
+# Lmo::Object package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Lmo/Object.pm
+#   t/lib/Lmo/Object.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Lmo::Object;
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(blessed);
+
+use Lmo::Meta;
+use Lmo::Utils qw(_glob_for);
+
+sub new {
+   my $class = shift;
+   my $args  = $class->BUILDARGS(@_);
+
+   my $class_metadata = Lmo::Meta->metadata_for($class);
+
+   my @args_to_delete;
+   while ( my ($attr, $meta) = each %$class_metadata ) {
+      next unless exists $meta->{init_arg};
+      my $init_arg = $meta->{init_arg};
+
+      if ( defined $init_arg ) {
+         $args->{$attr} = delete $args->{$init_arg};
+      }
+      else {
+         push @args_to_delete, $attr;
+      }
+   }
+
+   delete $args->{$_} for @args_to_delete;
+
+   for my $attribute ( keys %$args ) {
+      if ( my $coerce = $class_metadata->{$attribute}{coerce} ) {
+         $args->{$attribute} = $coerce->($args->{$attribute});
+      }
+      if ( my $isa_check = $class_metadata->{$attribute}{isa} ) {
+         my ($check_name, $check_sub) = @$isa_check;
+         $check_sub->($args->{$attribute});
+      }
+   }
+
+   while ( my ($attribute, $meta) = each %$class_metadata ) {
+      next unless $meta->{required};
+      Carp::confess("Attribute ($attribute) is required for $class")
+         if ! exists $args->{$attribute}
+   }
+
+   my $self = bless $args, $class;
+
+   my @build_subs;
+   my $linearized_isa = mro::get_linear_isa($class);
+
+   for my $isa_class ( @$linearized_isa ) {
+      unshift @build_subs, *{ _glob_for "${isa_class}::BUILD" }{CODE};
+   }
+   my @args = %$args;
+   for my $sub (grep { defined($_) && exists &$_ } @build_subs) {
+      $sub->( $self, @args);
+   }
+   return $self;
+}
+
+sub BUILDARGS {
+   shift; # No need for the classname
+   if ( @_ == 1 && ref($_[0]) ) {
+      Carp::confess("Single parameters to new() must be a HASH ref, not $_[0]")
+         unless ref($_[0]) eq ref({});
+      return {%{$_[0]}} # We want a new reference, always
+   }
+   else {
+      return { @_ };
+   }
+}
+
+sub meta {
+   my $class = shift;
+   $class    = Scalar::Util::blessed($class) || $class;
+   return Lmo::Meta->new(class => $class);
+}
+
+1;
+}
+# ###########################################################################
+# End Lmo::Object package
+# ###########################################################################
+
+# ###########################################################################
+# Lmo::Types package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Lmo/Types.pm
+#   t/lib/Lmo/Types.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Lmo::Types;
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+
+our %TYPES = (
+   Bool   => sub { !$_[0] || (defined $_[0] && looks_like_number($_[0]) && $_[0] == 1) },
+   Num    => sub { defined $_[0] && looks_like_number($_[0]) },
+   Int    => sub { defined $_[0] && looks_like_number($_[0]) && $_[0] == int($_[0]) },
+   Str    => sub { defined $_[0] },
+   Object => sub { defined $_[0] && blessed($_[0]) },
+   FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
+
+   map {
+      my $type = /R/ ? $_ : uc $_;
+      $_ . "Ref" => sub { ref $_[0] eq $type }
+   } qw(Array Code Hash Regexp Glob Scalar)
+);
+
+sub check_type_constraints {
+   my ($attribute, $type_check, $check_name, $val) = @_;
+   ( ref($type_check) eq 'CODE'
+      ? $type_check->($val)
+      : (ref $val eq $type_check
+         || ($val && $val eq $type_check)
+         || (exists $TYPES{$type_check} && $TYPES{$type_check}->($val)))
+   )
+   || Carp::confess(
+        qq<Attribute ($attribute) does not pass the type constraint because: >
+      . qq<Validation failed for '$check_name' with value >
+      . (defined $val ? Lmo::Dumper($val) : 'undef') )
+}
+
+sub _nested_constraints {
+   my ($attribute, $aggregate_type, $type) = @_;
+
+   my $inner_types;
+   if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
+      $inner_types = _nested_constraints($1, $2);
+   }
+   else {
+      $inner_types = $TYPES{$type};
+   }
+
+   if ( $aggregate_type eq 'ArrayRef' ) {
+      return sub {
+         my ($val) = @_;
+         return unless ref($val) eq ref([]);
+
+         if ($inner_types) {
+            for my $value ( @{$val} ) {
+               return unless $inner_types->($value)
+            }
+         }
+         else {
+            for my $value ( @{$val} ) {
+               return unless $value && ($value eq $type
+                        || (Scalar::Util::blessed($value) && $value->isa($type)));
+            }
+         }
+         return 1;
+      };
+   }
+   elsif ( $aggregate_type eq 'Maybe' ) {
+      return sub {
+         my ($value) = @_;
+         return 1 if ! defined($value);
+         if ($inner_types) {
+            return unless $inner_types->($value)
+         }
+         else {
+            return unless $value eq $type
+                        || (Scalar::Util::blessed($value) && $value->isa($type));
+         }
+         return 1;
+      }
+   }
+   else {
+      Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe");
+   }
+}
+
+1;
+}
+# ###########################################################################
+# End Lmo::Types package
+# ###########################################################################
+
+# ###########################################################################
+# Lmo package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Lmo.pm
+#   t/lib/Lmo.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+BEGIN {
+$INC{"Lmo.pm"} = __FILE__;
+package Lmo;
+our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo.
+
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+use Lmo::Meta;
+use Lmo::Object;
+use Lmo::Types;
+
+use Lmo::Utils;
+
+my %export_for;
+sub import {
+   warnings->import(qw(FATAL all));
+   strict->import();
+
+   my $caller     = scalar caller(); # Caller's package
+   my %exports = (
+      extends  => \&extends,
+      has      => \&has,
+      with     => \&with,
+      override => \&override,
+      confess  => \&Carp::confess,
+   );
+
+   $export_for{$caller} = \%exports;
+
+   for my $keyword ( keys %exports ) {
+      _install_coderef "${caller}::$keyword" => $exports{$keyword};
+   }
+
+   if ( !@{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] } ) {
+      @_ = "Lmo::Object";
+      goto *{ _glob_for "${caller}::extends" }{CODE};
+   }
+}
+
+sub extends {
+   my $caller = scalar caller();
+   for my $class ( @_ ) {
+      _load_module($class);
+   }
+   _set_package_isa($caller, @_);
+   _set_inherited_metadata($caller);
+}
+
+sub _load_module {
+   my ($class) = @_;
+
+   (my $file = $class) =~ s{::|'}{/}g;
+   $file .= '.pm';
+   { local $@; eval { require "$file" } } # or warn $@;
+   return;
+}
+
+sub with {
+   my $package = scalar caller();
+   require Role::Tiny;
+   for my $role ( @_ ) {
+      _load_module($role);
+      _role_attribute_metadata($package, $role);
+   }
+   Role::Tiny->apply_roles_to_package($package, @_);
+}
+
+sub _role_attribute_metadata {
+   my ($package, $role) = @_;
+
+   my $package_meta = Lmo::Meta->metadata_for($package);
+   my $role_meta    = Lmo::Meta->metadata_for($role);
+
+   %$package_meta = (%$role_meta, %$package_meta);
+}
+
+sub has {
+   my $names  = shift;
+   my $caller = scalar caller();
+
+   my $class_metadata = Lmo::Meta->metadata_for($caller);
+
+   for my $attribute ( ref $names ? @$names : $names ) {
+      my %args   = @_;
+      my $method = ($args{is} || '') eq 'ro'
+         ? sub {
+            Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller}::${attribute}")
+               if $#_;
+            return $_[0]{$attribute};
+         }
+         : sub {
+            return $#_
+                  ? $_[0]{$attribute} = $_[1]
+                  : $_[0]{$attribute};
+         };
+
+      $class_metadata->{$attribute} = ();
+
+      if ( my $type_check = $args{isa} ) {
+         my $check_name = $type_check;
+
+         if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
+            $type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type);
+         }
+
+         my $check_sub = sub {
+            my ($new_val) = @_;
+            Lmo::Types::check_type_constraints($attribute, $type_check, $check_name, $new_val);
+         };
+
+         $class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
+         my $orig_method = $method;
+         $method = sub {
+            $check_sub->($_[1]) if $#_;
+            goto &$orig_method;
+         };
+      }
+
+      if ( my $builder = $args{builder} ) {
+         my $original_method = $method;
+         $method = sub {
+               $#_
+                  ? goto &$original_method
+                  : ! exists $_[0]{$attribute}
+                     ? $_[0]{$attribute} = $_[0]->$builder
+                     : goto &$original_method
+         };
+      }
+
+      if ( my $code = $args{default} ) {
+         Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef")
+               unless ref($code) eq 'CODE';
+         my $original_method = $method;
+         $method = sub {
+               $#_
+                  ? goto &$original_method
+                  : ! exists $_[0]{$attribute}
+                     ? $_[0]{$attribute} = $_[0]->$code
+                     : goto &$original_method
+         };
+      }
+
+      if ( my $role = $args{does} ) {
+         my $original_method = $method;
+         $method = sub {
+            if ( $#_ ) {
+               Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
+                  unless Scalar::Util::blessed($_[1]) && eval { $_[1]->does($role) }
+            }
+            goto &$original_method
+         };
+      }
+
+      if ( my $coercion = $args{coerce} ) {
+         $class_metadata->{$attribute}{coerce} = $coercion;
+         my $original_method = $method;
+         $method = sub {
+            if ( $#_ ) {
+               return $original_method->($_[0], $coercion->($_[1]))
+            }
+            goto &$original_method;
+         }
+      }
+
+      _install_coderef "${caller}::$attribute" => $method;
+
+      if ( $args{required} ) {
+         $class_metadata->{$attribute}{required} = 1;
+      }
+
+      if ($args{clearer}) {
+         _install_coderef "${caller}::$args{clearer}"
+            => sub { delete shift->{$attribute} }
+      }
+
+      if ($args{predicate}) {
+         _install_coderef "${caller}::$args{predicate}"
+            => sub { exists shift->{$attribute} }
+      }
+
+      if ($args{handles}) {
+         _has_handles($caller, $attribute, \%args);
+      }
+
+      if (exists $args{init_arg}) {
+         $class_metadata->{$attribute}{init_arg} = $args{init_arg};
+      }
+   }
+}
+
+sub _has_handles {
+   my ($caller, $attribute, $args) = @_;
+   my $handles = $args->{handles};
+
+   my $ref = ref $handles;
+   my $kv;
+   if ( $ref eq ref [] ) {
+         $kv = { map { $_,$_ } @{$handles} };
+   }
+   elsif ( $ref eq ref {} ) {
+         $kv = $handles;
+   }
+   elsif ( $ref eq ref qr// ) {
+         Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)")
+            unless $args->{isa};
+         my $target_class = $args->{isa};
+         $kv = {
+            map   { $_, $_     }
+            grep  { $_ =~ $handles }
+            grep  { !exists $Lmo::Object::{$_} && $target_class->can($_) }
+            grep  { !$export_for{$target_class}->{$_} }
+            keys %{ _stash_for $target_class }
+         };
+   }
+   else {
+         Carp::confess("handles for $ref not yet implemented");
+   }
+
+   while ( my ($method, $target) = each %{$kv} ) {
+         my $name = _glob_for "${caller}::$method";
+         Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation")
+            if defined &$name;
+
+         my ($target, @curried_args) = ref($target) ? @$target : $target;
+         *$name = sub {
+            my $self        = shift;
+            my $delegate_to = $self->$attribute();
+            my $error = "Cannot delegate $method to $target because the value of $attribute";
+            Carp::confess("$error is not defined") unless $delegate_to;
+            Carp::confess("$error is not an object (got '$delegate_to')")
+               unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target));
+            return $delegate_to->$target(@curried_args, @_);
+         }
+   }
+}
+
+sub _set_package_isa {
+   my ($package, @new_isa) = @_;
+   my $package_isa  = \*{ _glob_for "${package}::ISA" };
+   @{*$package_isa} = @new_isa;
+}
+
+sub _set_inherited_metadata {
+   my $class = shift;
+   my $class_metadata = Lmo::Meta->metadata_for($class);
+   my $linearized_isa = mro::get_linear_isa($class);
+   my %new_metadata;
+
+   for my $isa_class (reverse @$linearized_isa) {
+      my $isa_metadata = Lmo::Meta->metadata_for($isa_class);
+      %new_metadata = (
+         %new_metadata,
+         %$isa_metadata,
+      );
+   }
+   %$class_metadata = %new_metadata;
+}
+
+sub unimport {
+   my $caller = scalar caller();
+   my $target = caller;
+  _unimport_coderefs($target, keys %{$export_for{$caller}});
+}
+
+sub Dumper {
+   require Data::Dumper;
+   local $Data::Dumper::Indent    = 0;
+   local $Data::Dumper::Sortkeys  = 0;
+   local $Data::Dumper::Quotekeys = 0;
+   local $Data::Dumper::Terse     = 1;
+
+   Data::Dumper::Dumper(@_)
+}
+
+BEGIN {
+   if ($] >= 5.010) {
+      { local $@; require mro; }
+   }
+   else {
+      local $@;
+      eval {
+         require MRO::Compat;
+      } or do {
+         *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub {
+            no strict 'refs';
+
+            my $classname = shift;
+
+            my @lin = ($classname);
+            my %stored;
+            foreach my $parent (@{"$classname\::ISA"}) {
+               my $plin = mro::get_linear_isa_dfs($parent);
+               foreach (@$plin) {
+                     next if exists $stored{$_};
+                     push(@lin, $_);
+                     $stored{$_} = 1;
+               }
+            }
+            return \@lin;
+         };
+      }
+   }
+}
+
+sub override {
+   my ($methods, $code) = @_;
+   my $caller          = scalar caller;
+
+   for my $method ( ref($methods) ? @$methods : $methods ) {
+      my $full_method     = "${caller}::${method}";
+      *{_glob_for $full_method} = $code;
+   }
+}
+
+}
+1;
+}
+# ###########################################################################
+# End Lmo package
+# ###########################################################################
+
+# ###########################################################################
+# VersionParser package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/VersionParser.pm
+#   t/lib/VersionParser.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package VersionParser;
+
+use Lmo;
+use Scalar::Util qw(blessed);
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use overload (
+   '""'     => "version",
+   '<=>'    => "cmp",
+   'cmp'    => "cmp",
+   fallback => 1,
+);
+
+use Carp ();
+
+has major => (
+    is       => 'ro',
+    isa      => 'Int',
+    required => 1,
+);
+
+has [qw( minor revision )] => (
+    is  => 'ro',
+    isa => 'Num',
+);
+
+has flavor => (
+    is      => 'ro',
+    isa     => 'Str',
+    default => sub { 'Unknown' },
+);
+
+has innodb_version => (
+    is      => 'ro',
+    isa     => 'Str',
+    default => sub { 'NO' },
+);
+
+sub series {
+   my $self = shift;
+   return $self->_join_version($self->major, $self->minor);
+}
+
+sub version {
+   my $self = shift;
+   return $self->_join_version($self->major, $self->minor, $self->revision);
+}
+
+sub is_in {
+   my ($self, $target) = @_;
+
+   return $self eq $target;
+}
+
+sub _join_version {
+    my ($self, @parts) = @_;
+
+    return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
+}
+sub _split_version {
+   my ($self, $str) = @_;
+   my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
+   return @version_parts[0..2];
+}
+
+sub normalized_version {
+   my ( $self ) = @_;
+   my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
+                                                      $self->minor,
+                                                      $self->revision);
+   PTDEBUG && _d($self->version, 'normalizes to', $result);
+   return $result;
+}
+
+sub comment {
+   my ( $self, $cmd ) = @_;
+   my $v = $self->normalized_version();
+
+   return "/*!$v $cmd */"
+}
+
+my @methods = qw(major minor revision);
+sub cmp {
+   my ($left, $right) = @_;
+   my $right_obj = (blessed($right) && $right->isa(ref($left)))
+                   ? $right
+                   : ref($left)->new($right);
+
+   my $retval = 0;
+   for my $m ( @methods ) {
+      last unless defined($left->$m) && defined($right_obj->$m);
+      $retval = $left->$m <=> $right_obj->$m;
+      last if $retval;
+   }
+   return $retval;
+}
+
+sub BUILDARGS {
+   my $self = shift;
+
+   if ( @_ == 1 ) {
+      my %args;
+      if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
+         PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
+         my $dbh = $_[0];
+         local $dbh->{FetchHashKeyName} = 'NAME_lc';
+         my $query = eval {
+            $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
+         };
+         if ( $query ) {
+            $query = { map { $_->{variable_name} => $_->{value} } @$query };
+            @args{@methods} = $self->_split_version($query->{version});
+            $args{flavor} = delete $query->{version_comment}
+                  if $query->{version_comment};
+         }
+         elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
+            @args{@methods} = $self->_split_version($query);
+         }
+         else {
+            Carp::confess("Couldn't get the version from the dbh while "
+                        . "creating a VersionParser object: $@");
+         }
+         $args{innodb_version} = eval { $self->_innodb_version($dbh) };
+      }
+      elsif ( !ref($_[0]) ) {
+         @args{@methods} = $self->_split_version($_[0]);
+      }
+
+      for my $method (@methods) {
+         delete $args{$method} unless defined $args{$method};
+      }
+      @_ = %args if %args;
+   }
+
+   return $self->SUPER::BUILDARGS(@_);
+}
+
+sub _innodb_version {
+   my ( $self, $dbh ) = @_;
+   return unless $dbh;
+   my $innodb_version = "NO";
+
+   my ($innodb) =
+      grep { $_->{engine} =~ m/InnoDB/i }
+      map  {
+         my %hash;
+         @hash{ map { lc $_ } keys %$_ } = values %$_;
+         \%hash;
+      }
+      @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
+   if ( $innodb ) {
+      PTDEBUG && _d("InnoDB support:", $innodb->{support});
+      if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
+         my $vars = $dbh->selectrow_hashref(
+            "SHOW VARIABLES LIKE 'innodb_version'");
+         $innodb_version = !$vars ? "BUILTIN"
+                         :          ($vars->{Value} || $vars->{value});
+      }
+      else {
+         $innodb_version = $innodb->{support};  # probably DISABLED or NO
+      }
+   }
+
+   PTDEBUG && _d("InnoDB version:", $innodb_version);
+   return $innodb_version;
+}
+
+sub _d {
+   my ($package, undef, $line) = caller 0;
+   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
+        map { defined $_ ? $_ : 'undef' }
+        @_;
+   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
+}
+
+no Lmo;
+1;
+}
+# ###########################################################################
+# End VersionParser package
+# ###########################################################################
+
+# ###########################################################################
+# DSNParser package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/DSNParser.pm
+#   t/lib/DSNParser.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package DSNParser;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Data::Dumper;
+$Data::Dumper::Indent    = 0;
+$Data::Dumper::Quotekeys = 0;
+
+my $dsn_sep = qr/(?<!\\),/;
+
+eval {
+   require DBI;
+};
+my $have_dbi = $EVAL_ERROR ? 0 : 1;
+
+sub new {
+   my ( $class, %args ) = @_;
+   foreach my $arg ( qw(opts) ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my $self = {
+      opts => {}  # h, P, u, etc.  Should come from DSN OPTIONS section in POD.
+   };
+   foreach my $opt ( @{$args{opts}} ) {
+      if ( !$opt->{key} || !$opt->{desc} ) {
+         die "Invalid DSN option: ", Dumper($opt);
+      }
+      PTDEBUG && _d('DSN option:',
+         join(', ',
+            map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') }
+               keys %$opt
+         )
+      );
+      $self->{opts}->{$opt->{key}} = {
+         dsn  => $opt->{dsn},
+         desc => $opt->{desc},
+         copy => $opt->{copy} || 0,
+      };
+   }
+   return bless $self, $class;
+}
+
+sub prop {
+   my ( $self, $prop, $value ) = @_;
+   if ( @_ > 2 ) {
+      PTDEBUG && _d('Setting', $prop, 'property');
+      $self->{$prop} = $value;
+   }
+   return $self->{$prop};
+}
+
+sub parse {
+   my ( $self, $dsn, $prev, $defaults ) = @_;
+   if ( !$dsn ) {
+      PTDEBUG && _d('No DSN to parse');
+      return;
+   }
+   PTDEBUG && _d('Parsing', $dsn);
+   $prev     ||= {};
+   $defaults ||= {};
+   my %given_props;
+   my %final_props;
+   my $opts = $self->{opts};
+
+   foreach my $dsn_part ( split($dsn_sep, $dsn) ) {
+      $dsn_part =~ s/\\,/,/g;
+      if ( my ($prop_key, $prop_val) = $dsn_part =~  m/^(.)=(.*)$/ ) {
+         $given_props{$prop_key} = $prop_val;
+      }
+      else {
+         PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part);
+         $given_props{h} = $dsn_part;
+      }
+   }
+
+   foreach my $key ( keys %$opts ) {
+      PTDEBUG && _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};
+         PTDEBUG && _d('Copying value for', $key, 'from previous DSN');
+      }
+      if ( !defined $final_props{$key} ) {
+         $final_props{$key} = $defaults->{$key};
+         PTDEBUG && _d('Copying value for', $key, 'from defaults');
+      }
+   }
+
+   foreach my $key ( keys %given_props ) {
+      die "Unknown DSN option '$key' in '$dsn'.  For more details, "
+            . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
+            . "for complete documentation."
+         unless exists $opts->{$key};
+   }
+   if ( (my $required = $self->prop('required')) ) {
+      foreach my $key ( keys %$required ) {
+         die "Missing required DSN option '$key' in '$dsn'.  For more details, "
+               . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
+               . "for complete documentation."
+            unless $final_props{$key};
+      }
+   }
+
+   return \%final_props;
+}
+
+sub parse_options {
+   my ( $self, $o ) = @_;
+   die 'I need an OptionParser object' unless ref $o eq 'OptionParser';
+   my $dsn_string
+      = join(',',
+          map  { "$_=".$o->get($_); }
+          grep { $o->has($_) && $o->get($_) }
+          keys %{$self->{opts}}
+        );
+   PTDEBUG && _d('DSN string made from options:', $dsn_string);
+   return $self->parse($dsn_string);
+}
+
+sub as_string {
+   my ( $self, $dsn, $props ) = @_;
+   return $dsn unless ref $dsn;
+   my @keys = $props ? @$props : sort keys %$dsn;
+   return join(',',
+      map  { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) }
+      grep {
+         exists $self->{opts}->{$_}
+         && exists $dsn->{$_}
+         && defined $dsn->{$_}
+      } @keys);
+}
+
+sub usage {
+   my ( $self ) = @_;
+   my $usage
+      = "DSN syntax is key=value[,key=value...]  Allowable DSN keys:\n\n"
+      . "  KEY  COPY  MEANING\n"
+      . "  ===  ====  =============================================\n";
+   my %opts = %{$self->{opts}};
+   foreach my $key ( sort keys %opts ) {
+      $usage .= "  $key    "
+             .  ($opts{$key}->{copy} ? 'yes   ' : 'no    ')
+             .  ($opts{$key}->{desc} || '[No description]')
+             . "\n";
+   }
+   $usage .= "\n  If the DSN is a bareword, the word is treated as the 'h' key.\n";
+   return $usage;
+}
+
+sub get_cxn_params {
+   my ( $self, $info ) = @_;
+   my $dsn;
+   my %opts = %{$self->{opts}};
+   my $driver = $self->prop('dbidriver') || '';
+   if ( $driver eq 'Pg' ) {
+      $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';'
+         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
+                     grep { defined $info->{$_} }
+                     qw(h P));
+   }
+   else {
+      $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
+         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
+                     grep { defined $info->{$_} }
+                     qw(F h P S A s))
+         . ';mysql_read_default_group=client'
+         . ($info->{L} ? ';mysql_local_infile=1' : '');
+   }
+   PTDEBUG && _d($dsn);
+   return ($dsn, $info->{u}, $info->{p});
+}
+
+sub fill_in_dsn {
+   my ( $self, $dbh, $dsn ) = @_;
+   my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name');
+   my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()');
+   $user =~ s/@.*//;
+   $dsn->{h} ||= $vars->{hostname}->{Value};
+   $dsn->{S} ||= $vars->{'socket'}->{Value};
+   $dsn->{P} ||= $vars->{port}->{Value};
+   $dsn->{u} ||= $user;
+   $dsn->{D} ||= $db;
+}
+
+sub get_dbh {
+   my ( $self, $cxn_string, $user, $pass, $opts ) = @_;
+   $opts ||= {};
+   my $defaults = {
+      AutoCommit         => 0,
+      RaiseError         => 1,
+      PrintError         => 0,
+      ShowErrorStatement => 1,
+      mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0),
+   };
+   @{$defaults}{ keys %$opts } = values %$opts;
+   if (delete $defaults->{L}) { # L for LOAD DATA LOCAL INFILE, our own extension
+      $defaults->{mysql_local_infile} = 1;
+   }
+
+   if ( $opts->{mysql_use_result} ) {
+      $defaults->{mysql_use_result} = 1;
+   }
+
+   if ( !$have_dbi ) {
+      die "Cannot connect to MySQL because the Perl DBI module is not "
+         . "installed or not found.  Run 'perl -MDBI' to see the directories "
+         . "that Perl searches for DBI.  If DBI is not installed, try:\n"
+         . "  Debian/Ubuntu  apt-get install libdbi-perl\n"
+         . "  RHEL/CentOS    yum install perl-DBI\n"
+         . "  OpenSolaris    pkg install pkg:/SUNWpmdbi\n";
+
+   }
+
+   my $dbh;
+   my $tries = 2;
+   while ( !$dbh && $tries-- ) {
+      PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
+         join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
+
+      $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
+
+      if ( !$dbh && $EVAL_ERROR ) {
+         if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
+            die "Cannot connect to MySQL because the Perl DBD::mysql module is "
+               . "not installed or not found.  Run 'perl -MDBD::mysql' to see "
+               . "the directories that Perl searches for DBD::mysql.  If "
+               . "DBD::mysql is not installed, try:\n"
+               . "  Debian/Ubuntu  apt-get install libdbd-mysql-perl\n"
+               . "  RHEL/CentOS    yum install perl-DBD-MySQL\n"
+               . "  OpenSolaris    pkg install pkg:/SUNWapu13dbd-mysql\n";
+         }
+         elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
+            PTDEBUG && _d('Going to try again without utf8 support');
+            delete $defaults->{mysql_enable_utf8};
+         }
+         if ( !$tries ) {
+            die $EVAL_ERROR;
+         }
+      }
+   }
+
+   if ( $cxn_string =~ m/mysql/i ) {
+      my $sql;
+
+      my ($charset) = $cxn_string =~ m/charset=([\w]+)/;
+      if ( $charset ) {
+         $sql = qq{/*!40101 SET NAMES "$charset"*/};
+         PTDEBUG && _d($dbh, $sql);
+         eval { $dbh->do($sql) };
+         if ( $EVAL_ERROR ) {
+            die "Error setting NAMES to $charset: $EVAL_ERROR";
+         }
+      }
+      else {
+         my ($mysql_version) = eval { $dbh->selectrow_array('SELECT VERSION()') };
+         if ( $EVAL_ERROR ) {
+            die "Cannot get MySQL version: $EVAL_ERROR";
+         }
+         my (undef, $character_set_server) = eval { $dbh->selectrow_array("SHOW VARIABLES LIKE 'character_set_server'") };
+         if ( $EVAL_ERROR ) {
+            die "Cannot get MySQL var character_set_server: $EVAL_ERROR";
+         }
+
+         if ( $mysql_version =~ m/^(\d+)\.(\d)\.(\d+).*/ ) {
+            if ( $1 >= 8 && $character_set_server =~ m/^utf8/ ) {
+               $dbh->{mysql_enable_utf8} = 1;
+               $charset = $character_set_server;
+               my $msg = "MySQL version $mysql_version >= 8 and character_set_server = $character_set_server\n".
+                        "Setting: SET NAMES $character_set_server";
+               PTDEBUG && _d($msg);
+               eval { $dbh->do("SET NAMES '$character_set_server'") };
+               if ( $EVAL_ERROR ) {
+                  die "Cannot SET NAMES $character_set_server: $EVAL_ERROR";
+               }
+            }
+         }
+      }
+      PTDEBUG && _d('Enabling charset for STDOUT');
+      if ( $charset && $charset =~ m/^utf8/ ) {
+         binmode(STDOUT, ':utf8')
+            or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
+         binmode(STDERR, ':utf8')
+            or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
+      }
+      else {
+         binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
+      }
+
+      if ( my $vars = $self->prop('set-vars') ) {
+         $self->set_vars($dbh, $vars);
+      }
+
+      $sql = 'SELECT @@SQL_MODE';
+      PTDEBUG && _d($dbh, $sql);
+      my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
+      if ( $EVAL_ERROR ) {
+         die "Error getting the current SQL_MODE: $EVAL_ERROR";
+      }
+
+      $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
+            . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
+            . ($sql_mode ? ",$sql_mode" : '')
+            . '\'*/';
+      PTDEBUG && _d($dbh, $sql);
+      eval { $dbh->do($sql) };
+      if ( $EVAL_ERROR ) {
+         die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
+           . ($sql_mode ? " and $sql_mode" : '')
+           . ": $EVAL_ERROR";
+      }
+   }
+
+   PTDEBUG && _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 ) = @_;
+   PTDEBUG && $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 set_vars {
+   my ($self, $dbh, $vars) = @_;
+
+   return unless $vars;
+
+   foreach my $var ( sort keys %$vars ) {
+      my $val = $vars->{$var}->{val};
+
+      (my $quoted_var = $var) =~ s/_/\\_/;
+      my ($var_exists, $current_val);
+      eval {
+         ($var_exists, $current_val) = $dbh->selectrow_array(
+            "SHOW VARIABLES LIKE '$quoted_var'");
+      };
+      my $e = $EVAL_ERROR;
+      if ( $e ) {
+         PTDEBUG && _d($e);
+      }
+
+      if ( $vars->{$var}->{default} && !$var_exists ) {
+         PTDEBUG && _d('Not setting default var', $var,
+            'because it does not exist');
+         next;
+      }
+
+      if ( $current_val && $current_val eq $val ) {
+         PTDEBUG && _d('Not setting var', $var, 'because its value',
+            'is already', $val);
+         next;
+      }
+
+      my $sql = "SET SESSION $var=$val";
+      PTDEBUG && _d($dbh, $sql);
+      eval { $dbh->do($sql) };
+      if ( my $set_error = $EVAL_ERROR ) {
+         chomp($set_error);
+         $set_error =~ s/ at \S+ line \d+//;
+         my $msg = "Error setting $var: $set_error";
+         if ( $current_val ) {
+            $msg .= "  The current value for $var is $current_val.  "
+                  . "If the variable is read only (not dynamic), specify "
+                  . "--set-vars $var=$current_val to avoid this warning, "
+                  . "else manually set the variable and restart MySQL.";
+         }
+         warn $msg . "\n\n";
+      }
+   }
+
+   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 DSNParser package
+# ###########################################################################
+
+# ###########################################################################
+# MasterSlave package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/MasterSlave.pm
+#   t/lib/MasterSlave.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package MasterSlave;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+sub check_recursion_method {
+   my ($methods) = @_;
+   if ( @$methods != 1 ) {
+      if ( grep({ !m/processlist|hosts/i } @$methods)
+            && $methods->[0] !~ /^dsn=/i )
+      {
+         die  "Invalid combination of recursion methods: "
+            . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". "
+            . "Only hosts and processlist may be combined.\n"
+      }
+   }
+   else {
+      my ($method) = @$methods;
+      die "Invalid recursion method: " . ( $method || 'undef' )
+         unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i;
+   }
+}
+
+sub new {
+   my ( $class, %args ) = @_;
+   my @required_args = qw(OptionParser DSNParser Quoter);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my $self = {
+      %args,
+      replication_thread => {},
+   };
+   return bless $self, $class;
+}
+
+sub get_replicas {
+   my ($self, %args) = @_;
+   my @required_args = qw(make_cxn);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($make_cxn) = @args{@required_args};
+
+   my $replicas  = [];
+   my $dp      = $self->{DSNParser};
+   my $methods = $self->_resolve_recursion_methods($args{dsn});
+
+   return $replicas unless @$methods;
+
+   if ( grep { m/processlist|hosts/i } @$methods ) {
+      my @required_args = qw(dbh dsn);
+      foreach my $arg ( @required_args ) {
+         die "I need a $arg argument" unless $args{$arg};
+      }
+      my ($dbh, $dsn) = @args{@required_args};
+      my $o = $self->{OptionParser};
+
+      $self->recurse_to_replicas(
+         {  dbh              => $dbh,
+            dsn              => $dsn,
+            replica_user     => $o->got('replica-user') ? $o->get('replica-user') : '',
+            replica_password => $o->got('replica-password') ? $o->get('replica-password') : '',
+            replicas         => $args{replicas},
+            callback  => sub {
+               my ( $dsn, $dbh, $level, $parent ) = @_;
+               return unless $level;
+               PTDEBUG && _d('Found replica:', $dp->as_string($dsn));
+               my $replica_dsn = $dsn;
+               if ($o->got('replica-user')) {
+                  $replica_dsn->{u} = $o->get('replica-user');
+                  PTDEBUG && _d("Using replica user ".$o->get('replica-user')." on ".$replica_dsn->{h}.":".$replica_dsn->{P});
+               }
+               if ($o->got('replica-password')) {
+                  $replica_dsn->{p} = $o->get('replica-password');
+                  PTDEBUG && _d("Replica password set");
+               }
+               push @$replicas, $make_cxn->(dsn => $replica_dsn, dbh => $dbh, parent => $parent);
+               return;
+            },
+            wait_no_die => $args{'wait_no_die'},
+         }
+      );
+   } elsif ( $methods->[0] =~ m/^dsn=/i ) {
+      (my $dsn_table_dsn = join ",", @$methods) =~ s/^dsn=//i;
+      $replicas = $self->get_cxn_from_dsn_table(
+         %args,
+         dsn_table_dsn => $dsn_table_dsn,
+         wait_no_die => $args{'wait_no_die'},
+      );
+   }
+   elsif ( $methods->[0] =~ m/none/i ) {
+      PTDEBUG && _d('Not getting to replicas');
+   }
+   else {
+      die "Unexpected recursion methods: @$methods";
+   }
+
+   return $replicas;
+}
+
+sub _resolve_recursion_methods {
+   my ($self, $dsn) = @_;
+   my $o = $self->{OptionParser};
+   if ( $o->got('recursion-method') ) {
+      return $o->get('recursion-method');
+   }
+   elsif ( $dsn && ($dsn->{P} || 3306) != 3306 ) {
+      PTDEBUG && _d('Port number is non-standard; using only hosts method');
+      return [qw(hosts)];
+   }
+   else {
+      return $o->get('recursion-method');
+   }
+}
+
+sub recurse_to_replicas {
+   my ( $self, $args, $level ) = @_;
+   $level ||= 0;
+   my $dp = $self->{DSNParser};
+   my $recurse = $args->{recurse} || $self->{OptionParser}->get('recurse');
+   my $dsn = $args->{dsn};
+   my $replica_user = $args->{replica_user} || '';
+   my $replica_password = $args->{replica_password} || '';
+
+   my $methods = $self->_resolve_recursion_methods($dsn);
+   PTDEBUG && _d('Recursion methods:', @$methods);
+   if ( lc($methods->[0]) eq 'none' ) {
+      PTDEBUG && _d('Not recursing to replicas');
+      return;
+   }
+
+   my $replica_dsn = $dsn;
+   if ($replica_user) {
+      $replica_dsn->{u} = $replica_user;
+      PTDEBUG && _d("Using replica user $replica_user on "
+         . $replica_dsn->{h} . ":" . ( $replica_dsn->{P} ? $replica_dsn->{P} : ""));
+   }
+   if ($replica_password) {
+      $replica_dsn->{p} = $replica_password;
+      PTDEBUG && _d("Replica password set");
+   }
+
+   my $dbh = $args->{dbh};
+
+   my $get_dbh = sub {
+         eval {
+            $dbh = $dp->get_dbh(
+               $dp->get_cxn_params($replica_dsn), { AutoCommit => 1 }
+            );
+            PTDEBUG && _d('Connected to', $dp->as_string($replica_dsn));
+         };
+         if ( $EVAL_ERROR ) {
+            print STDERR "Cannot connect to ", $dp->as_string($replica_dsn), ": ", $EVAL_ERROR, "\n"
+               or die "Cannot print: $OS_ERROR";
+            return;
+         }
+   };
+
+   DBH: {
+      if ( !defined $dbh ) {
+         foreach my $known_replica ( @{$args->{replicas}} ) {
+            if ($known_replica->{dsn}->{h} eq $replica_dsn->{h} and
+                $known_replica->{dsn}->{P} eq $replica_dsn->{P} ) {
+               $dbh = $known_replica->{dbh};
+               last DBH;
+            }
+         }
+         $get_dbh->();
+      }
+   }
+
+   my $sql  = 'SELECT @@SERVER_ID';
+   PTDEBUG && _d($sql);
+   my $id = undef;
+   do {
+      eval {
+         ($id) = $dbh->selectrow_array($sql);
+      };
+	   if ( $EVAL_ERROR ) {
+		   if ( $args->{wait_no_die} ) {
+			   print STDERR "Error getting server id: ", $EVAL_ERROR,
+               "\nRetrying query for server ", $replica_dsn->{h}, ":", $replica_dsn->{P}, "\n";
+            sleep 1;
+            $dbh->disconnect();
+            $get_dbh->();
+         } else {
+            die $EVAL_ERROR;
+         }
+      }
+   } until (defined $id);
+   PTDEBUG && _d('Working on server ID', $id);
+   my $source_thinks_i_am = $dsn->{server_id};
+   if ( !defined $id
+       || ( defined $source_thinks_i_am && $source_thinks_i_am != $id )
+       || $args->{server_ids_seen}->{$id}++
+   ) {
+      PTDEBUG && _d('Server ID seen, or not what source said');
+      if ( $args->{skip_callback} ) {
+         $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent});
+      }
+      return;
+   }
+
+   $args->{callback}->($dsn, $dbh, $level, $args->{parent});
+
+   if ( !defined $recurse || $level < $recurse ) {
+
+      my @replicas =
+         grep { !$_->{source_id} || $_->{source_id} == $id } # Only my replicas.
+         $self->find_replica_hosts($dp, $dbh, $dsn, $methods);
+
+      foreach my $replica ( @replicas ) {
+         PTDEBUG && _d('Recursing from',
+            $dp->as_string($dsn), 'to', $dp->as_string($replica));
+         $self->recurse_to_replicas(
+            { %$args, dsn => $replica, dbh => undef, parent => $dsn, replica_user => $replica_user, $replica_password => $replica_password }, $level + 1 );
+      }
+   }
+}
+
+sub find_replica_hosts {
+   my ( $self, $dsn_parser, $dbh, $dsn, $methods ) = @_;
+
+   PTDEBUG && _d('Looking for replicas on', $dsn_parser->as_string($dsn),
+      'using methods', @$methods);
+
+   my @replicas;
+   METHOD:
+   foreach my $method ( @$methods ) {
+      my $find_replicas = "_find_replicas_by_$method";
+      PTDEBUG && _d('Finding replicas with', $find_replicas);
+      @replicas = $self->$find_replicas($dsn_parser, $dbh, $dsn);
+      last METHOD if @replicas;
+   }
+
+   PTDEBUG && _d('Found', scalar(@replicas), 'replicas');
+   return @replicas;
+}
+
+sub _find_replicas_by_processlist {
+   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
+   my @connected_replicas = $self->get_connected_replicas($dbh);
+   my @replicas = $self->_process_replicas_list($dsn_parser, $dsn, \@connected_replicas);
+   return @replicas;
+}
+
+sub _process_replicas_list {
+   my ($self, $dsn_parser, $dsn, $connected_replicas) = @_;
+   my @replicas = map  {
+      my $replica        = $dsn_parser->parse("h=$_", $dsn);
+      $replica->{source} = 'processlist';
+      $replica;
+   }
+   grep { $_ }
+   map  {
+      my ( $host ) = $_->{host} =~ m/^(.*):\d+$/;
+      if ( $host eq 'localhost' ) {
+         $host = '127.0.0.1'; # Replication never uses sockets.
+      }
+      if ($host =~ m/::/) {
+          $host = '['.$host.']';
+      }
+      $host;
+   } @$connected_replicas;
+
+   return @replicas;
+}
+
+sub _find_replicas_by_hosts {
+   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
+
+   my @replicas;
+
+   my $vp = VersionParser->new($dbh);
+   my $sql = 'SHOW REPLICAS';
+   my $source_name = 'source';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $sql = 'SHOW SLAVE HOSTS';
+      $source_name='master';
+   }
+   
+   PTDEBUG && _d($dbh, $sql);
+   @replicas = @{$dbh->selectall_arrayref($sql, { Slice => {} })};
+
+   if ( @replicas ) {
+      PTDEBUG && _d('Found some SHOW REPLICAS info');
+      @replicas = 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->{source_id} = $hash{"${source_name}_id"};
+         $dsn->{source}    = 'hosts';
+         $dsn;
+      } @replicas;
+   }
+
+   return @replicas;
+}
+
+sub get_connected_replicas {
+   my ( $self, $dbh ) = @_;
+
+   my $show = "SHOW GRANTS FOR ";
+   my $user = 'CURRENT_USER()';
+   my $sql = $show . $user;
+   PTDEBUG && _d($dbh, $sql);
+
+   my $proc;
+   eval {
+      $proc = grep {
+         m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
+      } @{$dbh->selectcol_arrayref($sql)};
+   };
+   if ( $EVAL_ERROR ) {
+
+      if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) {
+         PTDEBUG && _d('Retrying SHOW GRANTS without host; error:',
+            $EVAL_ERROR);
+         ($user) = split('@', $user);
+         $sql    = $show . $user;
+         PTDEBUG && _d($sql);
+         eval {
+            $proc = grep {
+               m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
+            } @{$dbh->selectcol_arrayref($sql)};
+         };
+      }
+
+      die "Failed to $sql: $EVAL_ERROR" if $EVAL_ERROR;
+   }
+   if ( !$proc ) {
+      die "You do not have the PROCESS privilege";
+   }
+
+   $sql = 'SHOW FULL PROCESSLIST';
+   PTDEBUG && _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_source_of {
+   my ( $self, $source, $replica ) = @_;
+
+   my $replica_version = VersionParser->new($replica);
+   my $source_name = 'source';
+   my $source_port = 'source_port';
+   if ( $replica_version < '8.1' || $replica_version->flavor() =~ m/maria/ ) {
+      $source_name = 'master';
+      $source_port = 'master_port';
+   }
+
+   my $source_status = $self->get_source_status($source)
+      or die "The server specified as a source is not a source";
+   my $replica_status  = $self->get_replica_status($replica)
+      or die "The server specified as a replica is not a replica";
+   my @connected     = $self->get_connected_replicas($source)
+      or die "The server specified as a source has no connected replicas";
+   my (undef, $port) = $source->selectrow_array("SHOW VARIABLES LIKE 'port'");
+
+   if ( $port != $replica_status->{$source_port} ) {
+      die "The replica is connected to $replica_status->{$source_port} "
+         . "but the source's port is $port";
+   }
+
+   if ( !grep { $replica_status->{"${source_name}_user"} eq $_->{user} } @connected ) {
+      die "I don't see any replica I/O thread connected with user "
+         . $replica_status->{"${source_name}_user"};
+   }
+
+   if ( ($replica_status->{replica_io_state} || '')
+      eq 'Waiting for ${source_name} to send event' )
+   {
+      my ( $source_log_name, $source_log_num )
+         = $source_status->{file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
+      my ( $replica_log_name, $replica_log_num )
+         = $replica_status->{source_log_file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
+      if ( $source_log_name ne $replica_log_name
+         || abs($source_log_num - $replica_log_num) > 1 )
+      {
+         die "The replica thinks it is reading from "
+            . "$replica_status->{source_log_file},  but the "
+            . "source is writing to $source_status->{file}";
+      }
+   }
+   return 1;
+}
+
+sub get_source_dsn {
+   my ( $self, $dbh, $dsn, $dsn_parser ) = @_;
+
+   my $vp = VersionParser->new($dbh);
+   my $source_host = 'source_host';
+   my $source_port = 'source_port';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_host = 'master_host';
+      $source_port = 'master_port';
+   }
+
+   my $source = $self->get_replica_status($dbh) or return undef;
+   my $spec   = "h=$source->{${source_host}},P=$source->{${source_port}}";
+   return       $dsn_parser->parse($spec, $dsn);
+}
+
+sub get_replica_status {
+   my ( $self, $dbh ) = @_;
+
+   my $server_version = VersionParser->new($dbh);
+   my $replica_name = 'replica';
+   if ( $server_version < '8.1' || $server_version->flavor() =~ m/maria/ ) {
+      $replica_name = 'slave';
+   }
+
+   if ( !$self->{not_a_replica}->{$dbh} ) {
+      my $sth = $self->{sths}->{$dbh}->{REPLICA_STATUS}
+            ||= $dbh->prepare("SHOW ${replica_name} STATUS");
+      PTDEBUG && _d($dbh, "SHOW ${replica_name} STATUS");
+      $sth->execute();
+      my ($sss_rows) = $sth->fetchall_arrayref({}); # Show Replica Status rows
+
+      my $ss;
+      if ( $sss_rows && @$sss_rows ) {
+          if (scalar @$sss_rows > 1) {
+              if (!$self->{channel}) {
+                  die 'This server returned more than one row for SHOW REPLICA STATUS but "channel" was not specified on the command line';
+              }
+              my $replica_use_channels;
+              for my $row (@$sss_rows) {
+                  $row = { map { lc($_) => $row->{$_} } keys %$row }; # lowercase the keys
+                  if ($row->{channel_name}) {
+                      $replica_use_channels = 1;
+                  }
+                  if ($row->{channel_name} eq $self->{channel}) {
+                      $ss = $row;
+                      last;
+                  }
+              }
+              if (!$ss && $replica_use_channels) {
+                 die 'This server is using replication channels but "channel" was not specified on the command line';
+              }
+          } else {
+              if ($sss_rows->[0]->{channel_name} && $sss_rows->[0]->{channel_name} ne $self->{channel}) {
+                  die 'This server is using replication channels but "channel" was not specified on the command line';
+              } else {
+                  $ss = $sss_rows->[0];
+              }
+          }
+
+          if ( $ss && %$ss ) {
+             $ss = { map { lc($_) => $ss->{$_} } keys %$ss }; # lowercase the keys
+             return $ss;
+          }
+          if (!$ss && $self->{channel}) {
+              die "Specified channel name is invalid";
+          }
+      }
+
+      PTDEBUG && _d('This server returns nothing for SHOW REPLICA STATUS');
+      $self->{not_a_replica}->{$dbh}++;
+  }
+}
+
+sub get_source_status {
+   my ( $self, $dbh ) = @_;
+
+   if ( $self->{not_a_source}->{$dbh} ) {
+      PTDEBUG && _d('Server on dbh', $dbh, 'is not a source');
+      return;
+   }
+
+   my $vp = VersionParser->new($dbh);
+   my $source_name = 'binary log';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_name = 'master';
+   }
+
+   my $sth;
+   if ( $self->{sths}->{$dbh} && $dbh && $self->{sths}->{$dbh} == $dbh ) {
+      $sth = $self->{sths}->{$dbh}->{SOURCE_STATUS}
+         ||= $dbh->prepare("SHOW ${source_name} STATUS");
+   }
+   else {
+      $sth = $dbh->prepare("SHOW ${source_name} STATUS");
+   }
+   PTDEBUG && _d($dbh, "SHOW ${source_name} STATUS");
+   $sth->execute();
+   my ($ms) = @{$sth->fetchall_arrayref({})};
+   PTDEBUG && _d(
+      $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
+          : '');
+
+   if ( !$ms || scalar keys %$ms < 2 ) {
+      PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a source');
+      $self->{not_a_source}->{$dbh}++;
+   }
+
+  return { map { lc($_) => $ms->{$_} } keys %$ms }; # lowercase the keys
+}
+
+sub wait_for_source {
+   my ( $self, %args ) = @_;
+   my @required_args = qw(source_status replica_dbh);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($source_status, $replica_dbh) = @args{@required_args};
+   my $timeout       = $args{timeout} || 60;
+
+   my $result;
+   my $waited;
+   if ( $source_status ) {
+      my $replica_status;
+      eval {
+          $replica_status = $self->get_replica_status($replica_dbh);
+      };
+      if ($EVAL_ERROR) {
+          return {
+              result => undef,
+              waited => 0,
+              error  =>'Wait for source: this is a multi-source replica but "channel" was not specified on the command line',
+          };
+      }
+      my $vp = VersionParser->new($replica_dbh);
+      my $source_name = 'source';
+      if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+         $source_name = 'master';
+      }
+      my $channel_sql = $vp > '5.6' && $self->{channel} ? ", '$self->{channel}'" : '';
+      my $sql = "SELECT ${source_name}_POS_WAIT('$source_status->{file}', $source_status->{position}, $timeout $channel_sql)";
+      PTDEBUG && _d($replica_dbh, $sql);
+      my $start = time;
+      ($result) = $replica_dbh->selectrow_array($sql);
+
+      $waited = time - $start;
+
+      PTDEBUG && _d('Result of waiting:', $result);
+      PTDEBUG && _d("Waited", $waited, "seconds");
+   }
+   else {
+      PTDEBUG && _d('Not waiting: this server is not a source');
+   }
+
+   return {
+      result => $result,
+      waited => $waited,
+   };
+}
+
+sub stop_replica {
+   my ( $self, $dbh ) = @_;
+   my $vp = VersionParser->new($dbh);
+   my $replica_name = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $replica_name = 'slave';
+   }
+   my $sth = $self->{sths}->{$dbh}->{STOP_REPLICA}
+         ||= $dbh->prepare("STOP ${replica_name}");
+   PTDEBUG && _d($dbh, $sth->{Statement});
+   $sth->execute();
+}
+
+sub start_replica {
+   my ( $self, $dbh, $pos ) = @_;
+
+   my $vp = VersionParser->new($dbh);
+   my $source_name = 'source';
+   my $replica_name = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_name = 'master';
+      $replica_name = 'slave';
+   }
+
+   if ( $pos ) {
+      my $sql = "START ${replica_name} UNTIL ${source_name}_LOG_FILE='$pos->{file}', "
+              . "${source_name}_LOG_POS=$pos->{position}";
+      PTDEBUG && _d($dbh, $sql);
+      $dbh->do($sql);
+   }
+   else {
+      my $sth = $self->{sths}->{$dbh}->{START_REPLICA}
+            ||= $dbh->prepare("START ${replica_name}");
+      PTDEBUG && _d($dbh, $sth->{Statement});
+      $sth->execute();
+   }
+}
+
+sub catchup_to_source {
+   my ( $self, $replica, $source, $timeout ) = @_;
+   $self->stop_replica($source);
+   $self->stop_replica($replica);
+   my $replica_status  = $self->get_replica_status($replica);
+   my $replica_pos     = $self->repl_posn($replica_status);
+   my $source_status = $self->get_source_status($source);
+   my $source_pos    = $self->repl_posn($source_status);
+   PTDEBUG && _d('Source position:', $self->pos_to_string($source_pos),
+      'Replica position:', $self->pos_to_string($replica_pos));
+
+   my $result;
+   if ( $self->pos_cmp($replica_pos, $source_pos) < 0 ) {
+      PTDEBUG && _d('Waiting for replica to catch up to source');
+      $self->start_replica($replica, $source_pos);
+
+      $result = $self->wait_for_source(
+            source_status => $source_status,
+            replica_dbh   => $replica,
+            timeout       => $timeout,
+            source_status => $source_status
+      );
+      if ($result->{error}) {
+          die $result->{error};
+      }
+      if ( !defined $result->{result} ) {
+         $replica_status = $self->get_replica_status($replica);
+            
+         my $vp = VersionParser->new($replica);
+         my $replica_name = 'replica';
+         if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+            $replica_name = 'slave';
+         }
+
+         if ( !$self->replica_is_running($replica_status, $replica_name) ) {
+            PTDEBUG && _d('Source position:',
+               $self->pos_to_string($source_pos),
+               'Replica position:', $self->pos_to_string($replica_pos));
+            $replica_pos = $self->repl_posn($replica_status);
+            if ( $self->pos_cmp($replica_pos, $source_pos) != 0 ) {
+               die "SOURCE_POS_WAIT() returned NULL but replica has not "
+                  . "caught up to source";
+            }
+            PTDEBUG && _d('Replica is caught up to source and stopped');
+         }
+         else {
+            die "Replica has not caught up to source and it is still running";
+         }
+      }
+   }
+   else {
+      PTDEBUG && _d("Replica is already caught up to source");
+   }
+
+   return $result;
+}
+
+sub catchup_to_same_pos {
+   my ( $self, $s1_dbh, $s2_dbh ) = @_;
+   $self->stop_replica($s1_dbh);
+   $self->stop_replica($s2_dbh);
+   my $s1_status = $self->get_replica_status($s1_dbh);
+   my $s2_status = $self->get_replica_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_replica($s1_dbh, $s2_pos);
+   }
+   elsif ( $self->pos_cmp($s2_pos, $s1_pos) < 0 ) {
+      $self->start_replica($s2_dbh, $s1_pos);
+   }
+
+   $s1_status = $self->get_replica_status($s1_dbh);
+   $s2_status = $self->get_replica_status($s2_dbh);
+   $s1_pos    = $self->repl_posn($s1_status);
+   $s2_pos    = $self->repl_posn($s2_status);
+
+   my $vp1 = VersionParser->new($s1_dbh);
+   my $replica1_name = 'replica';
+   if ( $vp1 < '8.1' || $vp1->flavor() =~ m/maria/ ) {
+      $replica1_name = 'slave';
+   }
+
+   my $vp2 = VersionParser->new($s2_dbh);
+   my $replica2_name = 'replica';
+   if ( $vp2 < '8.1' || $vp2->flavor() =~ m/maria/ ) {
+      $replica2_name = 'slave';
+   }
+
+   if ( $self->replica_is_running($s1_status, $replica1_name)
+     || $self->replica_is_running($s2_status, $replica2_name)
+     || $self->pos_cmp($s1_pos, $s2_pos) != 0)
+   {
+      die "The servers aren't both stopped at the same position";
+   }
+
+}
+
+sub replica_is_running {
+   my ( $self, $replica_status, $replica_name ) = @_;
+   return ($replica_status->{"${replica_name}_sql_running"} || 'No') eq 'Yes';
+}
+
+sub has_replica_updates {
+   my ( $self, $dbh ) = @_;
+   
+   my $vp = VersionParser->new($dbh);
+   my $replica_name = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $replica_name = 'slave';
+   }
+
+   my $sql = qq{SHOW VARIABLES LIKE 'log_${replica_name}_updates'};
+   PTDEBUG && _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},
+      };
+   }
+   elsif ( exists $status->{relay_source_log_file} && exists $status->{exec_source_log_pos} ) {
+      return {
+         file     => $status->{relay_source_log_file},
+         position => $status->{exec_source_log_pos},
+      };
+   }
+   else {
+      return {
+         file     => $status->{relay_master_log_file},
+         position => $status->{exec_master_log_pos},
+      };
+   }
+}
+
+sub get_replica_lag {
+   my ( $self, $dbh ) = @_;
+   
+   my $vp = VersionParser->new($dbh);
+   my $source_name = 'source';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_name = 'master';
+   }
+
+   my $stat = $self->get_replica_status($dbh);
+   return unless $stat;  # server is not a replica
+   return $stat->{"seconds_behind_${source_name}"};
+}
+
+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->{source_host} ) {
+      $host = $dsn->{source_host};
+      $port = $dsn->{source_port};
+   }
+   else {
+      $host = $dsn->{h};
+      $port = $dsn->{P};
+   }
+   return ($host || '[default]') . ( ($port || 3306) == 3306 ? '' : ":$port" );
+}
+
+sub is_replication_thread {
+   my ( $self, $query, %args ) = @_;
+   return unless $query;
+
+   my $type = lc($args{type} || 'all');
+   die "Invalid type: $type"
+      unless $type =~ m/^binlog_dump|slave_io|slave_sql|replica_io|replica_sql|all$/i;
+
+   my $match = 0;
+   if ( $type =~ m/binlog_dump|all/i ) {
+      $match = 1
+         if ($query->{Command} || $query->{command} || '') eq "Binlog Dump";
+   }
+   if ( !$match ) {
+      if ( ($query->{User} || $query->{user} || '') eq "system user" ) {
+         PTDEBUG && _d("Replica replication thread");
+         if ( $type ne 'all' ) {
+            my $state = $query->{State} || $query->{state} || '';
+
+            if ( $state =~ m/^init|end$/ ) {
+               PTDEBUG && _d("Special state:", $state);
+               $match = 1;
+            }
+            else {
+               my ($replica_sql) = $state =~ m/
+                  ^(Waiting\sfor\sthe\snext\sevent
+                   |Reading\sevent\sfrom\sthe\srelay\slog
+                   |Has\sread\sall\srelay\slog;\swaiting
+                   |Making\stemp\sfile
+                   |Waiting\sfor\sslave\smutex\son\sexit
+                   |Waiting\sfor\sreplica\smutex\son\sexit)/xi;
+
+               $match = $type eq 'replica_sql' &&  $replica_sql ? 1
+                      : $type eq 'replica_io'  && !$replica_sql ? 1
+                      :                                       0;
+            }
+         }
+         else {
+            $match = 1;
+         }
+      }
+      else {
+         PTDEBUG && _d('Not system user');
+      }
+
+      if ( !defined $args{check_known_ids} || $args{check_known_ids} ) {
+         my $id = $query->{Id} || $query->{id};
+         if ( $match ) {
+            $self->{replication_thread}->{$id} = 1;
+         }
+         else {
+            if ( $self->{replication_thread}->{$id} ) {
+               PTDEBUG && _d("Thread ID is a known replication thread ID");
+               $match = 1;
+            }
+         }
+      }
+   }
+
+   PTDEBUG && _d('Matches', $type, 'replication thread:',
+      ($match ? 'yes' : 'no'), '; match:', $match);
+
+   return $match;
+}
+
+
+sub get_replication_filters {
+   my ( $self, %args ) = @_;
+   my @required_args = qw(dbh);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($dbh) = @args{@required_args};
+
+   my $vp = VersionParser->new($dbh);
+   my $replica_name = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $replica_name = 'slave';
+   }
+
+   my %filters = ();
+
+   my $status = $self->get_source_status($dbh);
+   if ( $status ) {
+      map { $filters{$_} = $status->{$_} }
+      grep { defined $status->{$_} && $status->{$_} ne '' }
+      qw(
+         binlog_do_db
+         binlog_ignore_db
+      );
+   }
+
+   $status = $self->get_replica_status($dbh);
+   if ( $status ) {
+      map { $filters{$_} = $status->{$_} }
+      grep { defined $status->{$_} && $status->{$_} ne '' }
+      qw(
+         replicate_do_db
+         replicate_ignore_db
+         replicate_do_table
+         replicate_ignore_table
+         replicate_wild_do_table
+         replicate_wild_ignore_table
+      );
+
+      my $sql = "SHOW VARIABLES LIKE '${replica_name}_skip_errors'";
+      PTDEBUG && _d($dbh, $sql);
+      my $row = $dbh->selectrow_arrayref($sql);
+      $filters{replica_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF';
+   }
+
+   return \%filters;
+}
+
+
+sub pos_to_string {
+   my ( $self, $pos ) = @_;
+   my $fmt  = '%s/%020d';
+   return sprintf($fmt, @{$pos}{qw(file position)});
+}
+
+sub reset_known_replication_threads {
+   my ( $self ) = @_;
+   $self->{replication_thread} = {};
+   return;
+}
+
+sub get_cxn_from_dsn_table {
+   my ($self, %args) = @_;
+   my @required_args = qw(dsn_table_dsn make_cxn);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($dsn_table_dsn, $make_cxn) = @args{@required_args};
+   PTDEBUG && _d('DSN table DSN:', $dsn_table_dsn);
+
+   my $dp = $self->{DSNParser};
+   my $q  = $self->{Quoter};
+
+   my $dsn = $dp->parse($dsn_table_dsn);
+   my $dsn_table;
+   if ( $dsn->{D} && $dsn->{t} ) {
+      $dsn_table = $q->quote($dsn->{D}, $dsn->{t});
+   }
+   elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) {
+      $dsn_table = $q->quote($q->split_unquote($dsn->{t}));
+   }
+   else {
+      die "DSN table DSN does not specify a database (D) "
+        . "or a database-qualified table (t)";
+   }
+
+   my $done = 0;
+   my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
+   my $dbh         = $dsn_tbl_cxn->connect();
+   my $sql         = "SELECT dsn FROM $dsn_table ORDER BY id";
+   PTDEBUG && _d($sql);
+   my @cxn;
+   use Data::Dumper;
+   DSN:
+   do {
+      @cxn = ();
+      my $dsn_strings = $dbh->selectcol_arrayref($sql);
+      if ( $dsn_strings ) {
+         foreach my $dsn_string ( @$dsn_strings ) {
+            PTDEBUG && _d('DSN from DSN table:', $dsn_string);
+            if ($args{wait_no_die}) {
+               my $lcxn;
+               eval {
+                  $lcxn = $make_cxn->(dsn_string => $dsn_string);
+               };
+               if ( $EVAL_ERROR && ($dsn_tbl_cxn->lost_connection($EVAL_ERROR)
+                     || $EVAL_ERROR =~ m/Can't connect to MySQL server/)) {
+                  PTDEBUG && _d("Server is not accessible, waiting when it is online again");
+                  sleep(1);
+                  goto DSN;
+               }
+               push @cxn, $lcxn;
+            } else {
+               push @cxn, $make_cxn->(dsn_string => $dsn_string);
+            }
+         }
+      }
+      $done = 1;
+   } until $done;
+   return \@cxn;
+}
+
+sub _d {
+   my ($package, undef, $line) = caller 0;
+   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
+        map { defined $_ ? $_ : 'undef' }
+        @_;
+   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
+}
+
+1;
+}
+# ###########################################################################
+# End MasterSlave package
+# ###########################################################################
+
+# ###########################################################################
+# Daemon package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/Daemon.pm
+#   t/lib/Daemon.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package Daemon;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use POSIX qw(setsid);
+use Fcntl qw(:DEFAULT);
+
+sub new {
+   my ($class, %args) = @_;
+   my $self = {
+      log_file       => $args{log_file},
+      pid_file       => $args{pid_file},
+      daemonize      => $args{daemonize},
+      force_log_file => $args{force_log_file},
+      parent_exit    => $args{parent_exit},
+      pid_file_owner => 0,
+      utf8           => $args{utf8} // 0,
+   };
+   return bless $self, $class;
+}
+
+sub run {
+   my ($self) = @_;
+
+   my $daemonize      = $self->{daemonize};
+   my $pid_file       = $self->{pid_file};
+   my $log_file       = $self->{log_file};
+   my $force_log_file = $self->{force_log_file};
+   my $parent_exit    = $self->{parent_exit};
+   my $utf8           = $self->{utf8};
+
+   PTDEBUG && _d('Starting daemon');
+
+   if ( $pid_file ) {
+      eval {
+         $self->_make_pid_file(
+            pid      => $PID,  # parent's pid
+            pid_file => $pid_file,
+         );
+      };
+      die "$EVAL_ERROR\n" if $EVAL_ERROR;
+      if ( !$daemonize ) {
+         $self->{pid_file_owner} = $PID;  # parent's pid
+      }
+   }
+
+   if ( $daemonize ) {
+      defined (my $child_pid = fork()) or die "Cannot fork: $OS_ERROR";
+      if ( $child_pid ) {
+         PTDEBUG && _d('Forked child', $child_pid);
+         $parent_exit->($child_pid) if $parent_exit;
+         exit 0;
+      }
+
+      POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
+      chdir '/'       or die "Cannot chdir to /: $OS_ERROR";
+
+      if ( $pid_file ) {
+         $self->_update_pid_file(
+            pid      => $PID,  # child's pid
+            pid_file => $pid_file,
+         );
+         $self->{pid_file_owner} = $PID;
+      }
+   }
+
+   if ( $daemonize || $force_log_file ) {
+      PTDEBUG && _d('Redirecting STDIN to /dev/null');
+      close STDIN;
+      open  STDIN, '/dev/null'
+         or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
+      if ( $log_file ) {
+         PTDEBUG && _d('Redirecting STDOUT and STDERR to', $log_file);
+         close STDOUT;
+         open  STDOUT, '>>', $log_file
+            or die "Cannot open log file $log_file: $OS_ERROR";
+         if ( $utf8 ) {
+            binmode(STDOUT, ':utf8')
+               or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
+         }
+
+
+         close STDERR;
+         open  STDERR, ">&STDOUT"
+            or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
+         if ( $utf8 ) {
+            binmode(STDERR, ':utf8')
+               or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
+         }
+      }
+      else {
+         if ( -t STDOUT ) {
+            PTDEBUG && _d('No log file and STDOUT is a terminal;',
+               'redirecting to /dev/null');
+            close STDOUT;
+            open  STDOUT, '>', '/dev/null'
+               or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
+         }
+         if ( -t STDERR ) {
+            PTDEBUG && _d('No log file and STDERR is a terminal;',
+               'redirecting to /dev/null');
+            close STDERR;
+            open  STDERR, '>', '/dev/null'
+               or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
+         }
+      }
+
+      $OUTPUT_AUTOFLUSH = 1;
+   }
+
+   PTDEBUG && _d('Daemon running');
+   return;
+}
+
+sub _make_pid_file {
+   my ($self, %args) = @_;
+   my @required_args = qw(pid pid_file);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   };
+   my $pid      = $args{pid};
+   my $pid_file = $args{pid_file};
+
+   eval {
+      sysopen(PID_FH, $pid_file, O_RDWR|O_CREAT|O_EXCL) or die $OS_ERROR;
+      print PID_FH $PID, "\n";
+      close PID_FH;
+   };
+   if ( my $e = $EVAL_ERROR ) {
+      if ( $e =~ m/file exists/i ) {
+         my $old_pid = $self->_check_pid_file(
+            pid_file => $pid_file,
+            pid      => $PID,
+         );
+         if ( $old_pid ) {
+            warn "Overwriting PID file $pid_file because PID $old_pid "
+               . "is not running.\n";
+         }
+         $self->_update_pid_file(
+            pid      => $PID,
+            pid_file => $pid_file
+         );
+      }
+      else {
+         die "Error creating PID file $pid_file: $e\n";
+      }
+   }
+
+   return;
+}
+
+sub _check_pid_file {
+   my ($self, %args) = @_;
+   my @required_args = qw(pid_file pid);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   };
+   my $pid_file = $args{pid_file};
+   my $pid      = $args{pid};
+
+   PTDEBUG && _d('Checking if PID in', $pid_file, 'is running');
+
+   if ( ! -f $pid_file ) {
+      PTDEBUG && _d('PID file', $pid_file, 'does not exist');
+      return;
+   }
+
+   open my $fh, '<', $pid_file
+      or die "Error opening $pid_file: $OS_ERROR";
+   my $existing_pid = do { local $/; <$fh> };
+   chomp($existing_pid) if $existing_pid;
+   close $fh
+      or die "Error closing $pid_file: $OS_ERROR";
+
+   if ( $existing_pid ) {
+      if ( $existing_pid == $pid ) {
+         warn "The current PID $pid already holds the PID file $pid_file\n";
+         return;
+      }
+      else {
+         PTDEBUG && _d('Checking if PID', $existing_pid, 'is running');
+         my $pid_is_alive = kill 0, $existing_pid;
+         if ( $pid_is_alive ) {
+            die "PID file $pid_file exists and PID $existing_pid is running\n";
+         }
+      }
+   }
+   else {
+      die "PID file $pid_file exists but it is empty.  Remove the file "
+         . "if the process is no longer running.\n";
+   }
+
+   return $existing_pid;
+}
+
+sub _update_pid_file {
+   my ($self, %args) = @_;
+   my @required_args = qw(pid pid_file);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   };
+   my $pid      = $args{pid};
+   my $pid_file = $args{pid_file};
+
+   open my $fh, '>', $pid_file
+      or die "Cannot open $pid_file: $OS_ERROR";
+   print { $fh } $pid, "\n"
+      or die "Cannot print to $pid_file: $OS_ERROR";
+   close $fh
+      or warn "Cannot close $pid_file: $OS_ERROR";
+
+   return;
+}
+
+sub remove_pid_file {
+   my ($self, $pid_file) = @_;
+   $pid_file ||= $self->{pid_file};
+   if ( $pid_file && -f $pid_file ) {
+      unlink $self->{pid_file}
+         or warn "Cannot remove PID file $pid_file: $OS_ERROR";
+      PTDEBUG && _d('Removed PID file');
+   }
+   else {
+      PTDEBUG && _d('No PID to remove');
+   }
+   return;
+}
+
+sub DESTROY {
+   my ($self) = @_;
+
+   if ( $self->{pid_file_owner} == $PID ) {
+      $self->remove_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
+# ###########################################################################
+
+# ###########################################################################
+# HTTP::Micro package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/HTTP/Micro.pm
+#   t/lib/HTTP/Micro.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package HTTP::Micro;
+
+our $VERSION = '0.01';
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Carp ();
+
+my @attributes;
+BEGIN {
+    @attributes = qw(agent timeout);
+    no strict 'refs';
+    for my $accessor ( @attributes ) {
+        *{$accessor} = sub {
+            @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
+        };
+    }
+}
+
+sub new {
+    my($class, %args) = @_;
+    (my $agent = $class) =~ s{::}{-}g;
+    my $self = {
+        agent        => $agent . "/" . ($class->VERSION || 0),
+        timeout      => 60,
+    };
+    for my $key ( @attributes ) {
+        $self->{$key} = $args{$key} if exists $args{$key}
+    }
+    return bless $self, $class;
+}
+
+my %DefaultPort = (
+    http => 80,
+    https => 443,
+);
+
+sub request {
+    my ($self, $method, $url, $args) = @_;
+    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
+      or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/);
+    $args ||= {}; # we keep some state in this during _request
+
+    my $response;
+    for ( 0 .. 1 ) {
+        $response = eval { $self->_request($method, $url, $args) };
+        last unless $@ && $method eq 'GET'
+            && $@ =~ m{^(?:Socket closed|Unexpected end)};
+    }
+
+    if (my $e = "$@") {
+        $response = {
+            success => q{},
+            status  => 599,
+            reason  => 'Internal Exception',
+            content => $e,
+            headers => {
+                'content-type'   => 'text/plain',
+                'content-length' => length $e,
+            }
+        };
+    }
+    return $response;
+}
+
+sub _request {
+    my ($self, $method, $url, $args) = @_;
+
+    my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
+
+    my $request = {
+        method    => $method,
+        scheme    => $scheme,
+        host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
+        uri       => $path_query,
+        headers   => {},
+    };
+
+    my $handle  = HTTP::Micro::Handle->new(timeout => $self->{timeout});
+
+    $handle->connect($scheme, $host, $port);
+
+    $self->_prepare_headers_and_cb($request, $args);
+    $handle->write_request_header(@{$request}{qw/method uri headers/});
+    $handle->write_content_body($request) if $request->{content};
+
+    my $response;
+    do { $response = $handle->read_response_header }
+        until (substr($response->{status},0,1) ne '1');
+
+    if (!($method eq 'HEAD' || $response->{status} =~ /^[23]04/)) {
+        $response->{content} = '';
+        $handle->read_content_body(sub { $_[1]->{content} .= $_[0] }, $response);
+    }
+
+    $handle->close;
+    $response->{success} = substr($response->{status},0,1) eq '2';
+    return $response;
+}
+
+sub _prepare_headers_and_cb {
+    my ($self, $request, $args) = @_;
+
+    for ($args->{headers}) {
+        next unless defined;
+        while (my ($k, $v) = each %$_) {
+            $request->{headers}{lc $k} = $v;
+        }
+    }
+    $request->{headers}{'host'}         = $request->{host_port};
+    $request->{headers}{'connection'}   = "close";
+    $request->{headers}{'user-agent'} ||= $self->{agent};
+
+    if (defined $args->{content}) {
+        $request->{headers}{'content-type'} ||= "application/octet-stream";
+        utf8::downgrade($args->{content}, 1)
+            or Carp::croak(q/Wide character in request message body/);
+        $request->{headers}{'content-length'} = length $args->{content};
+        $request->{content} = $args->{content};
+    }
+    return;
+}
+
+sub _split_url {
+    my $url = pop;
+
+    my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
+      or Carp::croak(qq/Cannot parse URL: '$url'/);
+
+    $scheme     = lc $scheme;
+    $path_query = "/$path_query" unless $path_query =~ m<\A/>;
+
+    my $host = (length($authority)) ? lc $authority : 'localhost';
+       $host =~ s/\A[^@]*@//;   # userinfo
+    my $port = do {
+       $host =~ s/:([0-9]*)\z// && length $1
+         ? $1
+         : $DefaultPort{$scheme}
+    };
+
+    return ($scheme, $host, $port, $path_query);
+}
+
+} # HTTP::Micro
+
+{
+   package HTTP::Micro::Handle;
+
+   use strict;
+   use warnings FATAL => 'all';
+   use English qw(-no_match_vars);
+
+   use Carp       qw(croak);
+   use Errno      qw(EINTR EPIPE);
+   use IO::Socket qw(SOCK_STREAM);
+
+   sub BUFSIZE () { 32768 }
+
+   my $Printable = sub {
+       local $_ = shift;
+       s/\r/\\r/g;
+       s/\n/\\n/g;
+       s/\t/\\t/g;
+       s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
+       $_;
+   };
+
+   sub new {
+       my ($class, %args) = @_;
+       return bless {
+           rbuf          => '',
+           timeout       => 60,
+           max_line_size => 16384,
+           %args
+       }, $class;
+   }
+
+   my $ssl_verify_args = {
+       check_cn         => "when_only",
+       wildcards_in_alt => "anywhere",
+       wildcards_in_cn  => "anywhere"
+   };
+
+   sub connect {
+       @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
+       my ($self, $scheme, $host, $port) = @_;
+
+       if ( $scheme eq 'https' ) {
+           eval "require IO::Socket::SSL"
+               unless exists $INC{'IO/Socket/SSL.pm'};
+           croak(qq/IO::Socket::SSL must be installed for https support\n/)
+               unless $INC{'IO/Socket/SSL.pm'};
+       }
+       elsif ( $scheme ne 'http' ) {
+         croak(qq/Unsupported URL scheme '$scheme'\n/);
+       }
+
+       $self->{fh} = IO::Socket::INET->new(
+           PeerHost  => $host,
+           PeerPort  => $port,
+           Proto     => 'tcp',
+           Type      => SOCK_STREAM,
+           Timeout   => $self->{timeout}
+       ) or croak(qq/Could not connect to '$host:$port': $@/);
+
+       binmode($self->{fh})
+         or croak(qq/Could not binmode() socket: '$!'/);
+
+       if ( $scheme eq 'https') {
+           IO::Socket::SSL->start_SSL(
+              $self->{fh},
+              SSL_verifycn_name => $host,
+           );
+           ref($self->{fh}) eq 'IO::Socket::SSL'
+               or die(qq/SSL connection failed for $host\n/);
+           if ( $self->{fh}->can("verify_hostname") ) {
+               $self->{fh}->verify_hostname( $host, $ssl_verify_args )
+                  or die(qq/SSL certificate not valid for $host\n/);
+           }
+           else {
+            my $fh = $self->{fh};
+            _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
+                  or die(qq/SSL certificate not valid for $host\n/);
+            }
+       }
+
+       $self->{host} = $host;
+       $self->{port} = $port;
+
+       return $self;
+   }
+
+   sub close {
+       @_ == 1 || croak(q/Usage: $handle->close()/);
+       my ($self) = @_;
+       CORE::close($self->{fh})
+         or croak(qq/Could not close socket: '$!'/);
+   }
+
+   sub write {
+       @_ == 2 || croak(q/Usage: $handle->write(buf)/);
+       my ($self, $buf) = @_;
+
+       my $len = length $buf;
+       my $off = 0;
+
+       local $SIG{PIPE} = 'IGNORE';
+
+       while () {
+           $self->can_write
+             or croak(q/Timed out while waiting for socket to become ready for writing/);
+           my $r = syswrite($self->{fh}, $buf, $len, $off);
+           if (defined $r) {
+               $len -= $r;
+               $off += $r;
+               last unless $len > 0;
+           }
+           elsif ($! == EPIPE) {
+               croak(qq/Socket closed by remote server: $!/);
+           }
+           elsif ($! != EINTR) {
+               croak(qq/Could not write to socket: '$!'/);
+           }
+       }
+       return $off;
+   }
+
+   sub read {
+       @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
+       my ($self, $len) = @_;
+
+       my $buf  = '';
+       my $got = length $self->{rbuf};
+
+       if ($got) {
+           my $take = ($got < $len) ? $got : $len;
+           $buf  = substr($self->{rbuf}, 0, $take, '');
+           $len -= $take;
+       }
+
+       while ($len > 0) {
+           $self->can_read
+             or croak(q/Timed out while waiting for socket to become ready for reading/);
+           my $r = sysread($self->{fh}, $buf, $len, length $buf);
+           if (defined $r) {
+               last unless $r;
+               $len -= $r;
+           }
+           elsif ($! != EINTR) {
+               croak(qq/Could not read from socket: '$!'/);
+           }
+       }
+       if ($len) {
+           croak(q/Unexpected end of stream/);
+       }
+       return $buf;
+   }
+
+   sub readline {
+       @_ == 1 || croak(q/Usage: $handle->readline()/);
+       my ($self) = @_;
+
+       while () {
+           if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
+               return $1;
+           }
+           $self->can_read
+             or croak(q/Timed out while waiting for socket to become ready for reading/);
+           my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
+           if (defined $r) {
+               last unless $r;
+           }
+           elsif ($! != EINTR) {
+               croak(qq/Could not read from socket: '$!'/);
+           }
+       }
+       croak(q/Unexpected end of stream while looking for line/);
+   }
+
+   sub read_header_lines {
+       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
+       my ($self, $headers) = @_;
+       $headers ||= {};
+       my $lines   = 0;
+       my $val;
+
+       while () {
+            my $line = $self->readline;
+
+            if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
+                my ($field_name) = lc $1;
+                $val = \($headers->{$field_name} = $2);
+            }
+            elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
+                $val
+                  or croak(q/Unexpected header continuation line/);
+                next unless length $1;
+                $$val .= ' ' if length $$val;
+                $$val .= $1;
+            }
+            elsif ($line =~ /\A \x0D?\x0A \z/x) {
+               last;
+            }
+            else {
+               croak(q/Malformed header line: / . $Printable->($line));
+            }
+       }
+       return $headers;
+   }
+
+   sub write_header_lines {
+       (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
+       my($self, $headers) = @_;
+
+       my $buf = '';
+       while (my ($k, $v) = each %$headers) {
+           my $field_name = lc $k;
+            $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
+               or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
+            $field_name =~ s/\b(\w)/\u$1/g;
+            $buf .= "$field_name: $v\x0D\x0A";
+       }
+       $buf .= "\x0D\x0A";
+       return $self->write($buf);
+   }
+
+   sub read_content_body {
+       @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
+       my ($self, $cb, $response, $len) = @_;
+       $len ||= $response->{headers}{'content-length'};
+
+       croak("No content-length in the returned response, and this "
+           . "UA doesn't implement chunking") unless defined $len;
+
+       while ($len > 0) {
+           my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
+           $cb->($self->read($read), $response);
+           $len -= $read;
+       }
+
+       return;
+   }
+
+   sub write_content_body {
+       @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
+       my ($self, $request) = @_;
+       my ($len, $content_length) = (0, $request->{headers}{'content-length'});
+
+       $len += $self->write($request->{content});
+
+       $len == $content_length
+         or croak(qq/Content-Length mismatch (got: $len expected: $content_length)/);
+
+       return $len;
+   }
+
+   sub read_response_header {
+       @_ == 1 || croak(q/Usage: $handle->read_response_header()/);
+       my ($self) = @_;
+
+       my $line = $self->readline;
+
+       $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
+         or croak(q/Malformed Status-Line: / . $Printable->($line));
+
+       my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
+
+       return {
+           status   => $status,
+           reason   => $reason,
+           headers  => $self->read_header_lines,
+           protocol => $protocol,
+       };
+   }
+
+   sub write_request_header {
+       @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
+       my ($self, $method, $request_uri, $headers) = @_;
+
+       return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
+            + $self->write_header_lines($headers);
+   }
+
+   sub _do_timeout {
+       my ($self, $type, $timeout) = @_;
+       $timeout = $self->{timeout}
+           unless defined $timeout && $timeout >= 0;
+
+       my $fd = fileno $self->{fh};
+       defined $fd && $fd >= 0
+         or croak(q/select(2): 'Bad file descriptor'/);
+
+       my $initial = time;
+       my $pending = $timeout;
+       my $nfound;
+
+       vec(my $fdset = '', $fd, 1) = 1;
+
+       while () {
+           $nfound = ($type eq 'read')
+               ? select($fdset, undef, undef, $pending)
+               : select(undef, $fdset, undef, $pending) ;
+           if ($nfound == -1) {
+               $! == EINTR
+                 or croak(qq/select(2): '$!'/);
+               redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
+               $nfound = 0;
+           }
+           last;
+       }
+       $! = 0;
+       return $nfound;
+   }
+
+   sub can_read {
+       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
+       my $self = shift;
+       return $self->_do_timeout('read', @_)
+   }
+
+   sub can_write {
+       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
+       my $self = shift;
+       return $self->_do_timeout('write', @_)
+   }
+}  # HTTP::Micro::Handle
+
+my $prog = <<'EOP';
+BEGIN {
+   if ( defined &IO::Socket::SSL::CAN_IPV6 ) {
+      *CAN_IPV6 = \*IO::Socket::SSL::CAN_IPV6;
+   }
+   else {
+      constant->import( CAN_IPV6 => '' );
+   }
+   my %const = (
+      NID_CommonName => 13,
+      GEN_DNS => 2,
+      GEN_IPADD => 7,
+   );
+   while ( my ($name,$value) = each %const ) {
+      no strict 'refs';
+      *{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) || sub { $value };
+   }
+}
+{
+   use Carp qw(croak);
+   my %dispatcher = (
+      issuer =>  sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
+      subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
+   );
+   if ( $Net::SSLeay::VERSION >= 1.30 ) {
+      $dispatcher{commonName} = sub {
+         my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
+            Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
+         $cn =~s{\0$}{}; # work around Bug in Net::SSLeay <1.33
+         $cn;
+      }
+   } else {
+      $dispatcher{commonName} = sub {
+         croak "you need at least Net::SSLeay version 1.30 for getting commonName"
+      }
+   }
+
+   if ( $Net::SSLeay::VERSION >= 1.33 ) {
+      $dispatcher{subjectAltNames} = sub { Net::SSLeay::X509_get_subjectAltNames( shift ) };
+   } else {
+      $dispatcher{subjectAltNames} = sub {
+         return;
+      };
+   }
+
+   $dispatcher{authority} = $dispatcher{issuer};
+   $dispatcher{owner}     = $dispatcher{subject};
+   $dispatcher{cn}        = $dispatcher{commonName};
+
+   sub _peer_certificate {
+      my ($self, $field) = @_;
+      my $ssl = $self->_get_ssl_object or return;
+
+      my $cert = ${*$self}{_SSL_certificate}
+         ||= Net::SSLeay::get_peer_certificate($ssl)
+         or return $self->error("Could not retrieve peer certificate");
+
+      if ($field) {
+         my $sub = $dispatcher{$field} or croak
+            "invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
+            "\nMaybe you need to upgrade your Net::SSLeay";
+         return $sub->($cert);
+      } else {
+         return $cert
+      }
+   }
+
+
+   my %scheme = (
+      ldap => {
+         wildcards_in_cn    => 0,
+         wildcards_in_alt => 'leftmost',
+         check_cn         => 'always',
+      },
+      http => {
+         wildcards_in_cn    => 'anywhere',
+         wildcards_in_alt => 'anywhere',
+         check_cn         => 'when_only',
+      },
+      smtp => {
+         wildcards_in_cn    => 0,
+         wildcards_in_alt => 0,
+         check_cn         => 'always'
+      },
+      none => {}, # do not check
+   );
+
+   $scheme{www}  = $scheme{http}; # alias
+   $scheme{xmpp} = $scheme{http}; # rfc 3920
+   $scheme{pop3} = $scheme{ldap}; # rfc 2595
+   $scheme{imap} = $scheme{ldap}; # rfc 2595
+   $scheme{acap} = $scheme{ldap}; # rfc 2595
+   $scheme{nntp} = $scheme{ldap}; # rfc 4642
+   $scheme{ftp}  = $scheme{http}; # rfc 4217
+
+
+   sub _verify_hostname_of_cert {
+      my $identity = shift;
+      my $cert = shift;
+      my $scheme = shift || 'none';
+      if ( ! ref($scheme) ) {
+         $scheme = $scheme{$scheme} or croak "scheme $scheme not defined";
+      }
+
+      return 1 if ! %$scheme; # 'none'
+
+      my $commonName = $dispatcher{cn}->($cert);
+      my @altNames   = $dispatcher{subjectAltNames}->($cert);
+
+      if ( my $sub = $scheme->{callback} ) {
+         return $sub->($identity,$commonName,@altNames);
+      }
+
+
+      my $ipn;
+      if ( CAN_IPV6 and $identity =~m{:} ) {
+         $ipn = IO::Socket::SSL::inet_pton(IO::Socket::SSL::AF_INET6,$identity)
+            or croak "'$identity' is not IPv6, but neither IPv4 nor hostname";
+      } elsif ( $identity =~m{^\d+\.\d+\.\d+\.\d+$} ) {
+         $ipn = IO::Socket::SSL::inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname";
+      } else {
+         if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
+            $identity =~m{\0} and croak("name '$identity' has \\0 byte");
+            $identity = IO::Socket::SSL::idn_to_ascii($identity) or
+               croak "Warning: Given name '$identity' could not be converted to IDNA!";
+         }
+      }
+
+      my $check_name = sub {
+         my ($name,$identity,$wtyp) = @_;
+         $wtyp ||= '';
+         my $pattern;
+         if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-]*)\*(.+)} ) {
+            $pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]*\Q$2\E$}i;
+         } elsif ( $wtyp eq 'leftmost' and $name =~m{^\*(\..+)$} ) {
+            $pattern = qr{^[a-zA-Z0-9_\-]*\Q$1\E$}i;
+         } else {
+            $pattern = qr{^\Q$name\E$}i;
+         }
+         return $identity =~ $pattern;
+      };
+
+      my $alt_dnsNames = 0;
+      while (@altNames) {
+         my ($type, $name) = splice (@altNames, 0, 2);
+         if ( $ipn and $type == GEN_IPADD ) {
+            return 1 if $ipn eq $name;
+
+         } elsif ( ! $ipn and $type == GEN_DNS ) {
+            $name =~s/\s+$//; $name =~s/^\s+//;
+            $alt_dnsNames++;
+            $check_name->($name,$identity,$scheme->{wildcards_in_alt})
+               and return 1;
+         }
+      }
+
+      if ( ! $ipn and (
+         $scheme->{check_cn} eq 'always' or
+         $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames)) {
+         $check_name->($commonName,$identity,$scheme->{wildcards_in_cn})
+            and return 1;
+      }
+
+      return 0; # no match
+   }
+}
+EOP
+
+eval { require IO::Socket::SSL };
+if ( $INC{"IO/Socket/SSL.pm"} ) {
+   eval $prog;
+   die $@ if $@;
+}
+
+1;
+# ###########################################################################
+# End HTTP::Micro package
+# ###########################################################################
+
+# ###########################################################################
+# VersionCheck package
+# This package is a copy without comments from the original.  The original
+# with comments and its test file can be found in the GitHub repository at,
+#   lib/VersionCheck.pm
+#   t/lib/VersionCheck.t
+# See https://github.com/percona/percona-toolkit for more information.
+# ###########################################################################
+{
+package VersionCheck;
+
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Data::Dumper;
+local $Data::Dumper::Indent    = 1;
+local $Data::Dumper::Sortkeys  = 1;
+local $Data::Dumper::Quotekeys = 0;
+
+use Digest::MD5 qw(md5_hex);
+use Sys::Hostname qw(hostname);
+use File::Basename qw();
+use File::Spec;
+use FindBin qw();
+
+eval {
+   require Percona::Toolkit;
+   require HTTP::Micro;
+};
+
+my $home    = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
+my @vc_dirs = (
+   '/etc/percona',
+   '/etc/percona-toolkit',
+   '/tmp',
+   "$home",
+);
+
+{
+   my $file    = 'percona-version-check';
+
+   sub version_check_file {
+      foreach my $dir ( @vc_dirs ) {
+         if ( -d $dir && -w $dir ) {
+            PTDEBUG && _d('Version check file', $file, 'in', $dir);
+            return $dir . '/' . $file;
+         }
+      }
+      PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
+      return $file;  # in the CWD
+   }
+}
+
+sub version_check_time_limit {
+   return 60 * 60 * 24;  # one day
+}
+
+
+sub version_check {
+   my (%args) = @_;
+
+   my $instances = $args{instances} || [];
+   my $instances_to_check;
+
+   PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin);
+   if ( !$args{force} ) {
+      if ( $FindBin::Bin
+           && (-d "$FindBin::Bin/../.bzr"    ||
+               -d "$FindBin::Bin/../../.bzr" ||
+               -d "$FindBin::Bin/../.git"    ||
+               -d "$FindBin::Bin/../../.git"
+              )
+         ) {
+         PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check");
+         return;
+      }
+   }
+
+   eval {
+      foreach my $instance ( @$instances ) {
+         my ($name, $id) = get_instance_id($instance);
+         $instance->{name} = $name;
+         $instance->{id}   = $id;
+      }
+
+      push @$instances, { name => 'system', id => 0 };
+
+      $instances_to_check = get_instances_to_check(
+         instances => $instances,
+         vc_file   => $args{vc_file},  # testing
+         now       => $args{now},      # testing
+      );
+      PTDEBUG && _d(scalar @$instances_to_check, 'instances to check');
+      return unless @$instances_to_check;
+
+      my $protocol = 'https';
+      eval { require IO::Socket::SSL; };
+      if ( $EVAL_ERROR ) {
+         PTDEBUG && _d($EVAL_ERROR);
+         PTDEBUG && _d("SSL not available, won't run version_check");
+         return;
+      }
+      PTDEBUG && _d('Using', $protocol);
+      my $url = $args{url}                       # testing
+                || $ENV{PERCONA_VERSION_CHECK_URL}  # testing
+                || "$protocol://v.percona.com";
+      PTDEBUG && _d('API URL:', $url);
+
+      my $advice = pingback(
+         instances => $instances_to_check,
+         protocol  => $protocol,
+         url       => $url,
+      );
+      if ( $advice ) {
+         PTDEBUG && _d('Advice:', Dumper($advice));
+         if ( scalar @$advice > 1) {
+            print "\n# " . scalar @$advice . " software updates are "
+               . "available:\n";
+         }
+         else {
+            print "\n# A software update is available:\n";
+         }
+         print join("\n", map { "#   * $_" } @$advice), "\n\n";
+      }
+   };
+   if ( $EVAL_ERROR ) {
+      PTDEBUG && _d('Version check failed:', $EVAL_ERROR);
+   }
+
+   if ( @$instances_to_check ) {
+      eval {
+         update_check_times(
+            instances => $instances_to_check,
+            vc_file   => $args{vc_file},  # testing
+            now       => $args{now},      # testing
+         );
+      };
+      if ( $EVAL_ERROR ) {
+         PTDEBUG && _d('Error updating version check file:', $EVAL_ERROR);
+      }
+   }
+
+   if ( $ENV{PTDEBUG_VERSION_CHECK} ) {
+      warn "Exiting because the PTDEBUG_VERSION_CHECK "
+         . "environment variable is defined.\n";
+      exit 255;
+   }
+
+   return;
+}
+
+sub get_instances_to_check {
+   my (%args) = @_;
+
+   my $instances = $args{instances};
+   my $now       = $args{now}     || int(time);
+   my $vc_file   = $args{vc_file} || version_check_file();
+
+   if ( !-f $vc_file ) {
+      PTDEBUG && _d('Version check file', $vc_file, 'does not exist;',
+         'version checking all instances');
+      return $instances;
+   }
+
+   open my $fh, '<', $vc_file or die "Cannot open $vc_file: $OS_ERROR";
+   chomp(my $file_contents = do { local $/ = undef; <$fh> });
+   PTDEBUG && _d('Version check file', $vc_file, 'contents:', $file_contents);
+   close $fh;
+   my %last_check_time_for = $file_contents =~ /^([^,]+),(.+)$/mg;
+
+   my $check_time_limit = version_check_time_limit();
+   my @instances_to_check;
+   foreach my $instance ( @$instances ) {
+      my $last_check_time = $last_check_time_for{ $instance->{id} };
+      PTDEBUG && _d('Instance', $instance->{id}, 'last checked',
+         $last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0),
+         'hours until next check',
+         sprintf '%.2f',
+            ($check_time_limit - ($now - ($last_check_time || 0))) / 3600);
+      if ( !defined $last_check_time
+           || ($now - $last_check_time) >= $check_time_limit ) {
+         PTDEBUG && _d('Time to check', Dumper($instance));
+         push @instances_to_check, $instance;
+      }
+   }
+
+   return \@instances_to_check;
+}
+
+sub update_check_times {
+   my (%args) = @_;
+
+   my $instances = $args{instances};
+   my $now       = $args{now}     || int(time);
+   my $vc_file   = $args{vc_file} || version_check_file();
+   PTDEBUG && _d('Updating last check time:', $now);
+
+   my %all_instances = map {
+      $_->{id} => { name => $_->{name}, ts => $now }
+   } @$instances;
+
+   if ( -f $vc_file ) {
+      open my $fh, '<', $vc_file or die "Cannot read $vc_file: $OS_ERROR";
+      my $contents = do { local $/ = undef; <$fh> };
+      close $fh;
+
+      foreach my $line ( split("\n", ($contents || '')) ) {
+         my ($id, $ts) = split(',', $line);
+         if ( !exists $all_instances{$id} ) {
+            $all_instances{$id} = { ts => $ts };  # original ts, not updated
+         }
+      }
+   }
+
+   open my $fh, '>', $vc_file or die "Cannot write to $vc_file: $OS_ERROR";
+   foreach my $id ( sort keys %all_instances ) {
+      PTDEBUG && _d('Updated:', $id, Dumper($all_instances{$id}));
+      print { $fh } $id . ',' . $all_instances{$id}->{ts} . "\n";
+   }
+   close $fh;
+
+   return;
+}
+
+sub get_instance_id {
+   my ($instance) = @_;
+
+   my $dbh = $instance->{dbh};
+   my $dsn = $instance->{dsn};
+
+   my $sql = q{SELECT CONCAT(@@hostname, @@port)};
+   PTDEBUG && _d($sql);
+   my ($name) = eval { $dbh->selectrow_array($sql) };
+   if ( $EVAL_ERROR ) {
+      PTDEBUG && _d($EVAL_ERROR);
+      $sql = q{SELECT @@hostname};
+      PTDEBUG && _d($sql);
+      ($name) = eval { $dbh->selectrow_array($sql) };
+      if ( $EVAL_ERROR ) {
+         PTDEBUG && _d($EVAL_ERROR);
+         $name = ($dsn->{h} || 'localhost') . ($dsn->{P} || 3306);
+      }
+      else {
+         $sql = q{SHOW VARIABLES LIKE 'port'};
+         PTDEBUG && _d($sql);
+         my (undef, $port) = eval { $dbh->selectrow_array($sql) };
+         PTDEBUG && _d('port:', $port);
+         $name .= $port || '';
+      }
+   }
+   my $id = md5_hex($name);
+
+   PTDEBUG && _d('MySQL instance:', $id, $name, Dumper($dsn));
+
+   return $name, $id;
+}
+
+
+sub get_uuid {
+    my $uuid_file = '/.percona-toolkit.uuid';
+    foreach my $dir (@vc_dirs) {
+        my $filename = $dir.$uuid_file;
+        my $uuid=_read_uuid($filename);
+        return $uuid if $uuid;
+    }
+
+    my $filename = $ENV{"HOME"} . $uuid_file;
+    my $uuid = _generate_uuid();
+
+    my $fh;
+    eval {
+        open($fh, '>', $filename);
+    };
+    if (!$EVAL_ERROR) {
+        print $fh $uuid;
+        close $fh;
+    }
+
+    return $uuid;
+}
+
+sub _generate_uuid {
+    return sprintf+($}="%04x")."$}-$}-$}-$}-".$}x3,map rand 65537,0..7;
+}
+
+sub _read_uuid {
+    my $filename = shift;
+    my $fh;
+
+    eval {
+        open($fh, '<:encoding(UTF-8)', $filename);
+    };
+    return if ($EVAL_ERROR);
+
+    my $uuid;
+    eval { $uuid = <$fh>; };
+    return if ($EVAL_ERROR);
+
+    chomp $uuid;
+    return $uuid;
+}
+
+
+sub pingback {
+   my (%args) = @_;
+   my @required_args = qw(url instances);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my $url       = $args{url};
+   my $instances = $args{instances};
+
+   my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
+
+   my $response = $ua->request('GET', $url);
+   PTDEBUG && _d('Server response:', Dumper($response));
+   die "No response from GET $url"
+      if !$response;
+   die("GET on $url returned HTTP status $response->{status}; expected 200\n",
+       ($response->{content} || '')) if $response->{status} != 200;
+   die("GET on $url did not return any programs to check")
+      if !$response->{content};
+
+   my $items = parse_server_response(
+      response => $response->{content}
+   );
+   die "Failed to parse server requested programs: $response->{content}"
+      if !scalar keys %$items;
+
+   my $versions = get_versions(
+      items     => $items,
+      instances => $instances,
+   );
+   die "Failed to get any program versions; should have at least gotten Perl"
+      if !scalar keys %$versions;
+
+   my $client_content = encode_client_response(
+      items      => $items,
+      versions   => $versions,
+      general_id => get_uuid(),
+   );
+
+   my $tool_name = $ENV{XTRABACKUP_VERSION} ? "Percona XtraBackup" : File::Basename::basename($0);
+   my $client_response = {
+      headers => { "X-Percona-Toolkit-Tool" => $tool_name },
+      content => $client_content,
+   };
+   PTDEBUG && _d('Client response:', Dumper($client_response));
+
+   $response = $ua->request('POST', $url, $client_response);
+   PTDEBUG && _d('Server suggestions:', Dumper($response));
+   die "No response from POST $url $client_response"
+      if !$response;
+   die "POST $url returned HTTP status $response->{status}; expected 200"
+      if $response->{status} != 200;
+
+   return unless $response->{content};
+
+   $items = parse_server_response(
+      response   => $response->{content},
+      split_vars => 0,
+   );
+   die "Failed to parse server suggestions: $response->{content}"
+      if !scalar keys %$items;
+   my @suggestions = map { $_->{vars} }
+                     sort { $a->{item} cmp $b->{item} }
+                     values %$items;
+
+   return \@suggestions;
+}
+
+sub encode_client_response {
+   my (%args) = @_;
+   my @required_args = qw(items versions general_id);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($items, $versions, $general_id) = @args{@required_args};
+
+   my @lines;
+   foreach my $item ( sort keys %$items ) {
+      next unless exists $versions->{$item};
+      if ( ref($versions->{$item}) eq 'HASH' ) {
+         my $mysql_versions = $versions->{$item};
+         for my $id ( sort keys %$mysql_versions ) {
+            push @lines, join(';', $id, $item, $mysql_versions->{$id});
+         }
+      }
+      else {
+         push @lines, join(';', $general_id, $item, $versions->{$item});
+      }
+   }
+
+   my $client_response = join("\n", @lines) . "\n";
+   return $client_response;
+}
+
+sub parse_server_response {
+   my (%args) = @_;
+   my @required_args = qw(response);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($response) = @args{@required_args};
+
+   my %items = map {
+      my ($item, $type, $vars) = split(";", $_);
+      if ( !defined $args{split_vars} || $args{split_vars} ) {
+         $vars = [ split(",", ($vars || '')) ];
+      }
+      $item => {
+         item => $item,
+         type => $type,
+         vars => $vars,
+      };
+   } split("\n", $response);
+
+   PTDEBUG && _d('Items:', Dumper(\%items));
+
+   return \%items;
+}
+
+my %sub_for_type = (
+   os_version          => \&get_os_version,
+   perl_version        => \&get_perl_version,
+   perl_module_version => \&get_perl_module_version,
+   mysql_variable      => \&get_mysql_variable,
+   xtrabackup          => \&get_xtrabackup_version,
+);
+
+sub valid_item {
+   my ($item) = @_;
+   return unless $item;
+   if ( !exists $sub_for_type{ $item->{type} } ) {
+      PTDEBUG && _d('Invalid type:', $item->{type});
+      return 0;
+   }
+   return 1;
+}
+
+sub get_versions {
+   my (%args) = @_;
+   my @required_args = qw(items);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($items) = @args{@required_args};
+
+   my %versions;
+   foreach my $item ( values %$items ) {
+      next unless valid_item($item);
+      eval {
+         my $version = $sub_for_type{ $item->{type} }->(
+            item      => $item,
+            instances => $args{instances},
+         );
+         if ( $version ) {
+            chomp $version unless ref($version);
+            $versions{$item->{item}} = $version;
+         }
+      };
+      if ( $EVAL_ERROR ) {
+         PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR);
+      }
+   }
+
+   return \%versions;
+}
+
+
+sub get_os_version {
+   if ( $OSNAME eq 'MSWin32' ) {
+      require Win32;
+      return Win32::GetOSDisplayName();
+   }
+
+  chomp(my $platform = `uname -s`);
+  PTDEBUG && _d('platform:', $platform);
+  return $OSNAME unless $platform;
+
+   chomp(my $lsb_release
+            = `which lsb_release 2>/dev/null | awk '{print \$1}'` || '');
+   PTDEBUG && _d('lsb_release:', $lsb_release);
+
+   my $release = "";
+
+   if ( $platform eq 'Linux' ) {
+      if ( -f "/etc/fedora-release" ) {
+         $release = `cat /etc/fedora-release`;
+      }
+      elsif ( -f "/etc/redhat-release" ) {
+         $release = `cat /etc/redhat-release`;
+      }
+      elsif ( -f "/etc/system-release" ) {
+         $release = `cat /etc/system-release`;
+      }
+      elsif ( $lsb_release ) {
+         $release = `$lsb_release -ds`;
+      }
+      elsif ( -f "/etc/lsb-release" ) {
+         $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`;
+         $release =~ s/^\w+="([^"]+)".+/$1/;
+      }
+      elsif ( -f "/etc/debian_version" ) {
+         chomp(my $rel = `cat /etc/debian_version`);
+         $release = "Debian $rel";
+         if ( -f "/etc/apt/sources.list" ) {
+             chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`);
+             $release .= " ($code_name)" if $code_name;
+         }
+      }
+      elsif ( -f "/etc/os-release" ) { # openSUSE
+         chomp($release = `grep PRETTY_NAME /etc/os-release`);
+         $release =~ s/^PRETTY_NAME="(.+)"$/$1/;
+      }
+      elsif ( `ls /etc/*release 2>/dev/null` ) {
+         if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) {
+            $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`;
+         }
+         else {
+            $release = `cat /etc/*release | head -n1`;
+         }
+      }
+   }
+   elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) {
+      my $rel = `uname -r`;
+      $release = "$platform $rel";
+   }
+   elsif ( $platform eq "SunOS" ) {
+      my $rel = `head -n1 /etc/release` || `uname -r`;
+      $release = "$platform $rel";
+   }
+
+   if ( !$release ) {
+      PTDEBUG && _d('Failed to get the release, using platform');
+      $release = $platform;
+   }
+   chomp($release);
+
+   $release =~ s/^"|"$//g;
+
+   PTDEBUG && _d('OS version =', $release);
+   return $release;
+}
+
+sub get_perl_version {
+   my (%args) = @_;
+   my $item = $args{item};
+   return unless $item;
+
+   my $version = sprintf '%vd', $PERL_VERSION;
+   PTDEBUG && _d('Perl version', $version);
+   return $version;
+}
+
+sub get_xtrabackup_version {
+    return $ENV{XTRABACKUP_VERSION};
+}
+
+sub get_perl_module_version {
+   my (%args) = @_;
+   my $item = $args{item};
+   return unless $item;
+
+   my $var     = '$' . $item->{item} . '::VERSION';
+   my $version = eval "use $item->{item}; $var;";
+   PTDEBUG && _d('Perl version for', $var, '=', $version);
+   return $version;
+}
+
+sub get_mysql_variable {
+   return get_from_mysql(
+      show => 'VARIABLES',
+      @_,
+   );
+}
+
+sub get_from_mysql {
+   my (%args) = @_;
+   my $show      = $args{show};
+   my $item      = $args{item};
+   my $instances = $args{instances};
+   return unless $show && $item;
+
+   if ( !$instances || !@$instances ) {
+      PTDEBUG && _d('Cannot check', $item,
+         'because there are no MySQL instances');
+      return;
+   }
+
+   if ($item->{item} eq 'MySQL' && $item->{type} eq 'mysql_variable') {
+      @{$item->{vars}} = grep { $_ eq 'version' || $_ eq 'version_comment' } @{$item->{vars}};
+   }
+
+
+   my @versions;
+   my %version_for;
+   foreach my $instance ( @$instances ) {
+      next unless $instance->{id};  # special system instance has id=0
+      my $dbh = $instance->{dbh};
+      local $dbh->{FetchHashKeyName} = 'NAME_lc';
+      my $sql = qq/SHOW $show/;
+      PTDEBUG && _d($sql);
+      my $rows = $dbh->selectall_hashref($sql, 'variable_name');
+
+      my @versions;
+      foreach my $var ( @{$item->{vars}} ) {
+         $var = lc($var);
+         my $version = $rows->{$var}->{value};
+         PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version,
+            'on', $instance->{name});
+         push @versions, $version;
+      }
+      $version_for{ $instance->{id} } = join(' ', @versions);
+   }
+
+   return \%version_for;
+}
+
+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 VersionCheck package
+# ###########################################################################
+
+# ###########################################################################
+# This is a combination of modules and programs in one -- a runnable module.
+# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
+# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
+#
+# Check at the end of this package for the call to main() which actually runs
+# the program.
+# ###########################################################################
+package pt_slave_restart;
+
+use English qw(-no_match_vars);
+use IO::File;
+use File::Basename;
+use List::Util qw(min max);
+use Time::HiRes qw(sleep);
+use sigtrap qw(handler finish untrapped normal-signals);
+
+use Percona::Toolkit;
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Data::Dumper;
+
+local $Data::Dumper::Indent    = 1;
+local $Data::Dumper::Sortkeys  = 1;
+local $Data::Dumper::Quotekeys = 0;
+
+$OUTPUT_AUTOFLUSH = 1;
+
+my $o;
+my $dp;
+my $q  = new Quoter();
+my %children;
+
+sub main {
+   local @ARGV = @_;  # set global ARGV for this package
+
+   if ( basename($0) eq 'pt-slave-restart' ) {
+      warn "pt-slave-restart is a link to pt-replica-restart.\nThis file name is deprecated and will be removed in future releases. Use pt-replica-restart instead.\n\n";
+   }
+
+   # ########################################################################
+   # Get configuration information.
+   # ########################################################################
+   $o  = new OptionParser();
+   $o->get_specs();
+   $o->get_opts();
+
+   $dp = $o->DSNParser();
+   $dp->prop('set-vars', $o->set_vars());
+
+   $o->set('verbose', 0) if $o->get('quiet');
+
+   if ( !$o->get('help') ) {
+      if ( $o->get('until-master') ) {
+         if ( $o->get('until-master') !~ m/^[.\w-]+,\d+$/ ) {
+            $o->save_error("Invalid --until-master argument, must be file,pos");
+         }
+      }
+      if ( $o->get('until-relay') ) {
+         if ( $o->get('until-relay') !~ m/^[.\w-]+,\d+$/ ) {
+            $o->save_error("Invalid --until-relay argument, must be file,pos");
+         }
+      }
+   }
+
+   eval {
+      MasterSlave::check_recursion_method($o->get('recursion-method'));
+   };
+   if ( $EVAL_ERROR ) {
+      $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
+   }
+
+   $o->usage_or_errors();
+
+   # ########################################################################
+   # First things first: if --stop was given, create the sentinel file.
+   # ########################################################################
+   my $sentinel = $o->get('sentinel');
+   if ( $o->get('stop') ) {
+      PTDEBUG && _d('Creating sentinel file', $sentinel);
+      my $file = IO::File->new($sentinel, ">>")
+         or die "Cannot open $sentinel: $OS_ERROR\n";
+      print $file "Remove this file to permit pt-replica-restart to run\n"
+         or die "Cannot write to $sentinel: $OS_ERROR\n";
+      close $file
+         or die "Cannot close $sentinel: $OS_ERROR\n";
+      print STDOUT "Successfully created file $sentinel\n"
+         unless $o->get('quiet');
+      # Exit unlesss --monitor is given.
+      if ( !$o->got('monitor') ) {
+         PTDEBUG && _d('Nothing more to do, quitting');
+         return 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.
+         PTDEBUG && _d('Waiting for other instances to quit');
+         sleep $o->get('max-sleep');
+         PTDEBUG && _d('Unlinking', $sentinel);
+         unlink $sentinel
+            or die "Cannot unlink $sentinel: $OS_ERROR";
+      }
+   }
+
+   # ########################################################################
+   # Connect to MySQL.
+   # ########################################################################
+   if ( $o->get('ask-pass') ) {
+      $o->set('password', OptionParser::prompt_noecho("Enter password: "));
+   }
+   my $dsn_defaults = $dp->parse_options($o);
+   my $dsn          = @ARGV ? $dp->parse(shift @ARGV, $dsn_defaults)
+                    :         $dsn_defaults;
+   my $dbh          = $dp->get_dbh($dp->get_cxn_params($dsn),
+                              { AutoCommit => 1, });
+
+   $dbh->{InactiveDestroy}  = 1;         # Don't disconnect on fork/daemonize
+
+   # ########################################################################
+   # Daemonize only after (potentially) asking for passwords for --ask-pass.
+   # If option daemonize is not provided while option pid is provided,
+   # we're not daemoninzing, it just handles PID stuff.
+   # ########################################################################
+   my $daemon;
+   if ( $o->get('daemonize') || $o->get('pid')) {
+      $daemon = new Daemon(
+         log_file => $o->get('log'),
+         pid_file => $o->get('pid'),
+         daemonize => $o->get('daemonize'),
+      );
+      $daemon->run();
+      PTDEBUG && $o->get('daemonize') && _d('I am a daemon now');
+   }
+
+   # ########################################################################
+   # Set source and replica names.
+   # ########################################################################
+
+   my $vp = VersionParser->new($dbh);
+   my $source_name = 'source';
+   my $replica_name = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_name = 'master';
+      $replica_name = 'slave';
+   }
+
+   # ########################################################################
+   # Start monitoring the replica.
+   # ########################################################################
+   my $exit_status = 0;
+   my @servers_to_watch;
+
+   # Despite the name, recursing to replicas actually begins at the specified
+   # server, so the named server may also be watched, if it's a replica.
+   my $ms = new MasterSlave(
+      OptionParser => $o,
+      DSNParser    => $dp,
+      Quoter       => $q,
+   );
+   $ms->recurse_to_replicas(
+      {  dbh      => $dbh,
+         dsn      => $dsn,
+         callback => sub {
+            my ( $dsn, $dbh, $level ) = @_;
+            # Test whether we want to watch this server.
+            eval {
+               my $stat = $ms->get_replica_status($dbh);
+               if ( $stat ) {
+                  push @servers_to_watch, { dsn => $dsn, dbh => $dbh };
+               }
+               else {
+                  die "could not find ${replica_name} status on this server\n";
+               }
+            };
+            if ( $EVAL_ERROR ) {
+               chomp $EVAL_ERROR;
+               PTDEBUG && _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";
+         },
+      }
+   );
+
+   # ########################################################################
+   # Do the version-check
+   # ########################################################################
+   if ( $o->get('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
+      VersionCheck::version_check(
+         force     => $o->got('version-check'),
+         instances => [ { dbh => $dbh, dsn => $dsn }, @servers_to_watch ],
+      );
+   }
+
+   # ########################################################################
+   # 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, $ms);
+      }
+      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;
+   }
+
+   PTDEBUG && _d('Child PIDs:', values %children);
+   # Wait for the children to exit.
+   foreach my $host ( keys %children ) {
+      PTDEBUG && _d('Waiting to reap', $host);
+      my $pid = waitpid($children{$host}, 0);
+      $exit_status ||= $CHILD_ERROR >> 8;
+   }
+
+   $dp->disconnect($dbh);
+   return $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, $ms ) = @_;
+
+   PTDEBUG && _d('Watching server', $dp->as_string($dsn),
+      'forked:', $was_forked);
+
+   my $vp = VersionParser->new($dbh);
+   my $source_name   = 'source';
+   my $source_change = 'replication source';
+   my $replica_name  = 'replica';
+   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
+      $source_name   = 'master';
+      $source_change = 'master';
+      $replica_name  = 'slave';
+   }
+
+   my $start_sql = $vp >= '4.0.5' ? "START ${replica_name}" : 'SLAVE START';
+   if ( $o->get('until-master') ) {
+      my ( $file, $pos ) = split(',', $o->get('until-master'));
+      $start_sql .= " UNTIL ${source_name}_LOG_FILE = '$file', ${source_name}_LOG_POS = $pos";
+   }
+   elsif ( $o->get('until-relay') ) {
+      my ( $file, $pos ) = split(',', $o->get('until-relay'));
+      $start_sql .= " UNTIL RELAY_LOG_FILE = '$file', RELAY_LOG_POS = $pos";
+   }
+
+   my $start = $dbh->prepare($start_sql);
+   my $stop  = $dbh->prepare("STOP ${replica_name}");
+
+   # ########################################################################
+   # Detect if GTID is enabled. Skipping an event is done differently.
+   # ########################################################################
+   # When MySQL 5.6.5 or higher is used and gtid is enabled, skipping a
+   # transaction is not possible with SQL_REPLICA_SKIP_COUNTER
+   my $skip_event;
+   my $have_gtid = 0;
+   # We also check if version is lower than 10.0.0 because MariaDB has different
+   # versioning system than MySQL
+   if ( VersionParser->new($dbh) >= '5.6.5' && VersionParser->new($dbh) <= '10.0.0' ) {
+      my $row = $dbh->selectrow_arrayref('SELECT @@GLOBAL.gtid_mode');
+      PTDEBUG && _d('@@GLOBAL.gtid_mode:', $row->[0]);
+      if ( $row && $row->[0] =~ m/^ON/ ) {
+         $have_gtid = 1;
+      }
+   }
+   PTDEBUG && _d('Have GTID:', $have_gtid);
+
+   # If GTID is enabled, replica_parallel_workers should be == 0.
+   # It's currently not possible to know what GTID event the failed trx is.
+   if ( $have_gtid ) {
+      my $threads = $dbh->selectrow_hashref(
+         "SELECT \@\@GLOBAL.${replica_name}_parallel_workers AS threads");
+      if ( $threads->{threads} > 0 ) {
+         die "Cannot skip transactions properly because GTID is enabled "
+            . "and ${replica_name}_parallel_workers > 0.  See 'GLOBAL TRANSACTION IDS' "
+            . "in the tool's documentation.\n";
+      }
+   }
+
+   # ########################################################################
+   # 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/./ => ($have_gtid ? 'skip_gtid' : 'skip')                     ],
+   );
+
+   # ########################################################################
+   # These are actions to take when an error is found.
+   # ########################################################################
+   my %actions = (
+      refetch_relay_log => sub {
+         my ( $stat, $dbh ) = @_;
+         PTDEBUG && _d('Found relay log corruption');
+         # Can't do CHANGE MASTER TO with a running replica.
+         $stop->execute();
+
+         # Cannot use ? placeholders for CHANGE MASTER values:
+         # https://bugs.launchpad.net/percona-toolkit/+bug/932614
+         my $sql = "CHANGE ${source_change} TO "
+                 . "${source_name}_LOG_FILE='" 
+                 . $stat->{"relay_${source_name}_log_file"} . "', "
+                 . "${source_name}_LOG_POS=" . $stat->{"exec_${source_name}_log_pos"};
+         PTDEBUG && _d($sql);
+         $dbh->do($sql);
+      },
+      skip => sub {
+         my ( $stat, $dbh ) = @_;
+         my $set_skip = $dbh->prepare("SET GLOBAL SQL_${replica_name}_SKIP_COUNTER = "
+                          . $o->get('skip-count'));
+         $set_skip->execute();
+      },
+      skip_gtid => sub {
+         my ( $stat, $dbh ) = @_;
+
+         # Get master_uuid from SHOW REPLICA STATUS if a UUID is not specified
+         # with --source-uuid.
+         my $gtid_uuid = $o->get("source-uuid");
+         if ( !$gtid_uuid ) {
+            $gtid_uuid = $stat->{"${source_name}_uuid"};
+            die "No ${source_name}_uuid" unless $gtid_uuid;  # shouldn't happen
+         }
+
+         # We need the highest transaction in the executed_gtid_set.
+         # and then we need to increase it by 1 (the one we want to skip)
+         # Notes:
+         #  - does not work with parallel replication
+         #  - it skips the next transaction from the master_uuid
+         #    (when a replicaB is replicating from replicaA,
+         #     the master_uuid is it's own master, replicaA)
+         my ($gtid_exec_ids) = ($stat->{executed_gtid_set} || '') =~ m/$gtid_uuid([0-9-:]*)/;
+         $gtid_exec_ids =~ s/:[0-9]+-/:/g;
+         die "No executed GTIDs" unless $gtid_exec_ids;
+
+         my @gtid_exec_ranges = split(/:/, $gtid_exec_ids);
+         delete $gtid_exec_ranges[0]; # undef the first value, it's always empty
+
+         # Get the highest id by sorting the array, removing the undef value.
+         my @gtid_exec_sorted = sort { $a <=> $b }
+                                grep { defined($_) } @gtid_exec_ranges;
+         my $gtid_exec_last   = $gtid_exec_sorted[-1];
+
+         PTDEBUG && _d("\n",
+            "GTID: ${source_name}_uuid:",         $gtid_uuid, "\n",
+            "GTID: executed_gtid_set:",           $gtid_exec_ids, "\n",
+            "GTID: max for ${source_name}_uuid:", $gtid_exec_sorted[-1], "\n",
+            "GTID: last executed gtid:",          $gtid_uuid, ":", $gtid_exec_last);
+
+         # Set the sessions next gtid, write an empty transaction
+         my $skipped = 0;
+         while ( $skipped++ < $o->get('skip-count') ) {
+            my $gtid_next = $gtid_exec_last + $skipped;
+            my $sql       = "SET GTID_NEXT='$gtid_uuid:$gtid_next'";
+            PTDEBUG && _d($sql);
+            my $sth = $dbh->prepare($sql);
+            $sth->execute();
+            $dbh->begin_work();
+            $dbh->commit();
+         }
+
+         # Set the session back to the automatically generated GTID_NEXT.
+         $dbh->do("SET GTID_NEXT='AUTOMATIC'");
+      },
+      repair_table => sub {
+         my ( $stat, $dbh ) = @_;
+         PTDEBUG && _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);
+            PTDEBUG && _d($sql);
+            $dbh->do($sql);
+         }
+      },
+   );
+
+   my $err_text  = $o->get('error-text');
+   my $exit_time = time() + ($o->get('run-time') || 0);
+   my $sleep     = $o->get('sleep');
+   my ($last_log, $last_pos);
+
+   my $stat = {}; # Will hold SHOW REPLICA STATUS
+   STAT:
+   while ( $stat
+           && (!$o->get('run-time') || time() < $exit_time)
+           && !-f $o->get('sentinel') ) {
+      my $increase_sleep = 1;
+      $stat = $ms->get_replica_status($dbh);
+      if ( !$stat ) {
+         print STDERR "No ${replica_name} STATUS output found on ",
+            $dp->as_string($dsn), "\n";
+         next STAT;
+      }
+
+      PTDEBUG && _d('Last/current relay log file:',
+         $last_log, $stat->{relay_log_file});
+      PTDEBUG && _d('Last/current relay log pos:',
+         $last_pos, $stat->{relay_log_pos});
+      if ( !$last_log
+           || $last_log ne $stat->{relay_log_file}   # Avoid infinite loops
+           || $last_pos != $stat->{relay_log_pos}
+      ) {
+         $stat->{"${replica_name}_sql_running"} ||= 'No';
+         $stat->{last_error}        ||= '';
+         $stat->{last_errno}        ||= 0;
+
+         if ( $o->get('until-master') && pos_ge($stat, $source_name, $source_name) ) {
+            die "Replica has advanced past " . $o->get('until-master')
+               . " on master.\n";
+         }
+         elsif ( $o->get('until-relay') && pos_ge($stat, 'relay', $source_name) ) {
+            die "Replica has advanced past " . $o->get('until-relay')
+               . " in relay logs.\n";
+         }
+
+         if ( $stat->{"${replica_name}_sql_running"} eq 'No' ) {
+            # Print the time, error, etc
+            if ( $o->get('verbose') ) {
+               my $err = '';
+               if ( $o->get('verbose') > 1 ) {
+                  ($err = $stat->{last_error} || '' ) =~ s/\s+/ /g;
+                  if ( $o->get('error-length') ) {
+                     $err = substr($err, 0, $o->get('error-length'));
+                  }
+               }
+               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 ( $o->got('error-numbers')
+                 && !exists($o->get('error-numbers')->{$stat->{last_errno}}) ) {
+               die "Error $stat->{last_errno} is not in --error-numbers.\n";
+            }
+            elsif ( $err_text
+                    && $stat->{last_error}
+                    && $stat->{last_error} !~ m/$err_text/ ) {
+               die "Error does not match --error-text.\n";
+            }
+            elsif ( $stat->{last_error} || $o->get('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).
+               if ( $o->get('check-relay-log') ) {
+                  $last_log = $stat->{relay_log_file};
+                  $last_pos = $stat->{relay_log_pos};
+               }
+            }
+            else {
+               PTDEBUG && _d('The replica is stopped, but without error');
+               $increase_sleep = 1;
+            }
+         }
+         elsif ( $o->get('verbose') > 2 ) {
+            printf("%s delayed %s sec\n", $dp->as_string($dsn),
+               (defined $stat->{"seconds_behind_${source_name}"} ?
+               $stat->{"seconds_behind_${source_name}"} : 'NULL'));
+         }
+      }
+      else {
+         if ( $o->get('verbose') ) {
+            print "Not checking replica because relay log file or position has "
+               . "not changed "
+               . "(file " . ($last_log || '')
+               . " pos "  . ($last_pos || '') . ")\n";
+         }
+      }
+
+      # Adjust sleep time.
+      if ( $increase_sleep ) {
+         $sleep = min($o->get('max-sleep'), $sleep * 2);
+      }
+      else {
+         $sleep = max($o->get('min-sleep'), $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 pt-replica-restart finds an error; now $sleep is 256, but
+      # pt-replica-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.
+      my $sleep_time = $increase_sleep ? $sleep : min($sleep, $o->get('sleep'));
+      if ( $o->get('verbose') > 2 ) {
+         printf("%s sleeping %f\n", $dp->as_string($dsn), $sleep_time);
+      }
+      sleep $sleep_time;
+   }
+
+   PTDEBUG && _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, $source_name ) = @_;
+   my $fmt  = '%s/%020d';
+   my $curr = $which eq $source_name
+      ? sprintf($fmt, @{$stat}{("relay_${source_name}_log_file", "exec_${source_name}_log_pos")})
+      : sprintf($fmt, @{$stat}{qw(relay_log_file relay_log_pos)});
+   my $stop = sprintf($fmt, split(',', $o->get("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);
+}
+
+# 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);
+}
+
+sub _d {
+   my ($package, undef, $line) = caller 0;
+   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
+        map { defined $_ ? $_ : 'undef' }
+        @_;
+   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
+}
+
+# ############################################################################
+# Run the program.
+# ############################################################################
+if ( !caller ) { exit main(@ARGV); }
+
+1; # Because this is a module as well as a script.
+
+# ############################################################################
+# Documentation.
+# ############################################################################
+
+=pod
+
+=head1 NAME
+
+pt-replica-restart - Watch and restart MySQL replication after errors.
+
+=head1 SYNOPSIS
+
+Usage: pt-replica-restart [OPTIONS] [DSN]
+
+pt-replica-restart watches one or more MySQL replication slaves for
+errors, and tries to restart replication if it stops.
+
+=head1 RISKS
+
+Percona Toolkit is mature, proven in the real world, and well tested,
+but all database tools can pose a risk to the system and the database
+server.  Before using this tool, please:
+
+=over
+
+=item * Read the tool's documentation
+
+=item * Review the tool's known L<"BUGS">
+
+=item * Test the tool on a non-production server
+
+=item * Backup your production server and verify the backups
+
+=back
+
+=head1 DESCRIPTION
+
+pt-replica-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.
+
+Although this tool can help a slave advance past errors, you should not
+rely on it to "fix" replication.  If slave errors occur frequently or
+unexpectedly, you should identify and fix the root cause.
+
+=head1 OUTPUT
+
+pt-replica-restart prints a line every time it sees the slave has an error.
+By default this line is: a timestamp, connection information, relay_log_file,
+relay_log_pos, and last_errno.
+You can add more information using the L<"--verbose"> option.
+You can suppress all output using the L<"--quiet"> option.
+
+=head1 SLEEP
+
+pt-replica-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<"--min-sleep"> and above by
+L<"--max-sleep">.
+
+=item *
+
+Immediately after finding an error, pt-replica-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 GLOBAL TRANSACTION IDS
+
+As of Percona Toolkit 2.2.8, pt-replica-restart supports Global Transaction IDs
+introduced in MySQL 5.6.5.  It's important to keep in mind that:
+
+=over
+
+=item *
+
+pt-replica-restart will not skip transactions when multiple replication threads
+are being used (slave_parallel_workers > 0).  pt-replica-restart does not know
+what the GTID event is of the failed transaction of a specific slave thread.
+
+=item *
+
+The default behavior is to skip the next transaction from the slave's master.
+Writes can originate on different servers, each with their own UUID.
+
+See L<"--master-uuid">.
+
+=back
+
+=head1 EXIT STATUS
+
+An exit status of 0 (sometimes also called a return value or return code)
+indicates success.  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
+
+pt-replica-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 OPTIONS
+
+This tool accepts additional command-line arguments.  Refer to the
+L<"SYNOPSIS"> and usage information for details.
+
+=over
+
+=item --always
+
+Start slaves even when there is no error.  With this option enabled,
+pt-replica-restart will not let you stop the slave manually if you want to!
+
+=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 --[no]check-relay-log
+
+default: yes
+
+Check the last relay log file and position before checking for slave errors.
+
+By default pt-replica-restart will not doing anything (it will just sleep)
+if neither the relay log file nor the relay log position have changed since
+the last check.  This prevents infinite loops (i.e. restarting the same
+error in the same relay log file at the same relay log position).
+
+For certain slave errors, however, this check needs to be disabled by
+specifying C<--no-check-relay-log>.  Do not do this unless you know what
+you are doing!
+
+=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
+
+Database to use.
+
+=item --defaults-file
+
+short form: -F; type: string
+
+Only read mysql options from the given file.  You must give an absolute
+pathname.
+
+=item --error-length
+
+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
+
+type: hash
+
+Only restart this comma-separated list of errors.  Makes pt-replica-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
+
+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,
+pt-replica-restart will try to restart the slave.  If it exists but doesn't match,
+pt-replica-restart will exit.
+
+The error text is in the C<last_error> column of C<SHOW SLAVE STATUS>.
+
+=item --help
+
+Show help and exit.
+
+=item --host
+
+short form: -h; type: string
+
+Connect to host.
+
+=item --log
+
+type: string
+
+Print all output to this file when daemonized.
+
+=item --max-sleep
+
+type: float; default: 64
+
+Maximum sleep seconds.
+
+The maximum time pt-replica-restart will sleep before polling the slave again.
+This is also the time that pt-replica-restart will wait for all other running
+instances to quit if both L<"--stop"> and L<"--monitor"> are specified.
+
+See L<"SLEEP">.
+
+=item --min-sleep
+
+type: float; default: 0.015625
+
+The minimum time pt-replica-restart will sleep before polling the slave again.
+See L<"SLEEP">.
+
+=item --monitor
+
+Whether to monitor the slave (default).  Unless you specify --monitor
+explicitly, L<"--stop"> will disable it.
+
+=item --password
+
+short form: -p; type: string
+
+Password to use when connecting.
+If password contains commas they must be escaped with a backslash: "exam\,ple"
+
+=item --pid
+
+type: string
+
+Create the given PID file.  The tool won't start if the PID file already
+exists and the PID it contains is different than the current PID.  However,
+if the PID file exists and the PID it contains is no longer running, the
+tool will overwrite the PID file with the current PID.  The PID file is
+removed automatically when the tool 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
+
+type: int; default: 0
+
+Watch slaves of the specified server, up to the specified number of servers deep
+in the hierarchy.  The default depth of 0 means "just watch the slave
+specified."
+
+pt-replica-restart examines C<SHOW PROCESSLIST> and tries to determine which
+connections are from slaves, then connect to them.  See L<"--recursion-method">.
+
+Recursion works by finding all slaves when the program starts, then watching
+them.  If there is more than one slave, C<pt-replica-restart> uses C<fork()> to
+monitor them.
+
+This also 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.
+
+=item --recursion-method
+
+type: array; default: processlist,hosts
+
+Preferred recursion method used to find slaves.
+
+Possible methods are:
+
+  METHOD       USES
+  ===========  ==================
+  processlist  SHOW PROCESSLIST
+  hosts        SHOW SLAVE HOSTS
+  none         Do not find slaves
+
+The processlist method is preferred because SHOW SLAVE HOSTS is not reliable.
+However, the hosts method is required if the server uses a non-standard
+port (not 3306).  Usually pt-replica-restart does the right thing and finds
+the slaves, but you may give a preferred method and it will be used first.
+If it doesn't find any slaves, the other methods will be tried.
+
+=item --run-time
+
+type: time
+
+Time to run before exiting.  Causes pt-replica-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 --sentinel
+
+type: string; default: /tmp/pt-replica-restart-sentinel
+
+Exit if this file exists.
+
+=item --slave-user
+
+type: string
+
+Sets the user to be used to connect to the slaves.
+This parameter allows you to have a different user with less privileges on the
+slaves but that user must exist on all slaves.
+
+=item --slave-password
+
+type: string
+
+Sets the password to be used to connect to the slaves.
+It can be used with --slave-user and the password for the user must be the same
+on all slaves.
+
+=item --set-vars
+
+type: Array
+
+Set the MySQL variables in this comma-separated list of C<variable=value> pairs.
+
+By default, the tool sets:
+
+=for comment ignore-pt-internal-value
+MAGIC_set_vars
+
+   wait_timeout=10000
+
+Variables specified on the command line override these defaults.  For
+example, specifying C<--set-vars wait_timeout=500> overrides the defaultvalue of C<10000>.
+
+The tool prints a warning and continues if a variable cannot be set.
+
+=item --skip-count
+
+type: int; default: 1
+
+Number of statements to skip when restarting the slave.
+
+=item --source-uuid
+
+type: string
+
+When using GTID, an empty transaction should be created in order to skip it.
+If writes are coming from different nodes in the replication tree above, it is
+not possible to know which event from which UUID to skip.
+
+By default, transactions from the slave's master (C<'Master_UUID'> from
+C<SHOW SLAVE STATUS>) are skipped.
+
+For example, with
+
+  master1 -> slave1 -> slave2
+
+When skipping events on slave2 that were written to master1, you must specify
+the UUID of master1, else the tool will use the UUID of slave1 by default.
+
+See L<"GLOBAL TRANSACTION IDS">.
+
+=item --sleep
+
+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<pt-replica-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<pt-replica-restart> will exit after creating the file.  If it is
+specified, C<pt-replica-restart> will wait the interval given by
+L<"--max-sleep">, 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<pt-replica-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 * * * * pt-replica-restart --monitor --stop --sentinel /tmp/pt-replica-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 --until-master
+
+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 pt-replica-restart
+will exit.
+
+=item --until-relay
+
+type: string
+
+Run until this relay log file and position.  Like L<"--until-master">, 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
+
+Adds more information to the output.
+This flag can be specified multiple times. e.g. -v -v OR -vv.
+By default (no verbose flag) the tool outputs connection information, a timestamp,
+relay_log_file, relay_log_pos, and last_errno.
+One flag (-v) adds last_error.  See also L<"--error-length">.
+Two flags (-vv) prints the current sleep time each time pt-replica-restart sleeps.
+To suppress all output use the L<"--quiet"> option.
+
+=item --version
+
+Show version and exit.
+
+=item --[no]version-check
+
+default: yes
+
+Check for the latest version of Percona Toolkit, MySQL, and other programs.
+
+This is a standard "check for updates automatically" feature, with two
+additional features.  First, the tool checks its own version and also the
+versions of the following software: operating system, Percona Monitoring and
+Management (PMM), MySQL, Perl, MySQL driver for Perl (DBD::mysql), and
+Percona Toolkit. Second, it checks for and warns about versions with known
+problems. For example, MySQL 5.5.25 had a critical bug and was re-released
+as 5.5.25a.
+
+A secure connection to Percona’s Version Check database server is done to
+perform these checks. Each request is logged by the server, including software
+version numbers and unique ID of the checked system. The ID is generated by the
+Percona Toolkit installation script or when the Version Check database call is
+done for the first time.
+
+Any updates or known problems are printed to STDOUT before the tool's normal
+output.  This feature should never interfere with the normal operation of the
+tool.
+
+For more information, visit L<https://www.percona.com/doc/percona-toolkit/LATEST/version-check.html>.
+
+=back
+
+Show version and exit.
+
+=head1 DSN OPTIONS
+
+These DSN options are used to create a DSN.  Each option is given like
+C<option=value>.  The options are case-sensitive, so P and p are not the
+same option.  There cannot be whitespace before or after the C<=> and
+if the value contains whitespace it must be quoted.  DSN options are
+comma-separated.  See the L<percona-toolkit> manpage for full details.
+
+=over
+
+=item * A
+
+dsn: charset; copy: yes
+
+Default character set.
+
+=item * D
+
+dsn: database; copy: yes
+
+Default database.
+
+=item * F
+
+dsn: mysql_read_default_file; copy: yes
+
+Only read default options from the given file
+
+=item * h
+
+dsn: host; copy: yes
+
+Connect to host.
+
+=item * p
+
+dsn: password; copy: yes
+
+Password to use when connecting.
+If password contains commas they must be escaped with a backslash: "exam\,ple"
+
+=item * P
+
+dsn: port; copy: yes
+
+Port number to use for connection.
+
+=item * S
+
+dsn: mysql_socket; copy: yes
+
+Socket file to use for connection.
+
+=item * u
+
+dsn: user; copy: yes
+
+User for login if not current user.
+
+=back
+
+=head1 ENVIRONMENT
+
+The environment variable C<PTDEBUG> enables verbose debugging output to STDERR.
+To enable debugging and capture all output to a file, run the tool like:
+
+   PTDEBUG=1 pt-replica-restart ... > FILE 2>&1
+
+Be careful: debugging output is voluminous and can generate several megabytes
+of output.
+
+=head1 ATTENTION
+
+Using <PTDEBUG> might expose passwords. When debug is enabled, all command line
+parameters are shown in the output.
+
+=head1 SYSTEM REQUIREMENTS
+
+You need Perl, DBI, DBD::mysql, and some core packages that ought to be
+installed in any reasonably new version of Perl.
+
+=head1 BUGS
+
+For a list of known bugs, see L<https://jira.percona.com/projects/PT/issues>.
+
+Please report bugs at L<https://jira.percona.com/projects/PT>.
+Include the following information in your bug report:
+
+=over
+
+=item * Complete command-line used to run the tool
+
+=item * Tool L<"--version">
+
+=item * MySQL version of all servers involved
+
+=item * Output from the tool including STDERR
+
+=item * Input files (log/dump/config files, etc.)
+
+=back
+
+If possible, include debugging output by running the tool with C<PTDEBUG>;
+see L<"ENVIRONMENT">.
+
+=head1 DOWNLOADING
+
+Visit L<http://www.percona.com/software/percona-toolkit/> to download the
+latest release of Percona Toolkit.  Or, get the latest release from the
+command line:
+
+   wget percona.com/get/percona-toolkit.tar.gz
+
+   wget percona.com/get/percona-toolkit.rpm
+
+   wget percona.com/get/percona-toolkit.deb
+
+You can also get individual tools from the latest release:
+
+   wget percona.com/get/TOOL
+
+Replace C<TOOL> with the name of any tool.
+
+=head1 AUTHORS
+
+Baron Schwartz
+
+=head1 ABOUT PERCONA TOOLKIT
+
+This tool is part of Percona Toolkit, a collection of advanced command-line
+tools for MySQL developed by Percona.  Percona Toolkit was forked from two
+projects in June, 2011: Maatkit and Aspersa.  Those projects were created by
+Baron Schwartz and primarily developed by him and Daniel Nichter.  Visit
+L<http://www.percona.com/software/> to learn about other free, open-source
+software from Percona.
+
+=head1 COPYRIGHT, LICENSE, AND WARRANTY
+
+This program is copyright 2011-2024 Percona LLC and/or its affiliates,
+2007-2011 Baron Schwartz.
+
+THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
+systems, you can issue `man perlgpl' or `man perlartistic' to read these
+licenses.
+
+You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+Place, Suite 330, Boston, MA  02111-1307  USA.
+
+=head1 VERSION
+
+pt-replica-restart 3.6.0
+
+=cut
diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart
deleted file mode 100755
index 0ac6d902..00000000
--- a/bin/pt-slave-restart
+++ /dev/null
@@ -1,6444 +0,0 @@
-#!/usr/bin/env perl
-
-# This program is part of Percona Toolkit: http://www.percona.com/software/
-# See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal
-# notices and disclaimers.
-
-use strict;
-use warnings FATAL => 'all';
-
-# This tool is "fat-packed": most of its dependent modules are embedded
-# in this file.  Setting %INC to this file for each module makes Perl aware
-# of this so it will not try to load the module from @INC.  See the tool's
-# documentation for a full list of dependencies.
-BEGIN {
-   $INC{$_} = __FILE__ for map { (my $pkg = "$_.pm") =~ s!::!/!g; $pkg } (qw(
-      Percona::Toolkit
-      Quoter
-      OptionParser
-      Lmo::Utils
-      Lmo::Meta
-      Lmo::Object
-      Lmo::Types
-      Lmo
-      VersionParser
-      DSNParser
-      MasterSlave
-      Daemon
-      HTTP::Micro
-      VersionCheck
-   ));
-}
-
-# ###########################################################################
-# Percona::Toolkit package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Percona/Toolkit.pm
-#   t/lib/Percona/Toolkit.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::Toolkit;
-
-our $VERSION = '3.6.0';
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Carp qw(carp cluck);
-use Data::Dumper qw();
-
-require Exporter;
-our @ISA         = qw(Exporter);
-our @EXPORT_OK   = qw(
-   have_required_args
-   Dumper
-   _d
-);
-
-sub have_required_args {
-   my ($args, @required_args) = @_;
-   my $have_required_args = 1;
-   foreach my $arg ( @required_args ) {
-      if ( !defined $args->{$arg} ) {
-         $have_required_args = 0;
-         carp "Argument $arg is not defined";
-      }
-   }
-   cluck unless $have_required_args;  # print backtrace
-   return $have_required_args;
-}
-
-sub Dumper {
-   local $Data::Dumper::Indent    = 1;
-   local $Data::Dumper::Sortkeys  = 1;
-   local $Data::Dumper::Quotekeys = 0;
-   Data::Dumper::Dumper(@_);
-}
-
-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 Percona::Toolkit package
-# ###########################################################################
-
-# ###########################################################################
-# Quoter package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Quoter.pm
-#   t/lib/Quoter.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Quoter;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Data::Dumper;
-$Data::Dumper::Indent    = 1;
-$Data::Dumper::Sortkeys  = 1;
-$Data::Dumper::Quotekeys = 0;
-
-sub new {
-   my ( $class, %args ) = @_;
-   return bless {}, $class;
-}
-
-sub quote {
-   my ( $self, @vals ) = @_;
-   foreach my $val ( @vals ) {
-      $val =~ s/`/``/g;
-   }
-   return join('.', map { '`' . $_ . '`' } @vals);
-}
-
-sub quote_val {
-   my ( $self, $val, %args ) = @_;
-
-   return 'NULL' unless defined $val;          # undef = NULL
-   return "''" if $val eq '';                  # blank string = ''
-   return $val if $val =~ m/^0x[0-9a-fA-F]+$/  # quote hex data
-                  && !$args{is_char};          # unless is_char is true
-
-   return $val if $args{is_float};
-
-   $val =~ s/(['\\])/\\$1/g;
-   return "'$val'";
-}
-
-sub split_unquote {
-   my ( $self, $db_tbl, $default_db ) = @_;
-   my ( $db, $tbl ) = split(/[.]/, $db_tbl);
-   if ( !$tbl ) {
-      $tbl = $db;
-      $db  = $default_db;
-   }
-   for ($db, $tbl) {
-      next unless $_;
-      s/\A`//;
-      s/`\z//;
-      s/``/`/g;
-   }
-
-   return ($db, $tbl);
-}
-
-sub literal_like {
-   my ( $self, $like ) = @_;
-   return unless $like;
-   $like =~ s/([%_])/\\$1/g;
-   return "'$like'";
-}
-
-sub join_quote {
-   my ( $self, $default_db, $db_tbl ) = @_;
-   return unless $db_tbl;
-   my ($db, $tbl) = split(/[.]/, $db_tbl);
-   if ( !$tbl ) {
-      $tbl = $db;
-      $db  = $default_db;
-   }
-   $db  = "`$db`"  if $db  && $db  !~ m/^`/;
-   $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/;
-   return $db ? "$db.$tbl" : $tbl;
-}
-
-sub serialize_list {
-   my ( $self, @args ) = @_;
-   PTDEBUG && _d('Serializing', Dumper(\@args));
-   return unless @args;
-
-   my @parts;
-   foreach my $arg  ( @args ) {
-      if ( defined $arg ) {
-         $arg =~ s/,/\\,/g;      # escape commas
-         $arg =~ s/\\N/\\\\N/g;  # escape literal \N
-         push @parts, $arg;
-      }
-      else {
-         push @parts, '\N';
-      }
-   }
-
-   my $string = join(',', @parts);
-   PTDEBUG && _d('Serialized: <', $string, '>');
-   return $string;
-}
-
-sub deserialize_list {
-   my ( $self, $string ) = @_;
-   PTDEBUG && _d('Deserializing <', $string, '>');
-   die "Cannot deserialize an undefined string" unless defined $string;
-
-   my @parts;
-   foreach my $arg ( split(/(?<!\\),/, $string) ) {
-      if ( $arg eq '\N' ) {
-         $arg = undef;
-      }
-      else {
-         $arg =~ s/\\,/,/g;
-         $arg =~ s/\\\\N/\\N/g;
-      }
-      push @parts, $arg;
-   }
-
-   if ( !@parts ) {
-      my $n_empty_strings = $string =~ tr/,//;
-      $n_empty_strings++;
-      PTDEBUG && _d($n_empty_strings, 'empty strings');
-      map { push @parts, '' } 1..$n_empty_strings;
-   }
-   elsif ( $string =~ m/(?<!\\),$/ ) {
-      PTDEBUG && _d('Last value is an empty string');
-      push @parts, '';
-   }
-
-   PTDEBUG && _d('Deserialized', Dumper(\@parts));
-   return @parts;
-}
-
-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 Quoter package
-# ###########################################################################
-
-# ###########################################################################
-# OptionParser package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/OptionParser.pm
-#   t/lib/OptionParser.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package OptionParser;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use List::Util qw(max);
-use Getopt::Long;
-use Data::Dumper;
-
-my $POD_link_re = '[LC]<"?([^">]+)"?>';
-
-sub new {
-   my ( $class, %args ) = @_;
-   my @required_args = qw();
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-
-   my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
-   $program_name ||= $PROGRAM_NAME;
-   my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
-
-   my %attributes = (
-      'type'       => 1,
-      'short form' => 1,
-      'group'      => 1,
-      'default'    => 1,
-      'cumulative' => 1,
-      'negatable'  => 1,
-      'repeatable' => 1,  # means it can be specified more than once
-   );
-
-   my $self = {
-      head1             => 'OPTIONS',        # These args are used internally
-      skip_rules        => 0,                # to instantiate another Option-
-      item              => '--(.*)',         # Parser obj that parses the
-      attributes        => \%attributes,     # DSN OPTIONS section.  Tools
-      parse_attributes  => \&_parse_attribs, # don't tinker with these args.
-
-      %args,
-
-      strict            => 1,  # disabled by a special rule
-      program_name      => $program_name,
-      opts              => {},
-      got_opts          => 0,
-      short_opts        => {},
-      defaults          => {},
-      groups            => {},
-      allowed_groups    => {},
-      errors            => [],
-      rules             => [],  # desc of rules for --help
-      mutex             => [],  # rule: opts are mutually exclusive
-      atleast1          => [],  # rule: at least one opt is required
-      disables          => {},  # rule: opt disables other opts
-      defaults_to       => {},  # rule: opt defaults to value of other opt
-      DSNParser         => undef,
-      default_files     => [
-         "/etc/percona-toolkit/percona-toolkit.conf",
-         "/etc/percona-toolkit/$program_name.conf",
-         "$home/.percona-toolkit.conf",
-         "$home/.$program_name.conf",
-      ],
-      types             => {
-         string => 's', # standard Getopt type
-         int    => 'i', # standard Getopt type
-         float  => 'f', # standard Getopt type
-         Hash   => 'H', # hash, formed from a comma-separated list
-         hash   => 'h', # hash as above, but only if a value is given
-         Array  => 'A', # array, similar to Hash
-         array  => 'a', # array, similar to hash
-         DSN    => 'd', # DSN
-         size   => 'z', # size with kMG suffix (powers of 2^10)
-         time   => 'm', # time, with an optional suffix of s/h/m/d
-      },
-   };
-
-   return bless $self, $class;
-}
-
-sub get_specs {
-   my ( $self, $file ) = @_;
-   $file ||= $self->{file} || __FILE__;
-   my @specs = $self->_pod_to_specs($file);
-   $self->_parse_specs(@specs);
-
-   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
-   my $contents = do { local $/ = undef; <$fh> };
-   close $fh;
-   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
-      PTDEBUG && _d('Parsing DSN OPTIONS');
-      my $dsn_attribs = {
-         dsn  => 1,
-         copy => 1,
-      };
-      my $parse_dsn_attribs = sub {
-         my ( $self, $option, $attribs ) = @_;
-         map {
-            my $val = $attribs->{$_};
-            if ( $val ) {
-               $val    = $val eq 'yes' ? 1
-                       : $val eq 'no'  ? 0
-                       :                 $val;
-               $attribs->{$_} = $val;
-            }
-         } keys %$attribs;
-         return {
-            key => $option,
-            %$attribs,
-         };
-      };
-      my $dsn_o = new OptionParser(
-         description       => 'DSN OPTIONS',
-         head1             => 'DSN OPTIONS',
-         dsn               => 0,         # XXX don't infinitely recurse!
-         item              => '\* (.)',  # key opts are a single character
-         skip_rules        => 1,         # no rules before opts
-         attributes        => $dsn_attribs,
-         parse_attributes  => $parse_dsn_attribs,
-      );
-      my @dsn_opts = map {
-         my $opts = {
-            key  => $_->{spec}->{key},
-            dsn  => $_->{spec}->{dsn},
-            copy => $_->{spec}->{copy},
-            desc => $_->{desc},
-         };
-         $opts;
-      } $dsn_o->_pod_to_specs($file);
-      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
-   }
-
-   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
-      $self->{version} = $1;
-      PTDEBUG && _d($self->{version});
-   }
-
-   return;
-}
-
-sub DSNParser {
-   my ( $self ) = @_;
-   return $self->{DSNParser};
-};
-
-sub get_defaults_files {
-   my ( $self ) = @_;
-   return @{$self->{default_files}};
-}
-
-sub _pod_to_specs {
-   my ( $self, $file ) = @_;
-   $file ||= $self->{file} || __FILE__;
-   open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR";
-
-   my @specs = ();
-   my @rules = ();
-   my $para;
-
-   local $INPUT_RECORD_SEPARATOR = '';
-   while ( $para = <$fh> ) {
-      next unless $para =~ m/^=head1 $self->{head1}/;
-      last;
-   }
-
-   while ( $para = <$fh> ) {
-      last if $para =~ m/^=over/;
-      next if $self->{skip_rules};
-      chomp $para;
-      $para =~ s/\s+/ /g;
-      $para =~ s/$POD_link_re/$1/go;
-      PTDEBUG && _d('Option rule:', $para);
-      push @rules, $para;
-   }
-
-   die "POD has no $self->{head1} section" unless $para;
-
-   do {
-      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
-         chomp $para;
-         PTDEBUG && _d($para);
-         my %attribs;
-
-         $para = <$fh>; # read next paragraph, possibly attributes
-
-         if ( $para =~ m/: / ) { # attributes
-            $para =~ s/\s+\Z//g;
-            %attribs = map {
-                  my ( $attrib, $val) = split(/: /, $_);
-                  die "Unrecognized attribute for --$option: $attrib"
-                     unless $self->{attributes}->{$attrib};
-                  ($attrib, $val);
-               } split(/; /, $para);
-            if ( $attribs{'short form'} ) {
-               $attribs{'short form'} =~ s/-//;
-            }
-            $para = <$fh>; # read next paragraph, probably short help desc
-         }
-         else {
-            PTDEBUG && _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;
-         PTDEBUG && _d('Short help:', $para);
-
-         die "No description after option spec $option" if $para =~ m/^=item/;
-
-         if ( my ($base_option) =  $option =~ m/^\[no\](.*)/ ) {
-            $option = $base_option;
-            $attribs{'negatable'} = 1;
-         }
-
-         push @specs, {
-            spec  => $self->{parse_attributes}->($self, $option, \%attribs),
-            desc  => $para
-               . (defined $attribs{default} ? " (default $attribs{default})" : ''),
-            group => ($attribs{'group'} ? $attribs{'group'} : 'default'),
-            attributes => \%attribs
-         };
-      }
-      while ( $para = <$fh> ) {
-         last unless $para;
-         if ( $para =~ m/^=head1/ ) {
-            $para = undef; # Can't 'last' out of a do {} block.
-            last;
-         }
-         last if $para =~ m/^=item /;
-      }
-   } while ( $para );
-
-   die "No valid specs in $self->{head1}" unless @specs;
-
-   close $fh;
-   return @specs, @rules;
-}
-
-sub _parse_specs {
-   my ( $self, @specs ) = @_;
-   my %disables; # special rule that requires deferred checking
-
-   foreach my $opt ( @specs ) {
-      if ( ref $opt ) { # It's an option spec, not a rule.
-         PTDEBUG && _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 ) {
-            PTDEBUG && _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_repeatable} = $opt->{attributes}->{repeatable} ? 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;
-         PTDEBUG && _d($long, 'type:', $type);
-
-
-         $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ );
-
-         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
-            $self->{defaults}->{$long} = defined $def ? $def : 1;
-            PTDEBUG && _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;
-            PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
-         }
-
-         $self->{opts}->{$long} = $opt;
-      }
-      else { # It's an option rule, not a spec.
-         PTDEBUG && _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;
-            PTDEBUG && _d(@participants, 'are mutually exclusive');
-         }
-         if ( $opt =~ m/at least one|one and only one/ ) {
-            $rule_ok = 1;
-            push @{$self->{atleast1}}, \@participants;
-            PTDEBUG && _d(@participants, 'require at least one');
-         }
-         if ( $opt =~ m/default to/ ) {
-            $rule_ok = 1;
-            $self->{defaults_to}->{$participants[0]} = $participants[1];
-            PTDEBUG && _d($participants[0], 'defaults to', $participants[1]);
-         }
-         if ( $opt =~ m/restricted to option groups/ ) {
-            $rule_ok = 1;
-            my ($groups) = $opt =~ m/groups ([\w\s\,]+)/;
-            my @groups = split(',', $groups);
-            %{$self->{allowed_groups}->{$participants[0]}} = map {
-               s/\s+//;
-               $_ => 1;
-            } @groups;
-         }
-         if( $opt =~ m/accepts additional command-line arguments/ ) {
-            $rule_ok = 1;
-            $self->{strict} = 0;
-            PTDEBUG && _d("Strict mode disabled by rule");
-         }
-
-         die "Unrecognized option rule: $opt" unless $rule_ok;
-      }
-   }
-
-   foreach my $long ( keys %disables ) {
-      my @participants = $self->_get_participants($disables{$long});
-      $self->{disables}->{$long} = \@participants;
-      PTDEBUG && _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;
-   }
-   PTDEBUG && _d('Participants for', $str, ':', @participants);
-   return @participants;
-}
-
-sub opts {
-   my ( $self ) = @_;
-   my %opts = %{$self->{opts}};
-   return %opts;
-}
-
-sub short_opts {
-   my ( $self ) = @_;
-   my %short_opts = %{$self->{short_opts}};
-   return %short_opts;
-}
-
-sub set_defaults {
-   my ( $self, %defaults ) = @_;
-   $self->{defaults} = {};
-   foreach my $long ( keys %defaults ) {
-      die "Cannot set default for nonexistent option $long"
-         unless exists $self->{opts}->{$long};
-      $self->{defaults}->{$long} = $defaults{$long};
-      PTDEBUG && _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}++;
-   }
-   elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) {
-      my $next_opt = $1;
-      if (    exists $self->{opts}->{$next_opt}
-           || exists $self->{short_opts}->{$next_opt} ) {
-         $self->save_error("--$long requires a string value");
-         return;
-      }
-      else {
-         if ($opt->{is_repeatable}) {
-            push @{$opt->{value}} , $val;
-         }
-         else {
-            $opt->{value} = $val;
-         }
-      }
-   }
-   else {
-      if ($opt->{is_repeatable}) {
-         push @{$opt->{value}} , $val;
-      }
-      else {
-         $opt->{value} = $val;
-      }
-   }
-   $opt->{got} = 1;
-   PTDEBUG && _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] =~/^--config=/ ) {
-      $ARGV[0] = substr($ARGV[0],9);
-      $ARGV[0] =~ s/^'(.*)'$/$1/;
-      $ARGV[0] =~ s/^"(.*)"$/$1/;
-      $self->_set_option('config', shift @ARGV);
-   }
-   if ( @ARGV && $ARGV[0] eq "--config" ) {
-      shift @ARGV;
-      $self->_set_option('config', shift @ARGV);
-   }
-   if ( $self->has('config') ) {
-      my @extra_args;
-      foreach my $filename ( split(',', $self->get('config')) ) {
-         eval {
-            push @extra_args, $self->_read_config_file($filename);
-         };
-         if ( $EVAL_ERROR ) {
-            if ( $self->got('config') ) {
-               die $EVAL_ERROR;
-            }
-            elsif ( PTDEBUG ) {
-               _d($EVAL_ERROR);
-            }
-         }
-      }
-      unshift @ARGV, @extra_args;
-   }
-
-   Getopt::Long::Configure('no_ignore_case', 'bundling');
-   GetOptions(
-      map    { $_->{spec} => sub { $self->_set_option(@_); } }
-      grep   { $_->{long} ne 'config' } # --config is handled specially above.
-      values %{$self->{opts}}
-   ) or $self->save_error('Error parsing options');
-
-   if ( exists $self->{opts}->{version} && $self->{opts}->{version}->{got} ) {
-      if ( $self->{version} ) {
-         print $self->{version}, "\n";
-         exit 0;
-      }
-      else {
-         print "Error parsing version.  See the VERSION section of the tool's documentation.\n";
-         exit 1;
-      }
-   }
-
-   if ( @ARGV && $self->{strict} ) {
-      $self->save_error("Unrecognized command-line options @ARGV");
-   }
-
-   foreach my $mutex ( @{$self->{mutex}} ) {
-      my @set = grep { $self->{opts}->{$_}->{got} } @$mutex;
-      if ( @set > 1 ) {
-         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
-                      @{$mutex}[ 0 .. scalar(@$mutex) - 2] )
-                 . ' and --'.$self->{opts}->{$mutex->[-1]}->{long}
-                 . ' are mutually exclusive.';
-         $self->save_error($err);
-      }
-   }
-
-   foreach my $required ( @{$self->{atleast1}} ) {
-      my @set = grep { $self->{opts}->{$_}->{got} } @$required;
-      if ( @set == 0 ) {
-         my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" }
-                      @{$required}[ 0 .. scalar(@$required) - 2] )
-                 .' or --'.$self->{opts}->{$required->[-1]}->{long};
-         $self->save_error("Specify at least one of $err");
-      }
-   }
-
-   $self->_check_opts( keys %{$self->{opts}} );
-   $self->{got_opts} = 1;
-   return;
-}
-
-sub _check_opts {
-   my ( $self, @long ) = @_;
-   my $long_last = scalar @long;
-   while ( @long ) {
-      foreach my $i ( 0..$#long ) {
-         my $long = $long[$i];
-         next unless $long;
-         my $opt  = $self->{opts}->{$long};
-         if ( $opt->{got} ) {
-            if ( exists $self->{disables}->{$long} ) {
-               my @disable_opts = @{$self->{disables}->{$long}};
-               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
-               PTDEBUG && _d('Unset options', @disable_opts,
-                  'because', $long,'disables them');
-            }
-
-            if ( exists $self->{allowed_groups}->{$long} ) {
-
-               my @restricted_groups = grep {
-                  !exists $self->{allowed_groups}->{$long}->{$_}
-               } keys %{$self->{groups}};
-
-               my @restricted_opts;
-               foreach my $restricted_group ( @restricted_groups ) {
-                  RESTRICTED_OPT:
-                  foreach my $restricted_opt (
-                     keys %{$self->{groups}->{$restricted_group}} )
-                  {
-                     next RESTRICTED_OPT if $restricted_opt eq $long;
-                     push @restricted_opts, $restricted_opt
-                        if $self->{opts}->{$restricted_opt}->{got};
-                  }
-               }
-
-               if ( @restricted_opts ) {
-                  my $err;
-                  if ( @restricted_opts == 1 ) {
-                     $err = "--$restricted_opts[0]";
-                  }
-                  else {
-                     $err = join(', ',
-                               map { "--$self->{opts}->{$_}->{long}" }
-                               grep { $_ }
-                               @restricted_opts[0..scalar(@restricted_opts) - 2]
-                            )
-                          . ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long};
-                  }
-                  $self->save_error("--$long is not allowed with $err");
-               }
-            }
-
-         }
-         elsif ( $opt->{is_required} ) {
-            $self->save_error("Required option --$long must be specified");
-         }
-
-         $self->_validate_type($opt);
-         if ( $opt->{parsed} ) {
-            delete $long[$i];
-         }
-         else {
-            PTDEBUG && _d('Temporarily failed to parse', $long);
-         }
-      }
-
-      die "Failed to parse options, possibly due to circular dependencies"
-         if @long == $long_last;
-      $long_last = @long;
-   }
-
-   return;
-}
-
-sub _validate_type {
-   my ( $self, $opt ) = @_;
-   return unless $opt;
-
-   if ( !$opt->{type} ) {
-      $opt->{parsed} = 1;
-      return;
-   }
-
-   my $val = $opt->{value};
-
-   if ( $val && $opt->{type} eq 'm' ) {  # type time
-      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
-      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
-      if ( !$suffix ) {
-         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
-         $suffix = $s || 's';
-         PTDEBUG && _d('No suffix given; using', $suffix, 'for',
-            $opt->{long}, '(value:', $val, ')');
-      }
-      if ( $suffix =~ m/[smhd]/ ) {
-         $val = $suffix eq 's' ? $num            # Seconds
-              : $suffix eq 'm' ? $num * 60       # Minutes
-              : $suffix eq 'h' ? $num * 3600     # Hours
-              :                  $num * 86400;   # Days
-         $opt->{value} = ($prefix || '') . $val;
-         PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
-      }
-      else {
-         $self->save_error("Invalid time suffix for --$opt->{long}");
-      }
-   }
-   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
-      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
-      my $prev = {};
-      my $from_key = $self->{defaults_to}->{ $opt->{long} };
-      if ( $from_key ) {
-         PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
-         if ( $self->{opts}->{$from_key}->{parsed} ) {
-            $prev = $self->{opts}->{$from_key}->{value};
-         }
-         else {
-            PTDEBUG && _d('Cannot parse', $opt->{long}, 'until',
-               $from_key, 'parsed');
-            return;
-         }
-      }
-      my $defaults = $self->{DSNParser}->parse_options($self);
-      if (!$opt->{attributes}->{repeatable}) {
-          $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
-      } else {
-          my $values = [];
-          for my $dsn_string (@$val) {
-              push @$values, $self->{DSNParser}->parse($dsn_string, $prev, $defaults);
-          }
-          $opt->{value} = $values;
-      }
-   }
-   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
-      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
-      $self->_parse_size($opt, $val);
-   }
-   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
-      $opt->{value} = { map { $_ => 1 } split(/(?<!\\),\s*/, ($val || '')) };
-   }
-   elsif ( $opt->{type} eq 'A' || (defined $val && $opt->{type} eq 'a') ) {
-      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
-   }
-   else {
-      PTDEBUG && _d('Nothing to validate for option',
-         $opt->{long}, 'type', $opt->{type}, 'value', $val);
-   }
-
-   $opt->{parsed} = 1;
-   return;
-}
-
-sub get {
-   my ( $self, $opt ) = @_;
-   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
-   die "Option $opt does not exist"
-      unless $long && exists $self->{opts}->{$long};
-   return $self->{opts}->{$long}->{value};
-}
-
-sub got {
-   my ( $self, $opt ) = @_;
-   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
-   die "Option $opt does not exist"
-      unless $long && exists $self->{opts}->{$long};
-   return $self->{opts}->{$long}->{got};
-}
-
-sub has {
-   my ( $self, $opt ) = @_;
-   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
-   return defined $long ? exists $self->{opts}->{$long} : 0;
-}
-
-sub set {
-   my ( $self, $opt, $val ) = @_;
-   my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt);
-   die "Option $opt does not exist"
-      unless $long && exists $self->{opts}->{$long};
-   $self->{opts}->{$long}->{value} = $val;
-   return;
-}
-
-sub save_error {
-   my ( $self, $error ) = @_;
-   push @{$self->{errors}}, $error;
-   return;
-}
-
-sub errors {
-   my ( $self ) = @_;
-   return $self->{errors};
-}
-
-sub usage {
-   my ( $self ) = @_;
-   warn "No usage string is set" unless $self->{usage}; # XXX
-   return "Usage: " . ($self->{usage} || '') . "\n";
-}
-
-sub descr {
-   my ( $self ) = @_;
-   warn "No description string is set" unless $self->{description}; # XXX
-   my $descr  = ($self->{description} || $self->{program_name} || '')
-              . "  For more details, please use the --help option, "
-              . "or try 'perldoc $PROGRAM_NAME' "
-              . "for complete documentation.";
-   $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g)
-      unless $ENV{DONT_BREAK_LINES};
-   $descr =~ s/ +$//mg;
-   return $descr;
-}
-
-sub usage_or_errors {
-   my ( $self, $file, $return ) = @_;
-   $file ||= $self->{file} || __FILE__;
-
-   if ( !$self->{description} || !$self->{usage} ) {
-      PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
-      my %synop = $self->_parse_synopsis($file);
-      $self->{description} ||= $synop{description};
-      $self->{usage}       ||= $synop{usage};
-      PTDEBUG && _d("Description:", $self->{description},
-         "\nUsage:", $self->{usage});
-   }
-
-   if ( $self->{opts}->{help}->{got} ) {
-      print $self->print_usage() or die "Cannot print usage: $OS_ERROR";
-      exit 0 unless $return;
-   }
-   elsif ( scalar @{$self->{errors}} ) {
-      print $self->print_errors() or die "Cannot print errors: $OS_ERROR";
-      exit 1 unless $return;
-   }
-
-   return;
-}
-
-sub print_errors {
-   my ( $self ) = @_;
-   my $usage = $self->usage() . "\n";
-   if ( (my @errors = @{$self->{errors}}) ) {
-      $usage .= join("\n  * ", 'Errors in command-line arguments:', @errors)
-              . "\n";
-   }
-   return $usage . "\n" . $self->descr();
-}
-
-sub print_usage {
-   my ( $self ) = @_;
-   die "Run get_opts() before print_usage()" unless $self->{got_opts};
-   my @opts = values %{$self->{opts}};
-
-   my $maxl = max(
-      map {
-         length($_->{long})               # option long name
-         + ($_->{is_negatable} ? 4 : 0)   # "[no]" if opt is negatable
-         + ($_->{type} ? 2 : 0)           # "=x" where x is the opt type
-      }
-      @opts);
-
-   my $maxs = max(0,
-      map {
-         length($_)
-         + ($self->{opts}->{$_}->{is_negatable} ? 4 : 0)
-         + ($self->{opts}->{$_}->{type} ? 2 : 0)
-      }
-      values %{$self->{short_opts}});
-
-   my $lcol = max($maxl, ($maxs + 3));
-   my $rcol = 80 - $lcol - 6;
-   my $rpad = ' ' x ( 80 - $rcol );
-
-   $maxs = max($lcol - 3, $maxs);
-
-   my $usage = $self->descr() . "\n" . $self->usage();
-
-   my @groups = reverse sort grep { $_ ne 'default'; } keys %{$self->{groups}};
-   push @groups, 'default';
-
-   foreach my $group ( reverse @groups ) {
-      $usage .= "\n".($group eq 'default' ? 'Options' : $group).":\n\n";
-      foreach my $opt (
-         sort { $a->{long} cmp $b->{long} }
-         grep { $_->{group} eq $group }
-         @opts )
-      {
-         my $long  = $opt->{is_negatable} ? "[no]$opt->{long}" : $opt->{long};
-         my $short = $opt->{short};
-         my $desc  = $opt->{desc};
-
-         $long .= $opt->{type} ? "=$opt->{type}" : "";
-
-         if ( $opt->{type} && $opt->{type} eq 'm' ) {
-            my ($s) = $desc =~ m/\(suffix (.)\)/;
-            $s    ||= 's';
-            $desc =~ s/\s+\(suffix .\)//;
-            $desc .= ".  Optional suffix s=seconds, m=minutes, h=hours, "
-                   . "d=days; if no suffix, $s is used.";
-         }
-         $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol}(?!\W))(?:\s+|(?<=\W)|$)/g);
-         $desc =~ s/ +$//mg;
-         if ( $short ) {
-            $usage .= sprintf("  --%-${maxs}s -%s  %s\n", $long, $short, $desc);
-         }
-         else {
-            $usage .= sprintf("  --%-${lcol}s  %s\n", $long, $desc);
-         }
-      }
-   }
-
-   $usage .= "\nOption types: s=string, i=integer, f=float, h/H/a/A=comma-separated list, d=DSN, z=size, m=time\n";
-
-   if ( (my @rules = @{$self->{rules}}) ) {
-      $usage .= "\nRules:\n\n";
-      $usage .= join("\n", map { "  $_" } @rules) . "\n";
-   }
-   if ( $self->{DSNParser} ) {
-      $usage .= "\n" . $self->{DSNParser}->usage();
-   }
-   $usage .= "\nOptions and values after processing arguments:\n\n";
-   foreach my $opt ( sort { $a->{long} cmp $b->{long} } @opts ) {
-      my $val   = $opt->{value};
-      my $type  = $opt->{type} || '';
-      my $bool  = $opt->{spec} =~ m/^[\w-]+(?:\|[\w-])?!?$/;
-      $val      = $bool              ? ( $val ? 'TRUE' : 'FALSE' )
-                : !defined $val      ? '(No value)'
-                : $type eq 'd'       ? $self->{DSNParser}->as_string($val)
-                : $type =~ m/H|h/    ? join(',', sort keys %$val)
-                : $type =~ m/A|a/    ? join(',', @$val)
-                :                    $val;
-      $usage .= sprintf("  --%-${lcol}s  %s\n", $opt->{long}, $val);
-   }
-   return $usage;
-}
-
-sub prompt_noecho {
-   shift @_ if ref $_[0] eq __PACKAGE__;
-   my ( $prompt ) = @_;
-   local $OUTPUT_AUTOFLUSH = 1;
-   print STDERR $prompt
-      or die "Cannot print: $OS_ERROR";
-   my $response;
-   eval {
-      require Term::ReadKey;
-      Term::ReadKey::ReadMode('noecho');
-      chomp($response = <STDIN>);
-      Term::ReadKey::ReadMode('normal');
-      print "\n"
-         or die "Cannot print: $OS_ERROR";
-   };
-   if ( $EVAL_ERROR ) {
-      die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR";
-   }
-   return $response;
-}
-
-sub _read_config_file {
-   my ( $self, $filename ) = @_;
-   open my $fh, "<", $filename or die "Cannot open $filename: $OS_ERROR\n";
-   my @args;
-   my $prefix = '--';
-   my $parse  = 1;
-
-   LINE:
-   while ( my $line = <$fh> ) {
-      chomp $line;
-      next LINE if $line =~ m/^\s*(?:\#|\;|$)/;
-      $line =~ s/\s+#.*$//g;
-      $line =~ s/^\s+|\s+$//g;
-      if ( $line eq '--' ) {
-         $prefix = '';
-         $parse  = 0;
-         next LINE;
-      }
-
-      if (  $parse
-            && !$self->has('version-check')
-            && $line =~ /version-check/
-      ) {
-         next LINE;
-      }
-
-      if ( $parse
-         && (my($opt, $arg) = $line =~ m/^\s*([^=\s]+?)(?:\s*=\s*(.*?)\s*)?$/)
-      ) {
-         push @args, grep { defined $_ } ("$prefix$opt", $arg);
-      }
-      elsif ( $line =~ m/./ ) {
-         push @args, $line;
-      }
-      else {
-         die "Syntax error in file $filename at line $INPUT_LINE_NUMBER";
-      }
-   }
-   close $fh;
-   return @args;
-}
-
-sub read_para_after {
-   my ( $self, $file, $regex ) = @_;
-   open my $fh, "<", $file or die "Can't open $file: $OS_ERROR";
-   local $INPUT_RECORD_SEPARATOR = '';
-   my $para;
-   while ( $para = <$fh> ) {
-      next unless $para =~ m/^=pod$/m;
-      last;
-   }
-   while ( $para = <$fh> ) {
-      next unless $para =~ m/$regex/;
-      last;
-   }
-   $para = <$fh>;
-   chomp($para);
-   close $fh or die "Can't close $file: $OS_ERROR";
-   return $para;
-}
-
-sub clone {
-   my ( $self ) = @_;
-
-   my %clone = map {
-      my $hashref  = $self->{$_};
-      my $val_copy = {};
-      foreach my $key ( keys %$hashref ) {
-         my $ref = ref $hashref->{$key};
-         $val_copy->{$key} = !$ref           ? $hashref->{$key}
-                           : $ref eq 'HASH'  ? { %{$hashref->{$key}} }
-                           : $ref eq 'ARRAY' ? [ @{$hashref->{$key}} ]
-                           : $hashref->{$key};
-      }
-      $_ => $val_copy;
-   } qw(opts short_opts defaults);
-
-   foreach my $scalar ( qw(got_opts) ) {
-      $clone{$scalar} = $self->{$scalar};
-   }
-
-   return bless \%clone;
-}
-
-sub _parse_size {
-   my ( $self, $opt, $val ) = @_;
-
-   if ( lc($val || '') eq 'null' ) {
-      PTDEBUG && _d('NULL size for', $opt->{long});
-      $opt->{value} = 'null';
-      return;
-   }
-
-   my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824);
-   my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/;
-   if ( defined $num ) {
-      if ( $factor ) {
-         $num *= $factor_for{$factor};
-         PTDEBUG && _d('Setting option', $opt->{y},
-            'to num', $num, '* factor', $factor);
-      }
-      $opt->{value} = ($pre || '') . $num;
-   }
-   else {
-      $self->save_error("Invalid size for --$opt->{long}: $val");
-   }
-   return;
-}
-
-sub _parse_attribs {
-   my ( $self, $option, $attribs ) = @_;
-   my $types = $self->{types};
-   return $option
-      . ($attribs->{'short form'} ? '|' . $attribs->{'short form'}   : '' )
-      . ($attribs->{'negatable'}  ? '!'                              : '' )
-      . ($attribs->{'cumulative'} ? '+'                              : '' )
-      . ($attribs->{'type'}       ? '=' . $types->{$attribs->{type}} : '' );
-}
-
-sub _parse_synopsis {
-   my ( $self, $file ) = @_;
-   $file ||= $self->{file} || __FILE__;
-   PTDEBUG && _d("Parsing SYNOPSIS in", $file);
-
-   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
-   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
-   my $para;
-   1 while defined($para = <$fh>) && $para !~ m/^=head1 SYNOPSIS/;
-   die "$file does not contain a SYNOPSIS section" unless $para;
-   my @synop;
-   for ( 1..2 ) {  # 1 for the usage, 2 for the description
-      my $para = <$fh>;
-      push @synop, $para;
-   }
-   close $fh;
-   PTDEBUG && _d("Raw SYNOPSIS text:", @synop);
-   my ($usage, $desc) = @synop;
-   die "The SYNOPSIS section in $file is not formatted properly"
-      unless $usage && $desc;
-
-   $usage =~ s/^\s*Usage:\s+(.+)/$1/;
-   chomp $usage;
-
-   $desc =~ s/\n/ /g;
-   $desc =~ s/\s{2,}/ /g;
-   $desc =~ s/\. ([A-Z][a-z])/.  $1/g;
-   $desc =~ s/\s+$//;
-
-   return (
-      description => $desc,
-      usage       => $usage,
-   );
-};
-
-sub set_vars {
-   my ($self, $file) = @_;
-   $file ||= $self->{file} || __FILE__;
-
-   my %user_vars;
-   my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef;
-   if ( $user_vars ) {
-      foreach my $var_val ( @$user_vars ) {
-         my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/;
-         die "Invalid --set-vars value: $var_val\n" unless $var && defined $val;
-         $user_vars{$var} = {
-            val     => $val,
-            default => 0,
-         };
-      }
-   }
-
-   my %default_vars;
-   my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/);
-   if ( $default_vars ) {
-      %default_vars = map {
-         my $var_val = $_;
-         my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/;
-         die "Invalid --set-vars value: $var_val\n" unless $var && defined $val;
-         $var => {
-            val     => $val,
-            default => 1,
-         };
-      } split("\n", $default_vars);
-   }
-
-   my %vars = (
-      %default_vars, # first the tool's defaults
-      %user_vars,    # then the user's which overwrite the defaults
-   );
-   PTDEBUG && _d('--set-vars:', Dumper(\%vars));
-   return \%vars;
-}
-
-sub _d {
-   my ($package, undef, $line) = caller 0;
-   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
-        map { defined $_ ? $_ : 'undef' }
-        @_;
-   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
-}
-
-if ( PTDEBUG ) {
-   print STDERR '# ', $^X, ' ', $], "\n";
-   if ( my $uname = `uname -a` ) {
-      $uname =~ s/\s+/ /g;
-      print STDERR "# $uname\n";
-   }
-   print STDERR '# Arguments: ',
-      join(' ', map { my $a = "_[$_]_"; $a =~ s/\n/\n# /g; $a; } @ARGV), "\n";
-}
-
-1;
-}
-# ###########################################################################
-# End OptionParser package
-# ###########################################################################
-
-# ###########################################################################
-# Lmo::Utils package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Lmo/Utils.pm
-#   t/lib/Lmo/Utils.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Lmo::Utils;
-
-use strict;
-use warnings qw( FATAL all );
-require Exporter;
-our (@ISA, @EXPORT, @EXPORT_OK);
-
-BEGIN {
-   @ISA = qw(Exporter);
-   @EXPORT = @EXPORT_OK = qw(
-      _install_coderef
-      _unimport_coderefs
-      _glob_for
-      _stash_for
-   );
-}
-
-{
-   no strict 'refs';
-   sub _glob_for {
-      return \*{shift()}
-   }
-
-   sub _stash_for {
-      return \%{ shift() . "::" };
-   }
-}
-
-sub _install_coderef {
-   my ($to, $code) = @_;
-
-   return *{ _glob_for $to } = $code;
-}
-
-sub _unimport_coderefs {
-   my ($target, @names) = @_;
-   return unless @names;
-   my $stash = _stash_for($target);
-   foreach my $name (@names) {
-      if ($stash->{$name} and defined(&{$stash->{$name}})) {
-         delete $stash->{$name};
-      }
-   }
-}
-
-1;
-}
-# ###########################################################################
-# End Lmo::Utils package
-# ###########################################################################
-
-# ###########################################################################
-# Lmo::Meta package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Lmo/Meta.pm
-#   t/lib/Lmo/Meta.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Lmo::Meta;
-use strict;
-use warnings qw( FATAL all );
-
-my %metadata_for;
-
-sub new {
-   my $class = shift;
-   return bless { @_ }, $class
-}
-
-sub metadata_for {
-   my $self    = shift;
-   my ($class) = @_;
-
-   return $metadata_for{$class} ||= {};
-}
-
-sub class { shift->{class} }
-
-sub attributes {
-   my $self = shift;
-   return keys %{$self->metadata_for($self->class)}
-}
-
-sub attributes_for_new {
-   my $self = shift;
-   my @attributes;
-
-   my $class_metadata = $self->metadata_for($self->class);
-   while ( my ($attr, $meta) = each %$class_metadata ) {
-      if ( exists $meta->{init_arg} ) {
-         push @attributes, $meta->{init_arg}
-               if defined $meta->{init_arg};
-      }
-      else {
-         push @attributes, $attr;
-      }
-   }
-   return @attributes;
-}
-
-1;
-}
-# ###########################################################################
-# End Lmo::Meta package
-# ###########################################################################
-
-# ###########################################################################
-# Lmo::Object package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Lmo/Object.pm
-#   t/lib/Lmo/Object.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Lmo::Object;
-
-use strict;
-use warnings qw( FATAL all );
-
-use Carp ();
-use Scalar::Util qw(blessed);
-
-use Lmo::Meta;
-use Lmo::Utils qw(_glob_for);
-
-sub new {
-   my $class = shift;
-   my $args  = $class->BUILDARGS(@_);
-
-   my $class_metadata = Lmo::Meta->metadata_for($class);
-
-   my @args_to_delete;
-   while ( my ($attr, $meta) = each %$class_metadata ) {
-      next unless exists $meta->{init_arg};
-      my $init_arg = $meta->{init_arg};
-
-      if ( defined $init_arg ) {
-         $args->{$attr} = delete $args->{$init_arg};
-      }
-      else {
-         push @args_to_delete, $attr;
-      }
-   }
-
-   delete $args->{$_} for @args_to_delete;
-
-   for my $attribute ( keys %$args ) {
-      if ( my $coerce = $class_metadata->{$attribute}{coerce} ) {
-         $args->{$attribute} = $coerce->($args->{$attribute});
-      }
-      if ( my $isa_check = $class_metadata->{$attribute}{isa} ) {
-         my ($check_name, $check_sub) = @$isa_check;
-         $check_sub->($args->{$attribute});
-      }
-   }
-
-   while ( my ($attribute, $meta) = each %$class_metadata ) {
-      next unless $meta->{required};
-      Carp::confess("Attribute ($attribute) is required for $class")
-         if ! exists $args->{$attribute}
-   }
-
-   my $self = bless $args, $class;
-
-   my @build_subs;
-   my $linearized_isa = mro::get_linear_isa($class);
-
-   for my $isa_class ( @$linearized_isa ) {
-      unshift @build_subs, *{ _glob_for "${isa_class}::BUILD" }{CODE};
-   }
-   my @args = %$args;
-   for my $sub (grep { defined($_) && exists &$_ } @build_subs) {
-      $sub->( $self, @args);
-   }
-   return $self;
-}
-
-sub BUILDARGS {
-   shift; # No need for the classname
-   if ( @_ == 1 && ref($_[0]) ) {
-      Carp::confess("Single parameters to new() must be a HASH ref, not $_[0]")
-         unless ref($_[0]) eq ref({});
-      return {%{$_[0]}} # We want a new reference, always
-   }
-   else {
-      return { @_ };
-   }
-}
-
-sub meta {
-   my $class = shift;
-   $class    = Scalar::Util::blessed($class) || $class;
-   return Lmo::Meta->new(class => $class);
-}
-
-1;
-}
-# ###########################################################################
-# End Lmo::Object package
-# ###########################################################################
-
-# ###########################################################################
-# Lmo::Types package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Lmo/Types.pm
-#   t/lib/Lmo/Types.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Lmo::Types;
-
-use strict;
-use warnings qw( FATAL all );
-
-use Carp ();
-use Scalar::Util qw(looks_like_number blessed);
-
-
-our %TYPES = (
-   Bool   => sub { !$_[0] || (defined $_[0] && looks_like_number($_[0]) && $_[0] == 1) },
-   Num    => sub { defined $_[0] && looks_like_number($_[0]) },
-   Int    => sub { defined $_[0] && looks_like_number($_[0]) && $_[0] == int($_[0]) },
-   Str    => sub { defined $_[0] },
-   Object => sub { defined $_[0] && blessed($_[0]) },
-   FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
-
-   map {
-      my $type = /R/ ? $_ : uc $_;
-      $_ . "Ref" => sub { ref $_[0] eq $type }
-   } qw(Array Code Hash Regexp Glob Scalar)
-);
-
-sub check_type_constraints {
-   my ($attribute, $type_check, $check_name, $val) = @_;
-   ( ref($type_check) eq 'CODE'
-      ? $type_check->($val)
-      : (ref $val eq $type_check
-         || ($val && $val eq $type_check)
-         || (exists $TYPES{$type_check} && $TYPES{$type_check}->($val)))
-   )
-   || Carp::confess(
-        qq<Attribute ($attribute) does not pass the type constraint because: >
-      . qq<Validation failed for '$check_name' with value >
-      . (defined $val ? Lmo::Dumper($val) : 'undef') )
-}
-
-sub _nested_constraints {
-   my ($attribute, $aggregate_type, $type) = @_;
-
-   my $inner_types;
-   if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
-      $inner_types = _nested_constraints($1, $2);
-   }
-   else {
-      $inner_types = $TYPES{$type};
-   }
-
-   if ( $aggregate_type eq 'ArrayRef' ) {
-      return sub {
-         my ($val) = @_;
-         return unless ref($val) eq ref([]);
-
-         if ($inner_types) {
-            for my $value ( @{$val} ) {
-               return unless $inner_types->($value)
-            }
-         }
-         else {
-            for my $value ( @{$val} ) {
-               return unless $value && ($value eq $type
-                        || (Scalar::Util::blessed($value) && $value->isa($type)));
-            }
-         }
-         return 1;
-      };
-   }
-   elsif ( $aggregate_type eq 'Maybe' ) {
-      return sub {
-         my ($value) = @_;
-         return 1 if ! defined($value);
-         if ($inner_types) {
-            return unless $inner_types->($value)
-         }
-         else {
-            return unless $value eq $type
-                        || (Scalar::Util::blessed($value) && $value->isa($type));
-         }
-         return 1;
-      }
-   }
-   else {
-      Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe");
-   }
-}
-
-1;
-}
-# ###########################################################################
-# End Lmo::Types package
-# ###########################################################################
-
-# ###########################################################################
-# Lmo package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Lmo.pm
-#   t/lib/Lmo.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-BEGIN {
-$INC{"Lmo.pm"} = __FILE__;
-package Lmo;
-our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo.
-
-
-use strict;
-use warnings qw( FATAL all );
-
-use Carp ();
-use Scalar::Util qw(looks_like_number blessed);
-
-use Lmo::Meta;
-use Lmo::Object;
-use Lmo::Types;
-
-use Lmo::Utils;
-
-my %export_for;
-sub import {
-   warnings->import(qw(FATAL all));
-   strict->import();
-
-   my $caller     = scalar caller(); # Caller's package
-   my %exports = (
-      extends  => \&extends,
-      has      => \&has,
-      with     => \&with,
-      override => \&override,
-      confess  => \&Carp::confess,
-   );
-
-   $export_for{$caller} = \%exports;
-
-   for my $keyword ( keys %exports ) {
-      _install_coderef "${caller}::$keyword" => $exports{$keyword};
-   }
-
-   if ( !@{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] } ) {
-      @_ = "Lmo::Object";
-      goto *{ _glob_for "${caller}::extends" }{CODE};
-   }
-}
-
-sub extends {
-   my $caller = scalar caller();
-   for my $class ( @_ ) {
-      _load_module($class);
-   }
-   _set_package_isa($caller, @_);
-   _set_inherited_metadata($caller);
-}
-
-sub _load_module {
-   my ($class) = @_;
-
-   (my $file = $class) =~ s{::|'}{/}g;
-   $file .= '.pm';
-   { local $@; eval { require "$file" } } # or warn $@;
-   return;
-}
-
-sub with {
-   my $package = scalar caller();
-   require Role::Tiny;
-   for my $role ( @_ ) {
-      _load_module($role);
-      _role_attribute_metadata($package, $role);
-   }
-   Role::Tiny->apply_roles_to_package($package, @_);
-}
-
-sub _role_attribute_metadata {
-   my ($package, $role) = @_;
-
-   my $package_meta = Lmo::Meta->metadata_for($package);
-   my $role_meta    = Lmo::Meta->metadata_for($role);
-
-   %$package_meta = (%$role_meta, %$package_meta);
-}
-
-sub has {
-   my $names  = shift;
-   my $caller = scalar caller();
-
-   my $class_metadata = Lmo::Meta->metadata_for($caller);
-
-   for my $attribute ( ref $names ? @$names : $names ) {
-      my %args   = @_;
-      my $method = ($args{is} || '') eq 'ro'
-         ? sub {
-            Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller}::${attribute}")
-               if $#_;
-            return $_[0]{$attribute};
-         }
-         : sub {
-            return $#_
-                  ? $_[0]{$attribute} = $_[1]
-                  : $_[0]{$attribute};
-         };
-
-      $class_metadata->{$attribute} = ();
-
-      if ( my $type_check = $args{isa} ) {
-         my $check_name = $type_check;
-
-         if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
-            $type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type);
-         }
-
-         my $check_sub = sub {
-            my ($new_val) = @_;
-            Lmo::Types::check_type_constraints($attribute, $type_check, $check_name, $new_val);
-         };
-
-         $class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
-         my $orig_method = $method;
-         $method = sub {
-            $check_sub->($_[1]) if $#_;
-            goto &$orig_method;
-         };
-      }
-
-      if ( my $builder = $args{builder} ) {
-         my $original_method = $method;
-         $method = sub {
-               $#_
-                  ? goto &$original_method
-                  : ! exists $_[0]{$attribute}
-                     ? $_[0]{$attribute} = $_[0]->$builder
-                     : goto &$original_method
-         };
-      }
-
-      if ( my $code = $args{default} ) {
-         Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef")
-               unless ref($code) eq 'CODE';
-         my $original_method = $method;
-         $method = sub {
-               $#_
-                  ? goto &$original_method
-                  : ! exists $_[0]{$attribute}
-                     ? $_[0]{$attribute} = $_[0]->$code
-                     : goto &$original_method
-         };
-      }
-
-      if ( my $role = $args{does} ) {
-         my $original_method = $method;
-         $method = sub {
-            if ( $#_ ) {
-               Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
-                  unless Scalar::Util::blessed($_[1]) && eval { $_[1]->does($role) }
-            }
-            goto &$original_method
-         };
-      }
-
-      if ( my $coercion = $args{coerce} ) {
-         $class_metadata->{$attribute}{coerce} = $coercion;
-         my $original_method = $method;
-         $method = sub {
-            if ( $#_ ) {
-               return $original_method->($_[0], $coercion->($_[1]))
-            }
-            goto &$original_method;
-         }
-      }
-
-      _install_coderef "${caller}::$attribute" => $method;
-
-      if ( $args{required} ) {
-         $class_metadata->{$attribute}{required} = 1;
-      }
-
-      if ($args{clearer}) {
-         _install_coderef "${caller}::$args{clearer}"
-            => sub { delete shift->{$attribute} }
-      }
-
-      if ($args{predicate}) {
-         _install_coderef "${caller}::$args{predicate}"
-            => sub { exists shift->{$attribute} }
-      }
-
-      if ($args{handles}) {
-         _has_handles($caller, $attribute, \%args);
-      }
-
-      if (exists $args{init_arg}) {
-         $class_metadata->{$attribute}{init_arg} = $args{init_arg};
-      }
-   }
-}
-
-sub _has_handles {
-   my ($caller, $attribute, $args) = @_;
-   my $handles = $args->{handles};
-
-   my $ref = ref $handles;
-   my $kv;
-   if ( $ref eq ref [] ) {
-         $kv = { map { $_,$_ } @{$handles} };
-   }
-   elsif ( $ref eq ref {} ) {
-         $kv = $handles;
-   }
-   elsif ( $ref eq ref qr// ) {
-         Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)")
-            unless $args->{isa};
-         my $target_class = $args->{isa};
-         $kv = {
-            map   { $_, $_     }
-            grep  { $_ =~ $handles }
-            grep  { !exists $Lmo::Object::{$_} && $target_class->can($_) }
-            grep  { !$export_for{$target_class}->{$_} }
-            keys %{ _stash_for $target_class }
-         };
-   }
-   else {
-         Carp::confess("handles for $ref not yet implemented");
-   }
-
-   while ( my ($method, $target) = each %{$kv} ) {
-         my $name = _glob_for "${caller}::$method";
-         Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation")
-            if defined &$name;
-
-         my ($target, @curried_args) = ref($target) ? @$target : $target;
-         *$name = sub {
-            my $self        = shift;
-            my $delegate_to = $self->$attribute();
-            my $error = "Cannot delegate $method to $target because the value of $attribute";
-            Carp::confess("$error is not defined") unless $delegate_to;
-            Carp::confess("$error is not an object (got '$delegate_to')")
-               unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target));
-            return $delegate_to->$target(@curried_args, @_);
-         }
-   }
-}
-
-sub _set_package_isa {
-   my ($package, @new_isa) = @_;
-   my $package_isa  = \*{ _glob_for "${package}::ISA" };
-   @{*$package_isa} = @new_isa;
-}
-
-sub _set_inherited_metadata {
-   my $class = shift;
-   my $class_metadata = Lmo::Meta->metadata_for($class);
-   my $linearized_isa = mro::get_linear_isa($class);
-   my %new_metadata;
-
-   for my $isa_class (reverse @$linearized_isa) {
-      my $isa_metadata = Lmo::Meta->metadata_for($isa_class);
-      %new_metadata = (
-         %new_metadata,
-         %$isa_metadata,
-      );
-   }
-   %$class_metadata = %new_metadata;
-}
-
-sub unimport {
-   my $caller = scalar caller();
-   my $target = caller;
-  _unimport_coderefs($target, keys %{$export_for{$caller}});
-}
-
-sub Dumper {
-   require Data::Dumper;
-   local $Data::Dumper::Indent    = 0;
-   local $Data::Dumper::Sortkeys  = 0;
-   local $Data::Dumper::Quotekeys = 0;
-   local $Data::Dumper::Terse     = 1;
-
-   Data::Dumper::Dumper(@_)
-}
-
-BEGIN {
-   if ($] >= 5.010) {
-      { local $@; require mro; }
-   }
-   else {
-      local $@;
-      eval {
-         require MRO::Compat;
-      } or do {
-         *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub {
-            no strict 'refs';
-
-            my $classname = shift;
-
-            my @lin = ($classname);
-            my %stored;
-            foreach my $parent (@{"$classname\::ISA"}) {
-               my $plin = mro::get_linear_isa_dfs($parent);
-               foreach (@$plin) {
-                     next if exists $stored{$_};
-                     push(@lin, $_);
-                     $stored{$_} = 1;
-               }
-            }
-            return \@lin;
-         };
-      }
-   }
-}
-
-sub override {
-   my ($methods, $code) = @_;
-   my $caller          = scalar caller;
-
-   for my $method ( ref($methods) ? @$methods : $methods ) {
-      my $full_method     = "${caller}::${method}";
-      *{_glob_for $full_method} = $code;
-   }
-}
-
-}
-1;
-}
-# ###########################################################################
-# End Lmo package
-# ###########################################################################
-
-# ###########################################################################
-# VersionParser package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/VersionParser.pm
-#   t/lib/VersionParser.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package VersionParser;
-
-use Lmo;
-use Scalar::Util qw(blessed);
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use overload (
-   '""'     => "version",
-   '<=>'    => "cmp",
-   'cmp'    => "cmp",
-   fallback => 1,
-);
-
-use Carp ();
-
-has major => (
-    is       => 'ro',
-    isa      => 'Int',
-    required => 1,
-);
-
-has [qw( minor revision )] => (
-    is  => 'ro',
-    isa => 'Num',
-);
-
-has flavor => (
-    is      => 'ro',
-    isa     => 'Str',
-    default => sub { 'Unknown' },
-);
-
-has innodb_version => (
-    is      => 'ro',
-    isa     => 'Str',
-    default => sub { 'NO' },
-);
-
-sub series {
-   my $self = shift;
-   return $self->_join_version($self->major, $self->minor);
-}
-
-sub version {
-   my $self = shift;
-   return $self->_join_version($self->major, $self->minor, $self->revision);
-}
-
-sub is_in {
-   my ($self, $target) = @_;
-
-   return $self eq $target;
-}
-
-sub _join_version {
-    my ($self, @parts) = @_;
-
-    return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
-}
-sub _split_version {
-   my ($self, $str) = @_;
-   my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
-   return @version_parts[0..2];
-}
-
-sub normalized_version {
-   my ( $self ) = @_;
-   my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
-                                                      $self->minor,
-                                                      $self->revision);
-   PTDEBUG && _d($self->version, 'normalizes to', $result);
-   return $result;
-}
-
-sub comment {
-   my ( $self, $cmd ) = @_;
-   my $v = $self->normalized_version();
-
-   return "/*!$v $cmd */"
-}
-
-my @methods = qw(major minor revision);
-sub cmp {
-   my ($left, $right) = @_;
-   my $right_obj = (blessed($right) && $right->isa(ref($left)))
-                   ? $right
-                   : ref($left)->new($right);
-
-   my $retval = 0;
-   for my $m ( @methods ) {
-      last unless defined($left->$m) && defined($right_obj->$m);
-      $retval = $left->$m <=> $right_obj->$m;
-      last if $retval;
-   }
-   return $retval;
-}
-
-sub BUILDARGS {
-   my $self = shift;
-
-   if ( @_ == 1 ) {
-      my %args;
-      if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
-         PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
-         my $dbh = $_[0];
-         local $dbh->{FetchHashKeyName} = 'NAME_lc';
-         my $query = eval {
-            $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
-         };
-         if ( $query ) {
-            $query = { map { $_->{variable_name} => $_->{value} } @$query };
-            @args{@methods} = $self->_split_version($query->{version});
-            $args{flavor} = delete $query->{version_comment}
-                  if $query->{version_comment};
-         }
-         elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
-            @args{@methods} = $self->_split_version($query);
-         }
-         else {
-            Carp::confess("Couldn't get the version from the dbh while "
-                        . "creating a VersionParser object: $@");
-         }
-         $args{innodb_version} = eval { $self->_innodb_version($dbh) };
-      }
-      elsif ( !ref($_[0]) ) {
-         @args{@methods} = $self->_split_version($_[0]);
-      }
-
-      for my $method (@methods) {
-         delete $args{$method} unless defined $args{$method};
-      }
-      @_ = %args if %args;
-   }
-
-   return $self->SUPER::BUILDARGS(@_);
-}
-
-sub _innodb_version {
-   my ( $self, $dbh ) = @_;
-   return unless $dbh;
-   my $innodb_version = "NO";
-
-   my ($innodb) =
-      grep { $_->{engine} =~ m/InnoDB/i }
-      map  {
-         my %hash;
-         @hash{ map { lc $_ } keys %$_ } = values %$_;
-         \%hash;
-      }
-      @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
-   if ( $innodb ) {
-      PTDEBUG && _d("InnoDB support:", $innodb->{support});
-      if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
-         my $vars = $dbh->selectrow_hashref(
-            "SHOW VARIABLES LIKE 'innodb_version'");
-         $innodb_version = !$vars ? "BUILTIN"
-                         :          ($vars->{Value} || $vars->{value});
-      }
-      else {
-         $innodb_version = $innodb->{support};  # probably DISABLED or NO
-      }
-   }
-
-   PTDEBUG && _d("InnoDB version:", $innodb_version);
-   return $innodb_version;
-}
-
-sub _d {
-   my ($package, undef, $line) = caller 0;
-   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
-        map { defined $_ ? $_ : 'undef' }
-        @_;
-   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End VersionParser package
-# ###########################################################################
-
-# ###########################################################################
-# DSNParser package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/DSNParser.pm
-#   t/lib/DSNParser.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package DSNParser;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Data::Dumper;
-$Data::Dumper::Indent    = 0;
-$Data::Dumper::Quotekeys = 0;
-
-my $dsn_sep = qr/(?<!\\),/;
-
-eval {
-   require DBI;
-};
-my $have_dbi = $EVAL_ERROR ? 0 : 1;
-
-sub new {
-   my ( $class, %args ) = @_;
-   foreach my $arg ( qw(opts) ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my $self = {
-      opts => {}  # h, P, u, etc.  Should come from DSN OPTIONS section in POD.
-   };
-   foreach my $opt ( @{$args{opts}} ) {
-      if ( !$opt->{key} || !$opt->{desc} ) {
-         die "Invalid DSN option: ", Dumper($opt);
-      }
-      PTDEBUG && _d('DSN option:',
-         join(', ',
-            map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') }
-               keys %$opt
-         )
-      );
-      $self->{opts}->{$opt->{key}} = {
-         dsn  => $opt->{dsn},
-         desc => $opt->{desc},
-         copy => $opt->{copy} || 0,
-      };
-   }
-   return bless $self, $class;
-}
-
-sub prop {
-   my ( $self, $prop, $value ) = @_;
-   if ( @_ > 2 ) {
-      PTDEBUG && _d('Setting', $prop, 'property');
-      $self->{$prop} = $value;
-   }
-   return $self->{$prop};
-}
-
-sub parse {
-   my ( $self, $dsn, $prev, $defaults ) = @_;
-   if ( !$dsn ) {
-      PTDEBUG && _d('No DSN to parse');
-      return;
-   }
-   PTDEBUG && _d('Parsing', $dsn);
-   $prev     ||= {};
-   $defaults ||= {};
-   my %given_props;
-   my %final_props;
-   my $opts = $self->{opts};
-
-   foreach my $dsn_part ( split($dsn_sep, $dsn) ) {
-      $dsn_part =~ s/\\,/,/g;
-      if ( my ($prop_key, $prop_val) = $dsn_part =~  m/^(.)=(.*)$/ ) {
-         $given_props{$prop_key} = $prop_val;
-      }
-      else {
-         PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part);
-         $given_props{h} = $dsn_part;
-      }
-   }
-
-   foreach my $key ( keys %$opts ) {
-      PTDEBUG && _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};
-         PTDEBUG && _d('Copying value for', $key, 'from previous DSN');
-      }
-      if ( !defined $final_props{$key} ) {
-         $final_props{$key} = $defaults->{$key};
-         PTDEBUG && _d('Copying value for', $key, 'from defaults');
-      }
-   }
-
-   foreach my $key ( keys %given_props ) {
-      die "Unknown DSN option '$key' in '$dsn'.  For more details, "
-            . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
-            . "for complete documentation."
-         unless exists $opts->{$key};
-   }
-   if ( (my $required = $self->prop('required')) ) {
-      foreach my $key ( keys %$required ) {
-         die "Missing required DSN option '$key' in '$dsn'.  For more details, "
-               . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
-               . "for complete documentation."
-            unless $final_props{$key};
-      }
-   }
-
-   return \%final_props;
-}
-
-sub parse_options {
-   my ( $self, $o ) = @_;
-   die 'I need an OptionParser object' unless ref $o eq 'OptionParser';
-   my $dsn_string
-      = join(',',
-          map  { "$_=".$o->get($_); }
-          grep { $o->has($_) && $o->get($_) }
-          keys %{$self->{opts}}
-        );
-   PTDEBUG && _d('DSN string made from options:', $dsn_string);
-   return $self->parse($dsn_string);
-}
-
-sub as_string {
-   my ( $self, $dsn, $props ) = @_;
-   return $dsn unless ref $dsn;
-   my @keys = $props ? @$props : sort keys %$dsn;
-   return join(',',
-      map  { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) }
-      grep {
-         exists $self->{opts}->{$_}
-         && exists $dsn->{$_}
-         && defined $dsn->{$_}
-      } @keys);
-}
-
-sub usage {
-   my ( $self ) = @_;
-   my $usage
-      = "DSN syntax is key=value[,key=value...]  Allowable DSN keys:\n\n"
-      . "  KEY  COPY  MEANING\n"
-      . "  ===  ====  =============================================\n";
-   my %opts = %{$self->{opts}};
-   foreach my $key ( sort keys %opts ) {
-      $usage .= "  $key    "
-             .  ($opts{$key}->{copy} ? 'yes   ' : 'no    ')
-             .  ($opts{$key}->{desc} || '[No description]')
-             . "\n";
-   }
-   $usage .= "\n  If the DSN is a bareword, the word is treated as the 'h' key.\n";
-   return $usage;
-}
-
-sub get_cxn_params {
-   my ( $self, $info ) = @_;
-   my $dsn;
-   my %opts = %{$self->{opts}};
-   my $driver = $self->prop('dbidriver') || '';
-   if ( $driver eq 'Pg' ) {
-      $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';'
-         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
-                     grep { defined $info->{$_} }
-                     qw(h P));
-   }
-   else {
-      $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';'
-         . join(';', map  { "$opts{$_}->{dsn}=$info->{$_}" }
-                     grep { defined $info->{$_} }
-                     qw(F h P S A s))
-         . ';mysql_read_default_group=client'
-         . ($info->{L} ? ';mysql_local_infile=1' : '');
-   }
-   PTDEBUG && _d($dsn);
-   return ($dsn, $info->{u}, $info->{p});
-}
-
-sub fill_in_dsn {
-   my ( $self, $dbh, $dsn ) = @_;
-   my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name');
-   my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()');
-   $user =~ s/@.*//;
-   $dsn->{h} ||= $vars->{hostname}->{Value};
-   $dsn->{S} ||= $vars->{'socket'}->{Value};
-   $dsn->{P} ||= $vars->{port}->{Value};
-   $dsn->{u} ||= $user;
-   $dsn->{D} ||= $db;
-}
-
-sub get_dbh {
-   my ( $self, $cxn_string, $user, $pass, $opts ) = @_;
-   $opts ||= {};
-   my $defaults = {
-      AutoCommit         => 0,
-      RaiseError         => 1,
-      PrintError         => 0,
-      ShowErrorStatement => 1,
-      mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0),
-   };
-   @{$defaults}{ keys %$opts } = values %$opts;
-   if (delete $defaults->{L}) { # L for LOAD DATA LOCAL INFILE, our own extension
-      $defaults->{mysql_local_infile} = 1;
-   }
-
-   if ( $opts->{mysql_use_result} ) {
-      $defaults->{mysql_use_result} = 1;
-   }
-
-   if ( !$have_dbi ) {
-      die "Cannot connect to MySQL because the Perl DBI module is not "
-         . "installed or not found.  Run 'perl -MDBI' to see the directories "
-         . "that Perl searches for DBI.  If DBI is not installed, try:\n"
-         . "  Debian/Ubuntu  apt-get install libdbi-perl\n"
-         . "  RHEL/CentOS    yum install perl-DBI\n"
-         . "  OpenSolaris    pkg install pkg:/SUNWpmdbi\n";
-
-   }
-
-   my $dbh;
-   my $tries = 2;
-   while ( !$dbh && $tries-- ) {
-      PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
-         join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
-
-      $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
-
-      if ( !$dbh && $EVAL_ERROR ) {
-         if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
-            die "Cannot connect to MySQL because the Perl DBD::mysql module is "
-               . "not installed or not found.  Run 'perl -MDBD::mysql' to see "
-               . "the directories that Perl searches for DBD::mysql.  If "
-               . "DBD::mysql is not installed, try:\n"
-               . "  Debian/Ubuntu  apt-get install libdbd-mysql-perl\n"
-               . "  RHEL/CentOS    yum install perl-DBD-MySQL\n"
-               . "  OpenSolaris    pkg install pkg:/SUNWapu13dbd-mysql\n";
-         }
-         elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
-            PTDEBUG && _d('Going to try again without utf8 support');
-            delete $defaults->{mysql_enable_utf8};
-         }
-         if ( !$tries ) {
-            die $EVAL_ERROR;
-         }
-      }
-   }
-
-   if ( $cxn_string =~ m/mysql/i ) {
-      my $sql;
-
-      my ($charset) = $cxn_string =~ m/charset=([\w]+)/;
-      if ( $charset ) {
-         $sql = qq{/*!40101 SET NAMES "$charset"*/};
-         PTDEBUG && _d($dbh, $sql);
-         eval { $dbh->do($sql) };
-         if ( $EVAL_ERROR ) {
-            die "Error setting NAMES to $charset: $EVAL_ERROR";
-         }
-      }
-      else {
-         my ($mysql_version) = eval { $dbh->selectrow_array('SELECT VERSION()') };
-         if ( $EVAL_ERROR ) {
-            die "Cannot get MySQL version: $EVAL_ERROR";
-         }
-         my (undef, $character_set_server) = eval { $dbh->selectrow_array("SHOW VARIABLES LIKE 'character_set_server'") };
-         if ( $EVAL_ERROR ) {
-            die "Cannot get MySQL var character_set_server: $EVAL_ERROR";
-         }
-
-         if ( $mysql_version =~ m/^(\d+)\.(\d)\.(\d+).*/ ) {
-            if ( $1 >= 8 && $character_set_server =~ m/^utf8/ ) {
-               $dbh->{mysql_enable_utf8} = 1;
-               $charset = $character_set_server;
-               my $msg = "MySQL version $mysql_version >= 8 and character_set_server = $character_set_server\n".
-                        "Setting: SET NAMES $character_set_server";
-               PTDEBUG && _d($msg);
-               eval { $dbh->do("SET NAMES '$character_set_server'") };
-               if ( $EVAL_ERROR ) {
-                  die "Cannot SET NAMES $character_set_server: $EVAL_ERROR";
-               }
-            }
-         }
-      }
-      PTDEBUG && _d('Enabling charset for STDOUT');
-      if ( $charset && $charset =~ m/^utf8/ ) {
-         binmode(STDOUT, ':utf8')
-            or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
-         binmode(STDERR, ':utf8')
-            or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
-      }
-      else {
-         binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
-      }
-
-      if ( my $vars = $self->prop('set-vars') ) {
-         $self->set_vars($dbh, $vars);
-      }
-
-      $sql = 'SELECT @@SQL_MODE';
-      PTDEBUG && _d($dbh, $sql);
-      my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
-      if ( $EVAL_ERROR ) {
-         die "Error getting the current SQL_MODE: $EVAL_ERROR";
-      }
-
-      $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
-            . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
-            . ($sql_mode ? ",$sql_mode" : '')
-            . '\'*/';
-      PTDEBUG && _d($dbh, $sql);
-      eval { $dbh->do($sql) };
-      if ( $EVAL_ERROR ) {
-         die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
-           . ($sql_mode ? " and $sql_mode" : '')
-           . ": $EVAL_ERROR";
-      }
-   }
-
-   PTDEBUG && _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 ) = @_;
-   PTDEBUG && $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 set_vars {
-   my ($self, $dbh, $vars) = @_;
-
-   return unless $vars;
-
-   foreach my $var ( sort keys %$vars ) {
-      my $val = $vars->{$var}->{val};
-
-      (my $quoted_var = $var) =~ s/_/\\_/;
-      my ($var_exists, $current_val);
-      eval {
-         ($var_exists, $current_val) = $dbh->selectrow_array(
-            "SHOW VARIABLES LIKE '$quoted_var'");
-      };
-      my $e = $EVAL_ERROR;
-      if ( $e ) {
-         PTDEBUG && _d($e);
-      }
-
-      if ( $vars->{$var}->{default} && !$var_exists ) {
-         PTDEBUG && _d('Not setting default var', $var,
-            'because it does not exist');
-         next;
-      }
-
-      if ( $current_val && $current_val eq $val ) {
-         PTDEBUG && _d('Not setting var', $var, 'because its value',
-            'is already', $val);
-         next;
-      }
-
-      my $sql = "SET SESSION $var=$val";
-      PTDEBUG && _d($dbh, $sql);
-      eval { $dbh->do($sql) };
-      if ( my $set_error = $EVAL_ERROR ) {
-         chomp($set_error);
-         $set_error =~ s/ at \S+ line \d+//;
-         my $msg = "Error setting $var: $set_error";
-         if ( $current_val ) {
-            $msg .= "  The current value for $var is $current_val.  "
-                  . "If the variable is read only (not dynamic), specify "
-                  . "--set-vars $var=$current_val to avoid this warning, "
-                  . "else manually set the variable and restart MySQL.";
-         }
-         warn $msg . "\n\n";
-      }
-   }
-
-   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 DSNParser package
-# ###########################################################################
-
-# ###########################################################################
-# MasterSlave package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/MasterSlave.pm
-#   t/lib/MasterSlave.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package MasterSlave;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-sub check_recursion_method {
-   my ($methods) = @_;
-   if ( @$methods != 1 ) {
-      if ( grep({ !m/processlist|hosts/i } @$methods)
-            && $methods->[0] !~ /^dsn=/i )
-      {
-         die  "Invalid combination of recursion methods: "
-            . join(", ", map { defined($_) ? $_ : 'undef' } @$methods) . ". "
-            . "Only hosts and processlist may be combined.\n"
-      }
-   }
-   else {
-      my ($method) = @$methods;
-      die "Invalid recursion method: " . ( $method || 'undef' )
-         unless $method && $method =~ m/^(?:processlist$|hosts$|none$|cluster$|dsn=)/i;
-   }
-}
-
-sub new {
-   my ( $class, %args ) = @_;
-   my @required_args = qw(OptionParser DSNParser Quoter);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my $self = {
-      %args,
-      replication_thread => {},
-   };
-   return bless $self, $class;
-}
-
-sub get_replicas {
-   my ($self, %args) = @_;
-   my @required_args = qw(make_cxn);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($make_cxn) = @args{@required_args};
-
-   my $replicas  = [];
-   my $dp      = $self->{DSNParser};
-   my $methods = $self->_resolve_recursion_methods($args{dsn});
-
-   return $replicas unless @$methods;
-
-   if ( grep { m/processlist|hosts/i } @$methods ) {
-      my @required_args = qw(dbh dsn);
-      foreach my $arg ( @required_args ) {
-         die "I need a $arg argument" unless $args{$arg};
-      }
-      my ($dbh, $dsn) = @args{@required_args};
-      my $o = $self->{OptionParser};
-
-      $self->recurse_to_replicas(
-         {  dbh              => $dbh,
-            dsn              => $dsn,
-            replica_user     => $o->got('replica-user') ? $o->get('replica-user') : '',
-            replica_password => $o->got('replica-password') ? $o->get('replica-password') : '',
-            replicas         => $args{replicas},
-            callback  => sub {
-               my ( $dsn, $dbh, $level, $parent ) = @_;
-               return unless $level;
-               PTDEBUG && _d('Found replica:', $dp->as_string($dsn));
-               my $replica_dsn = $dsn;
-               if ($o->got('replica-user')) {
-                  $replica_dsn->{u} = $o->get('replica-user');
-                  PTDEBUG && _d("Using replica user ".$o->get('replica-user')." on ".$replica_dsn->{h}.":".$replica_dsn->{P});
-               }
-               if ($o->got('replica-password')) {
-                  $replica_dsn->{p} = $o->get('replica-password');
-                  PTDEBUG && _d("Replica password set");
-               }
-               push @$replicas, $make_cxn->(dsn => $replica_dsn, dbh => $dbh, parent => $parent);
-               return;
-            },
-            wait_no_die => $args{'wait_no_die'},
-         }
-      );
-   } elsif ( $methods->[0] =~ m/^dsn=/i ) {
-      (my $dsn_table_dsn = join ",", @$methods) =~ s/^dsn=//i;
-      $replicas = $self->get_cxn_from_dsn_table(
-         %args,
-         dsn_table_dsn => $dsn_table_dsn,
-         wait_no_die => $args{'wait_no_die'},
-      );
-   }
-   elsif ( $methods->[0] =~ m/none/i ) {
-      PTDEBUG && _d('Not getting to replicas');
-   }
-   else {
-      die "Unexpected recursion methods: @$methods";
-   }
-
-   return $replicas;
-}
-
-sub _resolve_recursion_methods {
-   my ($self, $dsn) = @_;
-   my $o = $self->{OptionParser};
-   if ( $o->got('recursion-method') ) {
-      return $o->get('recursion-method');
-   }
-   elsif ( $dsn && ($dsn->{P} || 3306) != 3306 ) {
-      PTDEBUG && _d('Port number is non-standard; using only hosts method');
-      return [qw(hosts)];
-   }
-   else {
-      return $o->get('recursion-method');
-   }
-}
-
-sub recurse_to_replicas {
-   my ( $self, $args, $level ) = @_;
-   $level ||= 0;
-   my $dp = $self->{DSNParser};
-   my $recurse = $args->{recurse} || $self->{OptionParser}->get('recurse');
-   my $dsn = $args->{dsn};
-   my $replica_user = $args->{replica_user} || '';
-   my $replica_password = $args->{replica_password} || '';
-
-   my $methods = $self->_resolve_recursion_methods($dsn);
-   PTDEBUG && _d('Recursion methods:', @$methods);
-   if ( lc($methods->[0]) eq 'none' ) {
-      PTDEBUG && _d('Not recursing to replicas');
-      return;
-   }
-
-   my $replica_dsn = $dsn;
-   if ($replica_user) {
-      $replica_dsn->{u} = $replica_user;
-      PTDEBUG && _d("Using replica user $replica_user on "
-         . $replica_dsn->{h} . ":" . ( $replica_dsn->{P} ? $replica_dsn->{P} : ""));
-   }
-   if ($replica_password) {
-      $replica_dsn->{p} = $replica_password;
-      PTDEBUG && _d("Replica password set");
-   }
-
-   my $dbh = $args->{dbh};
-
-   my $get_dbh = sub {
-         eval {
-            $dbh = $dp->get_dbh(
-               $dp->get_cxn_params($replica_dsn), { AutoCommit => 1 }
-            );
-            PTDEBUG && _d('Connected to', $dp->as_string($replica_dsn));
-         };
-         if ( $EVAL_ERROR ) {
-            print STDERR "Cannot connect to ", $dp->as_string($replica_dsn), ": ", $EVAL_ERROR, "\n"
-               or die "Cannot print: $OS_ERROR";
-            return;
-         }
-   };
-
-   DBH: {
-      if ( !defined $dbh ) {
-         foreach my $known_replica ( @{$args->{replicas}} ) {
-            if ($known_replica->{dsn}->{h} eq $replica_dsn->{h} and
-                $known_replica->{dsn}->{P} eq $replica_dsn->{P} ) {
-               $dbh = $known_replica->{dbh};
-               last DBH;
-            }
-         }
-         $get_dbh->();
-      }
-   }
-
-   my $sql  = 'SELECT @@SERVER_ID';
-   PTDEBUG && _d($sql);
-   my $id = undef;
-   do {
-      eval {
-         ($id) = $dbh->selectrow_array($sql);
-      };
-	   if ( $EVAL_ERROR ) {
-		   if ( $args->{wait_no_die} ) {
-			   print STDERR "Error getting server id: ", $EVAL_ERROR,
-               "\nRetrying query for server ", $replica_dsn->{h}, ":", $replica_dsn->{P}, "\n";
-            sleep 1;
-            $dbh->disconnect();
-            $get_dbh->();
-         } else {
-            die $EVAL_ERROR;
-         }
-      }
-   } until (defined $id);
-   PTDEBUG && _d('Working on server ID', $id);
-   my $source_thinks_i_am = $dsn->{server_id};
-   if ( !defined $id
-       || ( defined $source_thinks_i_am && $source_thinks_i_am != $id )
-       || $args->{server_ids_seen}->{$id}++
-   ) {
-      PTDEBUG && _d('Server ID seen, or not what source said');
-      if ( $args->{skip_callback} ) {
-         $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent});
-      }
-      return;
-   }
-
-   $args->{callback}->($dsn, $dbh, $level, $args->{parent});
-
-   if ( !defined $recurse || $level < $recurse ) {
-
-      my @replicas =
-         grep { !$_->{source_id} || $_->{source_id} == $id } # Only my replicas.
-         $self->find_replica_hosts($dp, $dbh, $dsn, $methods);
-
-      foreach my $replica ( @replicas ) {
-         PTDEBUG && _d('Recursing from',
-            $dp->as_string($dsn), 'to', $dp->as_string($replica));
-         $self->recurse_to_replicas(
-            { %$args, dsn => $replica, dbh => undef, parent => $dsn, replica_user => $replica_user, $replica_password => $replica_password }, $level + 1 );
-      }
-   }
-}
-
-sub find_replica_hosts {
-   my ( $self, $dsn_parser, $dbh, $dsn, $methods ) = @_;
-
-   PTDEBUG && _d('Looking for replicas on', $dsn_parser->as_string($dsn),
-      'using methods', @$methods);
-
-   my @replicas;
-   METHOD:
-   foreach my $method ( @$methods ) {
-      my $find_replicas = "_find_replicas_by_$method";
-      PTDEBUG && _d('Finding replicas with', $find_replicas);
-      @replicas = $self->$find_replicas($dsn_parser, $dbh, $dsn);
-      last METHOD if @replicas;
-   }
-
-   PTDEBUG && _d('Found', scalar(@replicas), 'replicas');
-   return @replicas;
-}
-
-sub _find_replicas_by_processlist {
-   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
-   my @connected_replicas = $self->get_connected_replicas($dbh);
-   my @replicas = $self->_process_replicas_list($dsn_parser, $dsn, \@connected_replicas);
-   return @replicas;
-}
-
-sub _process_replicas_list {
-   my ($self, $dsn_parser, $dsn, $connected_replicas) = @_;
-   my @replicas = map  {
-      my $replica        = $dsn_parser->parse("h=$_", $dsn);
-      $replica->{source} = 'processlist';
-      $replica;
-   }
-   grep { $_ }
-   map  {
-      my ( $host ) = $_->{host} =~ m/^(.*):\d+$/;
-      if ( $host eq 'localhost' ) {
-         $host = '127.0.0.1'; # Replication never uses sockets.
-      }
-      if ($host =~ m/::/) {
-          $host = '['.$host.']';
-      }
-      $host;
-   } @$connected_replicas;
-
-   return @replicas;
-}
-
-sub _find_replicas_by_hosts {
-   my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
-
-   my @replicas;
-
-   my $vp = VersionParser->new($dbh);
-   my $sql = 'SHOW REPLICAS';
-   my $source_name = 'source';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $sql = 'SHOW SLAVE HOSTS';
-      $source_name='master';
-   }
-   
-   PTDEBUG && _d($dbh, $sql);
-   @replicas = @{$dbh->selectall_arrayref($sql, { Slice => {} })};
-
-   if ( @replicas ) {
-      PTDEBUG && _d('Found some SHOW REPLICAS info');
-      @replicas = 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->{source_id} = $hash{"${source_name}_id"};
-         $dsn->{source}    = 'hosts';
-         $dsn;
-      } @replicas;
-   }
-
-   return @replicas;
-}
-
-sub get_connected_replicas {
-   my ( $self, $dbh ) = @_;
-
-   my $show = "SHOW GRANTS FOR ";
-   my $user = 'CURRENT_USER()';
-   my $sql = $show . $user;
-   PTDEBUG && _d($dbh, $sql);
-
-   my $proc;
-   eval {
-      $proc = grep {
-         m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
-      } @{$dbh->selectcol_arrayref($sql)};
-   };
-   if ( $EVAL_ERROR ) {
-
-      if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) {
-         PTDEBUG && _d('Retrying SHOW GRANTS without host; error:',
-            $EVAL_ERROR);
-         ($user) = split('@', $user);
-         $sql    = $show . $user;
-         PTDEBUG && _d($sql);
-         eval {
-            $proc = grep {
-               m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
-            } @{$dbh->selectcol_arrayref($sql)};
-         };
-      }
-
-      die "Failed to $sql: $EVAL_ERROR" if $EVAL_ERROR;
-   }
-   if ( !$proc ) {
-      die "You do not have the PROCESS privilege";
-   }
-
-   $sql = 'SHOW FULL PROCESSLIST';
-   PTDEBUG && _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_source_of {
-   my ( $self, $source, $replica ) = @_;
-
-   my $replica_version = VersionParser->new($replica);
-   my $source_name = 'source';
-   my $source_port = 'source_port';
-   if ( $replica_version < '8.1' || $replica_version->flavor() =~ m/maria/ ) {
-      $source_name = 'master';
-      $source_port = 'master_port';
-   }
-
-   my $source_status = $self->get_source_status($source)
-      or die "The server specified as a source is not a source";
-   my $replica_status  = $self->get_replica_status($replica)
-      or die "The server specified as a replica is not a replica";
-   my @connected     = $self->get_connected_replicas($source)
-      or die "The server specified as a source has no connected replicas";
-   my (undef, $port) = $source->selectrow_array("SHOW VARIABLES LIKE 'port'");
-
-   if ( $port != $replica_status->{$source_port} ) {
-      die "The replica is connected to $replica_status->{$source_port} "
-         . "but the source's port is $port";
-   }
-
-   if ( !grep { $replica_status->{"${source_name}_user"} eq $_->{user} } @connected ) {
-      die "I don't see any replica I/O thread connected with user "
-         . $replica_status->{"${source_name}_user"};
-   }
-
-   if ( ($replica_status->{replica_io_state} || '')
-      eq 'Waiting for ${source_name} to send event' )
-   {
-      my ( $source_log_name, $source_log_num )
-         = $source_status->{file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
-      my ( $replica_log_name, $replica_log_num )
-         = $replica_status->{source_log_file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
-      if ( $source_log_name ne $replica_log_name
-         || abs($source_log_num - $replica_log_num) > 1 )
-      {
-         die "The replica thinks it is reading from "
-            . "$replica_status->{source_log_file},  but the "
-            . "source is writing to $source_status->{file}";
-      }
-   }
-   return 1;
-}
-
-sub get_source_dsn {
-   my ( $self, $dbh, $dsn, $dsn_parser ) = @_;
-
-   my $vp = VersionParser->new($dbh);
-   my $source_host = 'source_host';
-   my $source_port = 'source_port';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_host = 'master_host';
-      $source_port = 'master_port';
-   }
-
-   my $source = $self->get_replica_status($dbh) or return undef;
-   my $spec   = "h=$source->{${source_host}},P=$source->{${source_port}}";
-   return       $dsn_parser->parse($spec, $dsn);
-}
-
-sub get_replica_status {
-   my ( $self, $dbh ) = @_;
-
-   my $server_version = VersionParser->new($dbh);
-   my $replica_name = 'replica';
-   if ( $server_version < '8.1' || $server_version->flavor() =~ m/maria/ ) {
-      $replica_name = 'slave';
-   }
-
-   if ( !$self->{not_a_replica}->{$dbh} ) {
-      my $sth = $self->{sths}->{$dbh}->{REPLICA_STATUS}
-            ||= $dbh->prepare("SHOW ${replica_name} STATUS");
-      PTDEBUG && _d($dbh, "SHOW ${replica_name} STATUS");
-      $sth->execute();
-      my ($sss_rows) = $sth->fetchall_arrayref({}); # Show Replica Status rows
-
-      my $ss;
-      if ( $sss_rows && @$sss_rows ) {
-          if (scalar @$sss_rows > 1) {
-              if (!$self->{channel}) {
-                  die 'This server returned more than one row for SHOW REPLICA STATUS but "channel" was not specified on the command line';
-              }
-              my $replica_use_channels;
-              for my $row (@$sss_rows) {
-                  $row = { map { lc($_) => $row->{$_} } keys %$row }; # lowercase the keys
-                  if ($row->{channel_name}) {
-                      $replica_use_channels = 1;
-                  }
-                  if ($row->{channel_name} eq $self->{channel}) {
-                      $ss = $row;
-                      last;
-                  }
-              }
-              if (!$ss && $replica_use_channels) {
-                 die 'This server is using replication channels but "channel" was not specified on the command line';
-              }
-          } else {
-              if ($sss_rows->[0]->{channel_name} && $sss_rows->[0]->{channel_name} ne $self->{channel}) {
-                  die 'This server is using replication channels but "channel" was not specified on the command line';
-              } else {
-                  $ss = $sss_rows->[0];
-              }
-          }
-
-          if ( $ss && %$ss ) {
-             $ss = { map { lc($_) => $ss->{$_} } keys %$ss }; # lowercase the keys
-             return $ss;
-          }
-          if (!$ss && $self->{channel}) {
-              die "Specified channel name is invalid";
-          }
-      }
-
-      PTDEBUG && _d('This server returns nothing for SHOW REPLICA STATUS');
-      $self->{not_a_replica}->{$dbh}++;
-  }
-}
-
-sub get_source_status {
-   my ( $self, $dbh ) = @_;
-
-   if ( $self->{not_a_source}->{$dbh} ) {
-      PTDEBUG && _d('Server on dbh', $dbh, 'is not a source');
-      return;
-   }
-
-   my $vp = VersionParser->new($dbh);
-   my $source_name = 'binary log';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_name = 'master';
-   }
-
-   my $sth;
-   if ( $self->{sths}->{$dbh} && $dbh && $self->{sths}->{$dbh} == $dbh ) {
-      $sth = $self->{sths}->{$dbh}->{SOURCE_STATUS}
-         ||= $dbh->prepare("SHOW ${source_name} STATUS");
-   }
-   else {
-      $sth = $dbh->prepare("SHOW ${source_name} STATUS");
-   }
-   PTDEBUG && _d($dbh, "SHOW ${source_name} STATUS");
-   $sth->execute();
-   my ($ms) = @{$sth->fetchall_arrayref({})};
-   PTDEBUG && _d(
-      $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
-          : '');
-
-   if ( !$ms || scalar keys %$ms < 2 ) {
-      PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a source');
-      $self->{not_a_source}->{$dbh}++;
-   }
-
-  return { map { lc($_) => $ms->{$_} } keys %$ms }; # lowercase the keys
-}
-
-sub wait_for_source {
-   my ( $self, %args ) = @_;
-   my @required_args = qw(source_status replica_dbh);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($source_status, $replica_dbh) = @args{@required_args};
-   my $timeout       = $args{timeout} || 60;
-
-   my $result;
-   my $waited;
-   if ( $source_status ) {
-      my $replica_status;
-      eval {
-          $replica_status = $self->get_replica_status($replica_dbh);
-      };
-      if ($EVAL_ERROR) {
-          return {
-              result => undef,
-              waited => 0,
-              error  =>'Wait for source: this is a multi-source replica but "channel" was not specified on the command line',
-          };
-      }
-      my $vp = VersionParser->new($replica_dbh);
-      my $source_name = 'source';
-      if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-         $source_name = 'master';
-      }
-      my $channel_sql = $vp > '5.6' && $self->{channel} ? ", '$self->{channel}'" : '';
-      my $sql = "SELECT ${source_name}_POS_WAIT('$source_status->{file}', $source_status->{position}, $timeout $channel_sql)";
-      PTDEBUG && _d($replica_dbh, $sql);
-      my $start = time;
-      ($result) = $replica_dbh->selectrow_array($sql);
-
-      $waited = time - $start;
-
-      PTDEBUG && _d('Result of waiting:', $result);
-      PTDEBUG && _d("Waited", $waited, "seconds");
-   }
-   else {
-      PTDEBUG && _d('Not waiting: this server is not a source');
-   }
-
-   return {
-      result => $result,
-      waited => $waited,
-   };
-}
-
-sub stop_replica {
-   my ( $self, $dbh ) = @_;
-   my $vp = VersionParser->new($dbh);
-   my $replica_name = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $replica_name = 'slave';
-   }
-   my $sth = $self->{sths}->{$dbh}->{STOP_REPLICA}
-         ||= $dbh->prepare("STOP ${replica_name}");
-   PTDEBUG && _d($dbh, $sth->{Statement});
-   $sth->execute();
-}
-
-sub start_replica {
-   my ( $self, $dbh, $pos ) = @_;
-
-   my $vp = VersionParser->new($dbh);
-   my $source_name = 'source';
-   my $replica_name = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_name = 'master';
-      $replica_name = 'slave';
-   }
-
-   if ( $pos ) {
-      my $sql = "START ${replica_name} UNTIL ${source_name}_LOG_FILE='$pos->{file}', "
-              . "${source_name}_LOG_POS=$pos->{position}";
-      PTDEBUG && _d($dbh, $sql);
-      $dbh->do($sql);
-   }
-   else {
-      my $sth = $self->{sths}->{$dbh}->{START_REPLICA}
-            ||= $dbh->prepare("START ${replica_name}");
-      PTDEBUG && _d($dbh, $sth->{Statement});
-      $sth->execute();
-   }
-}
-
-sub catchup_to_source {
-   my ( $self, $replica, $source, $timeout ) = @_;
-   $self->stop_replica($source);
-   $self->stop_replica($replica);
-   my $replica_status  = $self->get_replica_status($replica);
-   my $replica_pos     = $self->repl_posn($replica_status);
-   my $source_status = $self->get_source_status($source);
-   my $source_pos    = $self->repl_posn($source_status);
-   PTDEBUG && _d('Source position:', $self->pos_to_string($source_pos),
-      'Replica position:', $self->pos_to_string($replica_pos));
-
-   my $result;
-   if ( $self->pos_cmp($replica_pos, $source_pos) < 0 ) {
-      PTDEBUG && _d('Waiting for replica to catch up to source');
-      $self->start_replica($replica, $source_pos);
-
-      $result = $self->wait_for_source(
-            source_status => $source_status,
-            replica_dbh   => $replica,
-            timeout       => $timeout,
-            source_status => $source_status
-      );
-      if ($result->{error}) {
-          die $result->{error};
-      }
-      if ( !defined $result->{result} ) {
-         $replica_status = $self->get_replica_status($replica);
-            
-         my $vp = VersionParser->new($replica);
-         my $replica_name = 'replica';
-         if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-            $replica_name = 'slave';
-         }
-
-         if ( !$self->replica_is_running($replica_status, $replica_name) ) {
-            PTDEBUG && _d('Source position:',
-               $self->pos_to_string($source_pos),
-               'Replica position:', $self->pos_to_string($replica_pos));
-            $replica_pos = $self->repl_posn($replica_status);
-            if ( $self->pos_cmp($replica_pos, $source_pos) != 0 ) {
-               die "SOURCE_POS_WAIT() returned NULL but replica has not "
-                  . "caught up to source";
-            }
-            PTDEBUG && _d('Replica is caught up to source and stopped');
-         }
-         else {
-            die "Replica has not caught up to source and it is still running";
-         }
-      }
-   }
-   else {
-      PTDEBUG && _d("Replica is already caught up to source");
-   }
-
-   return $result;
-}
-
-sub catchup_to_same_pos {
-   my ( $self, $s1_dbh, $s2_dbh ) = @_;
-   $self->stop_replica($s1_dbh);
-   $self->stop_replica($s2_dbh);
-   my $s1_status = $self->get_replica_status($s1_dbh);
-   my $s2_status = $self->get_replica_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_replica($s1_dbh, $s2_pos);
-   }
-   elsif ( $self->pos_cmp($s2_pos, $s1_pos) < 0 ) {
-      $self->start_replica($s2_dbh, $s1_pos);
-   }
-
-   $s1_status = $self->get_replica_status($s1_dbh);
-   $s2_status = $self->get_replica_status($s2_dbh);
-   $s1_pos    = $self->repl_posn($s1_status);
-   $s2_pos    = $self->repl_posn($s2_status);
-
-   my $vp1 = VersionParser->new($s1_dbh);
-   my $replica1_name = 'replica';
-   if ( $vp1 < '8.1' || $vp1->flavor() =~ m/maria/ ) {
-      $replica1_name = 'slave';
-   }
-
-   my $vp2 = VersionParser->new($s2_dbh);
-   my $replica2_name = 'replica';
-   if ( $vp2 < '8.1' || $vp2->flavor() =~ m/maria/ ) {
-      $replica2_name = 'slave';
-   }
-
-   if ( $self->replica_is_running($s1_status, $replica1_name)
-     || $self->replica_is_running($s2_status, $replica2_name)
-     || $self->pos_cmp($s1_pos, $s2_pos) != 0)
-   {
-      die "The servers aren't both stopped at the same position";
-   }
-
-}
-
-sub replica_is_running {
-   my ( $self, $replica_status, $replica_name ) = @_;
-   return ($replica_status->{"${replica_name}_sql_running"} || 'No') eq 'Yes';
-}
-
-sub has_replica_updates {
-   my ( $self, $dbh ) = @_;
-   
-   my $vp = VersionParser->new($dbh);
-   my $replica_name = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $replica_name = 'slave';
-   }
-
-   my $sql = qq{SHOW VARIABLES LIKE 'log_${replica_name}_updates'};
-   PTDEBUG && _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},
-      };
-   }
-   elsif ( exists $status->{relay_source_log_file} && exists $status->{exec_source_log_pos} ) {
-      return {
-         file     => $status->{relay_source_log_file},
-         position => $status->{exec_source_log_pos},
-      };
-   }
-   else {
-      return {
-         file     => $status->{relay_master_log_file},
-         position => $status->{exec_master_log_pos},
-      };
-   }
-}
-
-sub get_replica_lag {
-   my ( $self, $dbh ) = @_;
-   
-   my $vp = VersionParser->new($dbh);
-   my $source_name = 'source';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_name = 'master';
-   }
-
-   my $stat = $self->get_replica_status($dbh);
-   return unless $stat;  # server is not a replica
-   return $stat->{"seconds_behind_${source_name}"};
-}
-
-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->{source_host} ) {
-      $host = $dsn->{source_host};
-      $port = $dsn->{source_port};
-   }
-   else {
-      $host = $dsn->{h};
-      $port = $dsn->{P};
-   }
-   return ($host || '[default]') . ( ($port || 3306) == 3306 ? '' : ":$port" );
-}
-
-sub is_replication_thread {
-   my ( $self, $query, %args ) = @_;
-   return unless $query;
-
-   my $type = lc($args{type} || 'all');
-   die "Invalid type: $type"
-      unless $type =~ m/^binlog_dump|slave_io|slave_sql|replica_io|replica_sql|all$/i;
-
-   my $match = 0;
-   if ( $type =~ m/binlog_dump|all/i ) {
-      $match = 1
-         if ($query->{Command} || $query->{command} || '') eq "Binlog Dump";
-   }
-   if ( !$match ) {
-      if ( ($query->{User} || $query->{user} || '') eq "system user" ) {
-         PTDEBUG && _d("Replica replication thread");
-         if ( $type ne 'all' ) {
-            my $state = $query->{State} || $query->{state} || '';
-
-            if ( $state =~ m/^init|end$/ ) {
-               PTDEBUG && _d("Special state:", $state);
-               $match = 1;
-            }
-            else {
-               my ($replica_sql) = $state =~ m/
-                  ^(Waiting\sfor\sthe\snext\sevent
-                   |Reading\sevent\sfrom\sthe\srelay\slog
-                   |Has\sread\sall\srelay\slog;\swaiting
-                   |Making\stemp\sfile
-                   |Waiting\sfor\sslave\smutex\son\sexit
-                   |Waiting\sfor\sreplica\smutex\son\sexit)/xi;
-
-               $match = $type eq 'replica_sql' &&  $replica_sql ? 1
-                      : $type eq 'replica_io'  && !$replica_sql ? 1
-                      :                                       0;
-            }
-         }
-         else {
-            $match = 1;
-         }
-      }
-      else {
-         PTDEBUG && _d('Not system user');
-      }
-
-      if ( !defined $args{check_known_ids} || $args{check_known_ids} ) {
-         my $id = $query->{Id} || $query->{id};
-         if ( $match ) {
-            $self->{replication_thread}->{$id} = 1;
-         }
-         else {
-            if ( $self->{replication_thread}->{$id} ) {
-               PTDEBUG && _d("Thread ID is a known replication thread ID");
-               $match = 1;
-            }
-         }
-      }
-   }
-
-   PTDEBUG && _d('Matches', $type, 'replication thread:',
-      ($match ? 'yes' : 'no'), '; match:', $match);
-
-   return $match;
-}
-
-
-sub get_replication_filters {
-   my ( $self, %args ) = @_;
-   my @required_args = qw(dbh);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($dbh) = @args{@required_args};
-
-   my $vp = VersionParser->new($dbh);
-   my $replica_name = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $replica_name = 'slave';
-   }
-
-   my %filters = ();
-
-   my $status = $self->get_source_status($dbh);
-   if ( $status ) {
-      map { $filters{$_} = $status->{$_} }
-      grep { defined $status->{$_} && $status->{$_} ne '' }
-      qw(
-         binlog_do_db
-         binlog_ignore_db
-      );
-   }
-
-   $status = $self->get_replica_status($dbh);
-   if ( $status ) {
-      map { $filters{$_} = $status->{$_} }
-      grep { defined $status->{$_} && $status->{$_} ne '' }
-      qw(
-         replicate_do_db
-         replicate_ignore_db
-         replicate_do_table
-         replicate_ignore_table
-         replicate_wild_do_table
-         replicate_wild_ignore_table
-      );
-
-      my $sql = "SHOW VARIABLES LIKE '${replica_name}_skip_errors'";
-      PTDEBUG && _d($dbh, $sql);
-      my $row = $dbh->selectrow_arrayref($sql);
-      $filters{replica_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF';
-   }
-
-   return \%filters;
-}
-
-
-sub pos_to_string {
-   my ( $self, $pos ) = @_;
-   my $fmt  = '%s/%020d';
-   return sprintf($fmt, @{$pos}{qw(file position)});
-}
-
-sub reset_known_replication_threads {
-   my ( $self ) = @_;
-   $self->{replication_thread} = {};
-   return;
-}
-
-sub get_cxn_from_dsn_table {
-   my ($self, %args) = @_;
-   my @required_args = qw(dsn_table_dsn make_cxn);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($dsn_table_dsn, $make_cxn) = @args{@required_args};
-   PTDEBUG && _d('DSN table DSN:', $dsn_table_dsn);
-
-   my $dp = $self->{DSNParser};
-   my $q  = $self->{Quoter};
-
-   my $dsn = $dp->parse($dsn_table_dsn);
-   my $dsn_table;
-   if ( $dsn->{D} && $dsn->{t} ) {
-      $dsn_table = $q->quote($dsn->{D}, $dsn->{t});
-   }
-   elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) {
-      $dsn_table = $q->quote($q->split_unquote($dsn->{t}));
-   }
-   else {
-      die "DSN table DSN does not specify a database (D) "
-        . "or a database-qualified table (t)";
-   }
-
-   my $done = 0;
-   my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
-   my $dbh         = $dsn_tbl_cxn->connect();
-   my $sql         = "SELECT dsn FROM $dsn_table ORDER BY id";
-   PTDEBUG && _d($sql);
-   my @cxn;
-   use Data::Dumper;
-   DSN:
-   do {
-      @cxn = ();
-      my $dsn_strings = $dbh->selectcol_arrayref($sql);
-      if ( $dsn_strings ) {
-         foreach my $dsn_string ( @$dsn_strings ) {
-            PTDEBUG && _d('DSN from DSN table:', $dsn_string);
-            if ($args{wait_no_die}) {
-               my $lcxn;
-               eval {
-                  $lcxn = $make_cxn->(dsn_string => $dsn_string);
-               };
-               if ( $EVAL_ERROR && ($dsn_tbl_cxn->lost_connection($EVAL_ERROR)
-                     || $EVAL_ERROR =~ m/Can't connect to MySQL server/)) {
-                  PTDEBUG && _d("Server is not accessible, waiting when it is online again");
-                  sleep(1);
-                  goto DSN;
-               }
-               push @cxn, $lcxn;
-            } else {
-               push @cxn, $make_cxn->(dsn_string => $dsn_string);
-            }
-         }
-      }
-      $done = 1;
-   } until $done;
-   return \@cxn;
-}
-
-sub _d {
-   my ($package, undef, $line) = caller 0;
-   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
-        map { defined $_ ? $_ : 'undef' }
-        @_;
-   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
-}
-
-1;
-}
-# ###########################################################################
-# End MasterSlave package
-# ###########################################################################
-
-# ###########################################################################
-# Daemon package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/Daemon.pm
-#   t/lib/Daemon.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package Daemon;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use POSIX qw(setsid);
-use Fcntl qw(:DEFAULT);
-
-sub new {
-   my ($class, %args) = @_;
-   my $self = {
-      log_file       => $args{log_file},
-      pid_file       => $args{pid_file},
-      daemonize      => $args{daemonize},
-      force_log_file => $args{force_log_file},
-      parent_exit    => $args{parent_exit},
-      pid_file_owner => 0,
-      utf8           => $args{utf8} // 0,
-   };
-   return bless $self, $class;
-}
-
-sub run {
-   my ($self) = @_;
-
-   my $daemonize      = $self->{daemonize};
-   my $pid_file       = $self->{pid_file};
-   my $log_file       = $self->{log_file};
-   my $force_log_file = $self->{force_log_file};
-   my $parent_exit    = $self->{parent_exit};
-   my $utf8           = $self->{utf8};
-
-   PTDEBUG && _d('Starting daemon');
-
-   if ( $pid_file ) {
-      eval {
-         $self->_make_pid_file(
-            pid      => $PID,  # parent's pid
-            pid_file => $pid_file,
-         );
-      };
-      die "$EVAL_ERROR\n" if $EVAL_ERROR;
-      if ( !$daemonize ) {
-         $self->{pid_file_owner} = $PID;  # parent's pid
-      }
-   }
-
-   if ( $daemonize ) {
-      defined (my $child_pid = fork()) or die "Cannot fork: $OS_ERROR";
-      if ( $child_pid ) {
-         PTDEBUG && _d('Forked child', $child_pid);
-         $parent_exit->($child_pid) if $parent_exit;
-         exit 0;
-      }
-
-      POSIX::setsid() or die "Cannot start a new session: $OS_ERROR";
-      chdir '/'       or die "Cannot chdir to /: $OS_ERROR";
-
-      if ( $pid_file ) {
-         $self->_update_pid_file(
-            pid      => $PID,  # child's pid
-            pid_file => $pid_file,
-         );
-         $self->{pid_file_owner} = $PID;
-      }
-   }
-
-   if ( $daemonize || $force_log_file ) {
-      PTDEBUG && _d('Redirecting STDIN to /dev/null');
-      close STDIN;
-      open  STDIN, '/dev/null'
-         or die "Cannot reopen STDIN to /dev/null: $OS_ERROR";
-      if ( $log_file ) {
-         PTDEBUG && _d('Redirecting STDOUT and STDERR to', $log_file);
-         close STDOUT;
-         open  STDOUT, '>>', $log_file
-            or die "Cannot open log file $log_file: $OS_ERROR";
-         if ( $utf8 ) {
-            binmode(STDOUT, ':utf8')
-               or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
-         }
-
-
-         close STDERR;
-         open  STDERR, ">&STDOUT"
-            or die "Cannot dupe STDERR to STDOUT: $OS_ERROR";
-         if ( $utf8 ) {
-            binmode(STDERR, ':utf8')
-               or die "Can't binmode(STDERR, ':utf8'): $OS_ERROR";
-         }
-      }
-      else {
-         if ( -t STDOUT ) {
-            PTDEBUG && _d('No log file and STDOUT is a terminal;',
-               'redirecting to /dev/null');
-            close STDOUT;
-            open  STDOUT, '>', '/dev/null'
-               or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
-         }
-         if ( -t STDERR ) {
-            PTDEBUG && _d('No log file and STDERR is a terminal;',
-               'redirecting to /dev/null');
-            close STDERR;
-            open  STDERR, '>', '/dev/null'
-               or die "Cannot reopen STDERR to /dev/null: $OS_ERROR";
-         }
-      }
-
-      $OUTPUT_AUTOFLUSH = 1;
-   }
-
-   PTDEBUG && _d('Daemon running');
-   return;
-}
-
-sub _make_pid_file {
-   my ($self, %args) = @_;
-   my @required_args = qw(pid pid_file);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   };
-   my $pid      = $args{pid};
-   my $pid_file = $args{pid_file};
-
-   eval {
-      sysopen(PID_FH, $pid_file, O_RDWR|O_CREAT|O_EXCL) or die $OS_ERROR;
-      print PID_FH $PID, "\n";
-      close PID_FH;
-   };
-   if ( my $e = $EVAL_ERROR ) {
-      if ( $e =~ m/file exists/i ) {
-         my $old_pid = $self->_check_pid_file(
-            pid_file => $pid_file,
-            pid      => $PID,
-         );
-         if ( $old_pid ) {
-            warn "Overwriting PID file $pid_file because PID $old_pid "
-               . "is not running.\n";
-         }
-         $self->_update_pid_file(
-            pid      => $PID,
-            pid_file => $pid_file
-         );
-      }
-      else {
-         die "Error creating PID file $pid_file: $e\n";
-      }
-   }
-
-   return;
-}
-
-sub _check_pid_file {
-   my ($self, %args) = @_;
-   my @required_args = qw(pid_file pid);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   };
-   my $pid_file = $args{pid_file};
-   my $pid      = $args{pid};
-
-   PTDEBUG && _d('Checking if PID in', $pid_file, 'is running');
-
-   if ( ! -f $pid_file ) {
-      PTDEBUG && _d('PID file', $pid_file, 'does not exist');
-      return;
-   }
-
-   open my $fh, '<', $pid_file
-      or die "Error opening $pid_file: $OS_ERROR";
-   my $existing_pid = do { local $/; <$fh> };
-   chomp($existing_pid) if $existing_pid;
-   close $fh
-      or die "Error closing $pid_file: $OS_ERROR";
-
-   if ( $existing_pid ) {
-      if ( $existing_pid == $pid ) {
-         warn "The current PID $pid already holds the PID file $pid_file\n";
-         return;
-      }
-      else {
-         PTDEBUG && _d('Checking if PID', $existing_pid, 'is running');
-         my $pid_is_alive = kill 0, $existing_pid;
-         if ( $pid_is_alive ) {
-            die "PID file $pid_file exists and PID $existing_pid is running\n";
-         }
-      }
-   }
-   else {
-      die "PID file $pid_file exists but it is empty.  Remove the file "
-         . "if the process is no longer running.\n";
-   }
-
-   return $existing_pid;
-}
-
-sub _update_pid_file {
-   my ($self, %args) = @_;
-   my @required_args = qw(pid pid_file);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   };
-   my $pid      = $args{pid};
-   my $pid_file = $args{pid_file};
-
-   open my $fh, '>', $pid_file
-      or die "Cannot open $pid_file: $OS_ERROR";
-   print { $fh } $pid, "\n"
-      or die "Cannot print to $pid_file: $OS_ERROR";
-   close $fh
-      or warn "Cannot close $pid_file: $OS_ERROR";
-
-   return;
-}
-
-sub remove_pid_file {
-   my ($self, $pid_file) = @_;
-   $pid_file ||= $self->{pid_file};
-   if ( $pid_file && -f $pid_file ) {
-      unlink $self->{pid_file}
-         or warn "Cannot remove PID file $pid_file: $OS_ERROR";
-      PTDEBUG && _d('Removed PID file');
-   }
-   else {
-      PTDEBUG && _d('No PID to remove');
-   }
-   return;
-}
-
-sub DESTROY {
-   my ($self) = @_;
-
-   if ( $self->{pid_file_owner} == $PID ) {
-      $self->remove_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
-# ###########################################################################
-
-# ###########################################################################
-# HTTP::Micro package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/HTTP/Micro.pm
-#   t/lib/HTTP/Micro.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package HTTP::Micro;
-
-our $VERSION = '0.01';
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use Carp ();
-
-my @attributes;
-BEGIN {
-    @attributes = qw(agent timeout);
-    no strict 'refs';
-    for my $accessor ( @attributes ) {
-        *{$accessor} = sub {
-            @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
-        };
-    }
-}
-
-sub new {
-    my($class, %args) = @_;
-    (my $agent = $class) =~ s{::}{-}g;
-    my $self = {
-        agent        => $agent . "/" . ($class->VERSION || 0),
-        timeout      => 60,
-    };
-    for my $key ( @attributes ) {
-        $self->{$key} = $args{$key} if exists $args{$key}
-    }
-    return bless $self, $class;
-}
-
-my %DefaultPort = (
-    http => 80,
-    https => 443,
-);
-
-sub request {
-    my ($self, $method, $url, $args) = @_;
-    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
-      or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/);
-    $args ||= {}; # we keep some state in this during _request
-
-    my $response;
-    for ( 0 .. 1 ) {
-        $response = eval { $self->_request($method, $url, $args) };
-        last unless $@ && $method eq 'GET'
-            && $@ =~ m{^(?:Socket closed|Unexpected end)};
-    }
-
-    if (my $e = "$@") {
-        $response = {
-            success => q{},
-            status  => 599,
-            reason  => 'Internal Exception',
-            content => $e,
-            headers => {
-                'content-type'   => 'text/plain',
-                'content-length' => length $e,
-            }
-        };
-    }
-    return $response;
-}
-
-sub _request {
-    my ($self, $method, $url, $args) = @_;
-
-    my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
-
-    my $request = {
-        method    => $method,
-        scheme    => $scheme,
-        host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
-        uri       => $path_query,
-        headers   => {},
-    };
-
-    my $handle  = HTTP::Micro::Handle->new(timeout => $self->{timeout});
-
-    $handle->connect($scheme, $host, $port);
-
-    $self->_prepare_headers_and_cb($request, $args);
-    $handle->write_request_header(@{$request}{qw/method uri headers/});
-    $handle->write_content_body($request) if $request->{content};
-
-    my $response;
-    do { $response = $handle->read_response_header }
-        until (substr($response->{status},0,1) ne '1');
-
-    if (!($method eq 'HEAD' || $response->{status} =~ /^[23]04/)) {
-        $response->{content} = '';
-        $handle->read_content_body(sub { $_[1]->{content} .= $_[0] }, $response);
-    }
-
-    $handle->close;
-    $response->{success} = substr($response->{status},0,1) eq '2';
-    return $response;
-}
-
-sub _prepare_headers_and_cb {
-    my ($self, $request, $args) = @_;
-
-    for ($args->{headers}) {
-        next unless defined;
-        while (my ($k, $v) = each %$_) {
-            $request->{headers}{lc $k} = $v;
-        }
-    }
-    $request->{headers}{'host'}         = $request->{host_port};
-    $request->{headers}{'connection'}   = "close";
-    $request->{headers}{'user-agent'} ||= $self->{agent};
-
-    if (defined $args->{content}) {
-        $request->{headers}{'content-type'} ||= "application/octet-stream";
-        utf8::downgrade($args->{content}, 1)
-            or Carp::croak(q/Wide character in request message body/);
-        $request->{headers}{'content-length'} = length $args->{content};
-        $request->{content} = $args->{content};
-    }
-    return;
-}
-
-sub _split_url {
-    my $url = pop;
-
-    my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
-      or Carp::croak(qq/Cannot parse URL: '$url'/);
-
-    $scheme     = lc $scheme;
-    $path_query = "/$path_query" unless $path_query =~ m<\A/>;
-
-    my $host = (length($authority)) ? lc $authority : 'localhost';
-       $host =~ s/\A[^@]*@//;   # userinfo
-    my $port = do {
-       $host =~ s/:([0-9]*)\z// && length $1
-         ? $1
-         : $DefaultPort{$scheme}
-    };
-
-    return ($scheme, $host, $port, $path_query);
-}
-
-} # HTTP::Micro
-
-{
-   package HTTP::Micro::Handle;
-
-   use strict;
-   use warnings FATAL => 'all';
-   use English qw(-no_match_vars);
-
-   use Carp       qw(croak);
-   use Errno      qw(EINTR EPIPE);
-   use IO::Socket qw(SOCK_STREAM);
-
-   sub BUFSIZE () { 32768 }
-
-   my $Printable = sub {
-       local $_ = shift;
-       s/\r/\\r/g;
-       s/\n/\\n/g;
-       s/\t/\\t/g;
-       s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
-       $_;
-   };
-
-   sub new {
-       my ($class, %args) = @_;
-       return bless {
-           rbuf          => '',
-           timeout       => 60,
-           max_line_size => 16384,
-           %args
-       }, $class;
-   }
-
-   my $ssl_verify_args = {
-       check_cn         => "when_only",
-       wildcards_in_alt => "anywhere",
-       wildcards_in_cn  => "anywhere"
-   };
-
-   sub connect {
-       @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
-       my ($self, $scheme, $host, $port) = @_;
-
-       if ( $scheme eq 'https' ) {
-           eval "require IO::Socket::SSL"
-               unless exists $INC{'IO/Socket/SSL.pm'};
-           croak(qq/IO::Socket::SSL must be installed for https support\n/)
-               unless $INC{'IO/Socket/SSL.pm'};
-       }
-       elsif ( $scheme ne 'http' ) {
-         croak(qq/Unsupported URL scheme '$scheme'\n/);
-       }
-
-       $self->{fh} = IO::Socket::INET->new(
-           PeerHost  => $host,
-           PeerPort  => $port,
-           Proto     => 'tcp',
-           Type      => SOCK_STREAM,
-           Timeout   => $self->{timeout}
-       ) or croak(qq/Could not connect to '$host:$port': $@/);
-
-       binmode($self->{fh})
-         or croak(qq/Could not binmode() socket: '$!'/);
-
-       if ( $scheme eq 'https') {
-           IO::Socket::SSL->start_SSL(
-              $self->{fh},
-              SSL_verifycn_name => $host,
-           );
-           ref($self->{fh}) eq 'IO::Socket::SSL'
-               or die(qq/SSL connection failed for $host\n/);
-           if ( $self->{fh}->can("verify_hostname") ) {
-               $self->{fh}->verify_hostname( $host, $ssl_verify_args )
-                  or die(qq/SSL certificate not valid for $host\n/);
-           }
-           else {
-            my $fh = $self->{fh};
-            _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
-                  or die(qq/SSL certificate not valid for $host\n/);
-            }
-       }
-
-       $self->{host} = $host;
-       $self->{port} = $port;
-
-       return $self;
-   }
-
-   sub close {
-       @_ == 1 || croak(q/Usage: $handle->close()/);
-       my ($self) = @_;
-       CORE::close($self->{fh})
-         or croak(qq/Could not close socket: '$!'/);
-   }
-
-   sub write {
-       @_ == 2 || croak(q/Usage: $handle->write(buf)/);
-       my ($self, $buf) = @_;
-
-       my $len = length $buf;
-       my $off = 0;
-
-       local $SIG{PIPE} = 'IGNORE';
-
-       while () {
-           $self->can_write
-             or croak(q/Timed out while waiting for socket to become ready for writing/);
-           my $r = syswrite($self->{fh}, $buf, $len, $off);
-           if (defined $r) {
-               $len -= $r;
-               $off += $r;
-               last unless $len > 0;
-           }
-           elsif ($! == EPIPE) {
-               croak(qq/Socket closed by remote server: $!/);
-           }
-           elsif ($! != EINTR) {
-               croak(qq/Could not write to socket: '$!'/);
-           }
-       }
-       return $off;
-   }
-
-   sub read {
-       @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
-       my ($self, $len) = @_;
-
-       my $buf  = '';
-       my $got = length $self->{rbuf};
-
-       if ($got) {
-           my $take = ($got < $len) ? $got : $len;
-           $buf  = substr($self->{rbuf}, 0, $take, '');
-           $len -= $take;
-       }
-
-       while ($len > 0) {
-           $self->can_read
-             or croak(q/Timed out while waiting for socket to become ready for reading/);
-           my $r = sysread($self->{fh}, $buf, $len, length $buf);
-           if (defined $r) {
-               last unless $r;
-               $len -= $r;
-           }
-           elsif ($! != EINTR) {
-               croak(qq/Could not read from socket: '$!'/);
-           }
-       }
-       if ($len) {
-           croak(q/Unexpected end of stream/);
-       }
-       return $buf;
-   }
-
-   sub readline {
-       @_ == 1 || croak(q/Usage: $handle->readline()/);
-       my ($self) = @_;
-
-       while () {
-           if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
-               return $1;
-           }
-           $self->can_read
-             or croak(q/Timed out while waiting for socket to become ready for reading/);
-           my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
-           if (defined $r) {
-               last unless $r;
-           }
-           elsif ($! != EINTR) {
-               croak(qq/Could not read from socket: '$!'/);
-           }
-       }
-       croak(q/Unexpected end of stream while looking for line/);
-   }
-
-   sub read_header_lines {
-       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
-       my ($self, $headers) = @_;
-       $headers ||= {};
-       my $lines   = 0;
-       my $val;
-
-       while () {
-            my $line = $self->readline;
-
-            if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
-                my ($field_name) = lc $1;
-                $val = \($headers->{$field_name} = $2);
-            }
-            elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
-                $val
-                  or croak(q/Unexpected header continuation line/);
-                next unless length $1;
-                $$val .= ' ' if length $$val;
-                $$val .= $1;
-            }
-            elsif ($line =~ /\A \x0D?\x0A \z/x) {
-               last;
-            }
-            else {
-               croak(q/Malformed header line: / . $Printable->($line));
-            }
-       }
-       return $headers;
-   }
-
-   sub write_header_lines {
-       (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
-       my($self, $headers) = @_;
-
-       my $buf = '';
-       while (my ($k, $v) = each %$headers) {
-           my $field_name = lc $k;
-            $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
-               or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
-            $field_name =~ s/\b(\w)/\u$1/g;
-            $buf .= "$field_name: $v\x0D\x0A";
-       }
-       $buf .= "\x0D\x0A";
-       return $self->write($buf);
-   }
-
-   sub read_content_body {
-       @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
-       my ($self, $cb, $response, $len) = @_;
-       $len ||= $response->{headers}{'content-length'};
-
-       croak("No content-length in the returned response, and this "
-           . "UA doesn't implement chunking") unless defined $len;
-
-       while ($len > 0) {
-           my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
-           $cb->($self->read($read), $response);
-           $len -= $read;
-       }
-
-       return;
-   }
-
-   sub write_content_body {
-       @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
-       my ($self, $request) = @_;
-       my ($len, $content_length) = (0, $request->{headers}{'content-length'});
-
-       $len += $self->write($request->{content});
-
-       $len == $content_length
-         or croak(qq/Content-Length mismatch (got: $len expected: $content_length)/);
-
-       return $len;
-   }
-
-   sub read_response_header {
-       @_ == 1 || croak(q/Usage: $handle->read_response_header()/);
-       my ($self) = @_;
-
-       my $line = $self->readline;
-
-       $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
-         or croak(q/Malformed Status-Line: / . $Printable->($line));
-
-       my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
-
-       return {
-           status   => $status,
-           reason   => $reason,
-           headers  => $self->read_header_lines,
-           protocol => $protocol,
-       };
-   }
-
-   sub write_request_header {
-       @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
-       my ($self, $method, $request_uri, $headers) = @_;
-
-       return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
-            + $self->write_header_lines($headers);
-   }
-
-   sub _do_timeout {
-       my ($self, $type, $timeout) = @_;
-       $timeout = $self->{timeout}
-           unless defined $timeout && $timeout >= 0;
-
-       my $fd = fileno $self->{fh};
-       defined $fd && $fd >= 0
-         or croak(q/select(2): 'Bad file descriptor'/);
-
-       my $initial = time;
-       my $pending = $timeout;
-       my $nfound;
-
-       vec(my $fdset = '', $fd, 1) = 1;
-
-       while () {
-           $nfound = ($type eq 'read')
-               ? select($fdset, undef, undef, $pending)
-               : select(undef, $fdset, undef, $pending) ;
-           if ($nfound == -1) {
-               $! == EINTR
-                 or croak(qq/select(2): '$!'/);
-               redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
-               $nfound = 0;
-           }
-           last;
-       }
-       $! = 0;
-       return $nfound;
-   }
-
-   sub can_read {
-       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
-       my $self = shift;
-       return $self->_do_timeout('read', @_)
-   }
-
-   sub can_write {
-       @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
-       my $self = shift;
-       return $self->_do_timeout('write', @_)
-   }
-}  # HTTP::Micro::Handle
-
-my $prog = <<'EOP';
-BEGIN {
-   if ( defined &IO::Socket::SSL::CAN_IPV6 ) {
-      *CAN_IPV6 = \*IO::Socket::SSL::CAN_IPV6;
-   }
-   else {
-      constant->import( CAN_IPV6 => '' );
-   }
-   my %const = (
-      NID_CommonName => 13,
-      GEN_DNS => 2,
-      GEN_IPADD => 7,
-   );
-   while ( my ($name,$value) = each %const ) {
-      no strict 'refs';
-      *{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) || sub { $value };
-   }
-}
-{
-   use Carp qw(croak);
-   my %dispatcher = (
-      issuer =>  sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
-      subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
-   );
-   if ( $Net::SSLeay::VERSION >= 1.30 ) {
-      $dispatcher{commonName} = sub {
-         my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
-            Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
-         $cn =~s{\0$}{}; # work around Bug in Net::SSLeay <1.33
-         $cn;
-      }
-   } else {
-      $dispatcher{commonName} = sub {
-         croak "you need at least Net::SSLeay version 1.30 for getting commonName"
-      }
-   }
-
-   if ( $Net::SSLeay::VERSION >= 1.33 ) {
-      $dispatcher{subjectAltNames} = sub { Net::SSLeay::X509_get_subjectAltNames( shift ) };
-   } else {
-      $dispatcher{subjectAltNames} = sub {
-         return;
-      };
-   }
-
-   $dispatcher{authority} = $dispatcher{issuer};
-   $dispatcher{owner}     = $dispatcher{subject};
-   $dispatcher{cn}        = $dispatcher{commonName};
-
-   sub _peer_certificate {
-      my ($self, $field) = @_;
-      my $ssl = $self->_get_ssl_object or return;
-
-      my $cert = ${*$self}{_SSL_certificate}
-         ||= Net::SSLeay::get_peer_certificate($ssl)
-         or return $self->error("Could not retrieve peer certificate");
-
-      if ($field) {
-         my $sub = $dispatcher{$field} or croak
-            "invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
-            "\nMaybe you need to upgrade your Net::SSLeay";
-         return $sub->($cert);
-      } else {
-         return $cert
-      }
-   }
-
-
-   my %scheme = (
-      ldap => {
-         wildcards_in_cn    => 0,
-         wildcards_in_alt => 'leftmost',
-         check_cn         => 'always',
-      },
-      http => {
-         wildcards_in_cn    => 'anywhere',
-         wildcards_in_alt => 'anywhere',
-         check_cn         => 'when_only',
-      },
-      smtp => {
-         wildcards_in_cn    => 0,
-         wildcards_in_alt => 0,
-         check_cn         => 'always'
-      },
-      none => {}, # do not check
-   );
-
-   $scheme{www}  = $scheme{http}; # alias
-   $scheme{xmpp} = $scheme{http}; # rfc 3920
-   $scheme{pop3} = $scheme{ldap}; # rfc 2595
-   $scheme{imap} = $scheme{ldap}; # rfc 2595
-   $scheme{acap} = $scheme{ldap}; # rfc 2595
-   $scheme{nntp} = $scheme{ldap}; # rfc 4642
-   $scheme{ftp}  = $scheme{http}; # rfc 4217
-
-
-   sub _verify_hostname_of_cert {
-      my $identity = shift;
-      my $cert = shift;
-      my $scheme = shift || 'none';
-      if ( ! ref($scheme) ) {
-         $scheme = $scheme{$scheme} or croak "scheme $scheme not defined";
-      }
-
-      return 1 if ! %$scheme; # 'none'
-
-      my $commonName = $dispatcher{cn}->($cert);
-      my @altNames   = $dispatcher{subjectAltNames}->($cert);
-
-      if ( my $sub = $scheme->{callback} ) {
-         return $sub->($identity,$commonName,@altNames);
-      }
-
-
-      my $ipn;
-      if ( CAN_IPV6 and $identity =~m{:} ) {
-         $ipn = IO::Socket::SSL::inet_pton(IO::Socket::SSL::AF_INET6,$identity)
-            or croak "'$identity' is not IPv6, but neither IPv4 nor hostname";
-      } elsif ( $identity =~m{^\d+\.\d+\.\d+\.\d+$} ) {
-         $ipn = IO::Socket::SSL::inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname";
-      } else {
-         if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
-            $identity =~m{\0} and croak("name '$identity' has \\0 byte");
-            $identity = IO::Socket::SSL::idn_to_ascii($identity) or
-               croak "Warning: Given name '$identity' could not be converted to IDNA!";
-         }
-      }
-
-      my $check_name = sub {
-         my ($name,$identity,$wtyp) = @_;
-         $wtyp ||= '';
-         my $pattern;
-         if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-]*)\*(.+)} ) {
-            $pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]*\Q$2\E$}i;
-         } elsif ( $wtyp eq 'leftmost' and $name =~m{^\*(\..+)$} ) {
-            $pattern = qr{^[a-zA-Z0-9_\-]*\Q$1\E$}i;
-         } else {
-            $pattern = qr{^\Q$name\E$}i;
-         }
-         return $identity =~ $pattern;
-      };
-
-      my $alt_dnsNames = 0;
-      while (@altNames) {
-         my ($type, $name) = splice (@altNames, 0, 2);
-         if ( $ipn and $type == GEN_IPADD ) {
-            return 1 if $ipn eq $name;
-
-         } elsif ( ! $ipn and $type == GEN_DNS ) {
-            $name =~s/\s+$//; $name =~s/^\s+//;
-            $alt_dnsNames++;
-            $check_name->($name,$identity,$scheme->{wildcards_in_alt})
-               and return 1;
-         }
-      }
-
-      if ( ! $ipn and (
-         $scheme->{check_cn} eq 'always' or
-         $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames)) {
-         $check_name->($commonName,$identity,$scheme->{wildcards_in_cn})
-            and return 1;
-      }
-
-      return 0; # no match
-   }
-}
-EOP
-
-eval { require IO::Socket::SSL };
-if ( $INC{"IO/Socket/SSL.pm"} ) {
-   eval $prog;
-   die $@ if $@;
-}
-
-1;
-# ###########################################################################
-# End HTTP::Micro package
-# ###########################################################################
-
-# ###########################################################################
-# VersionCheck package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the GitHub repository at,
-#   lib/VersionCheck.pm
-#   t/lib/VersionCheck.t
-# See https://github.com/percona/percona-toolkit for more information.
-# ###########################################################################
-{
-package VersionCheck;
-
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Data::Dumper;
-local $Data::Dumper::Indent    = 1;
-local $Data::Dumper::Sortkeys  = 1;
-local $Data::Dumper::Quotekeys = 0;
-
-use Digest::MD5 qw(md5_hex);
-use Sys::Hostname qw(hostname);
-use File::Basename qw();
-use File::Spec;
-use FindBin qw();
-
-eval {
-   require Percona::Toolkit;
-   require HTTP::Micro;
-};
-
-my $home    = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
-my @vc_dirs = (
-   '/etc/percona',
-   '/etc/percona-toolkit',
-   '/tmp',
-   "$home",
-);
-
-{
-   my $file    = 'percona-version-check';
-
-   sub version_check_file {
-      foreach my $dir ( @vc_dirs ) {
-         if ( -d $dir && -w $dir ) {
-            PTDEBUG && _d('Version check file', $file, 'in', $dir);
-            return $dir . '/' . $file;
-         }
-      }
-      PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD});
-      return $file;  # in the CWD
-   }
-}
-
-sub version_check_time_limit {
-   return 60 * 60 * 24;  # one day
-}
-
-
-sub version_check {
-   my (%args) = @_;
-
-   my $instances = $args{instances} || [];
-   my $instances_to_check;
-
-   PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin);
-   if ( !$args{force} ) {
-      if ( $FindBin::Bin
-           && (-d "$FindBin::Bin/../.bzr"    ||
-               -d "$FindBin::Bin/../../.bzr" ||
-               -d "$FindBin::Bin/../.git"    ||
-               -d "$FindBin::Bin/../../.git"
-              )
-         ) {
-         PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check");
-         return;
-      }
-   }
-
-   eval {
-      foreach my $instance ( @$instances ) {
-         my ($name, $id) = get_instance_id($instance);
-         $instance->{name} = $name;
-         $instance->{id}   = $id;
-      }
-
-      push @$instances, { name => 'system', id => 0 };
-
-      $instances_to_check = get_instances_to_check(
-         instances => $instances,
-         vc_file   => $args{vc_file},  # testing
-         now       => $args{now},      # testing
-      );
-      PTDEBUG && _d(scalar @$instances_to_check, 'instances to check');
-      return unless @$instances_to_check;
-
-      my $protocol = 'https';
-      eval { require IO::Socket::SSL; };
-      if ( $EVAL_ERROR ) {
-         PTDEBUG && _d($EVAL_ERROR);
-         PTDEBUG && _d("SSL not available, won't run version_check");
-         return;
-      }
-      PTDEBUG && _d('Using', $protocol);
-      my $url = $args{url}                       # testing
-                || $ENV{PERCONA_VERSION_CHECK_URL}  # testing
-                || "$protocol://v.percona.com";
-      PTDEBUG && _d('API URL:', $url);
-
-      my $advice = pingback(
-         instances => $instances_to_check,
-         protocol  => $protocol,
-         url       => $url,
-      );
-      if ( $advice ) {
-         PTDEBUG && _d('Advice:', Dumper($advice));
-         if ( scalar @$advice > 1) {
-            print "\n# " . scalar @$advice . " software updates are "
-               . "available:\n";
-         }
-         else {
-            print "\n# A software update is available:\n";
-         }
-         print join("\n", map { "#   * $_" } @$advice), "\n\n";
-      }
-   };
-   if ( $EVAL_ERROR ) {
-      PTDEBUG && _d('Version check failed:', $EVAL_ERROR);
-   }
-
-   if ( @$instances_to_check ) {
-      eval {
-         update_check_times(
-            instances => $instances_to_check,
-            vc_file   => $args{vc_file},  # testing
-            now       => $args{now},      # testing
-         );
-      };
-      if ( $EVAL_ERROR ) {
-         PTDEBUG && _d('Error updating version check file:', $EVAL_ERROR);
-      }
-   }
-
-   if ( $ENV{PTDEBUG_VERSION_CHECK} ) {
-      warn "Exiting because the PTDEBUG_VERSION_CHECK "
-         . "environment variable is defined.\n";
-      exit 255;
-   }
-
-   return;
-}
-
-sub get_instances_to_check {
-   my (%args) = @_;
-
-   my $instances = $args{instances};
-   my $now       = $args{now}     || int(time);
-   my $vc_file   = $args{vc_file} || version_check_file();
-
-   if ( !-f $vc_file ) {
-      PTDEBUG && _d('Version check file', $vc_file, 'does not exist;',
-         'version checking all instances');
-      return $instances;
-   }
-
-   open my $fh, '<', $vc_file or die "Cannot open $vc_file: $OS_ERROR";
-   chomp(my $file_contents = do { local $/ = undef; <$fh> });
-   PTDEBUG && _d('Version check file', $vc_file, 'contents:', $file_contents);
-   close $fh;
-   my %last_check_time_for = $file_contents =~ /^([^,]+),(.+)$/mg;
-
-   my $check_time_limit = version_check_time_limit();
-   my @instances_to_check;
-   foreach my $instance ( @$instances ) {
-      my $last_check_time = $last_check_time_for{ $instance->{id} };
-      PTDEBUG && _d('Instance', $instance->{id}, 'last checked',
-         $last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0),
-         'hours until next check',
-         sprintf '%.2f',
-            ($check_time_limit - ($now - ($last_check_time || 0))) / 3600);
-      if ( !defined $last_check_time
-           || ($now - $last_check_time) >= $check_time_limit ) {
-         PTDEBUG && _d('Time to check', Dumper($instance));
-         push @instances_to_check, $instance;
-      }
-   }
-
-   return \@instances_to_check;
-}
-
-sub update_check_times {
-   my (%args) = @_;
-
-   my $instances = $args{instances};
-   my $now       = $args{now}     || int(time);
-   my $vc_file   = $args{vc_file} || version_check_file();
-   PTDEBUG && _d('Updating last check time:', $now);
-
-   my %all_instances = map {
-      $_->{id} => { name => $_->{name}, ts => $now }
-   } @$instances;
-
-   if ( -f $vc_file ) {
-      open my $fh, '<', $vc_file or die "Cannot read $vc_file: $OS_ERROR";
-      my $contents = do { local $/ = undef; <$fh> };
-      close $fh;
-
-      foreach my $line ( split("\n", ($contents || '')) ) {
-         my ($id, $ts) = split(',', $line);
-         if ( !exists $all_instances{$id} ) {
-            $all_instances{$id} = { ts => $ts };  # original ts, not updated
-         }
-      }
-   }
-
-   open my $fh, '>', $vc_file or die "Cannot write to $vc_file: $OS_ERROR";
-   foreach my $id ( sort keys %all_instances ) {
-      PTDEBUG && _d('Updated:', $id, Dumper($all_instances{$id}));
-      print { $fh } $id . ',' . $all_instances{$id}->{ts} . "\n";
-   }
-   close $fh;
-
-   return;
-}
-
-sub get_instance_id {
-   my ($instance) = @_;
-
-   my $dbh = $instance->{dbh};
-   my $dsn = $instance->{dsn};
-
-   my $sql = q{SELECT CONCAT(@@hostname, @@port)};
-   PTDEBUG && _d($sql);
-   my ($name) = eval { $dbh->selectrow_array($sql) };
-   if ( $EVAL_ERROR ) {
-      PTDEBUG && _d($EVAL_ERROR);
-      $sql = q{SELECT @@hostname};
-      PTDEBUG && _d($sql);
-      ($name) = eval { $dbh->selectrow_array($sql) };
-      if ( $EVAL_ERROR ) {
-         PTDEBUG && _d($EVAL_ERROR);
-         $name = ($dsn->{h} || 'localhost') . ($dsn->{P} || 3306);
-      }
-      else {
-         $sql = q{SHOW VARIABLES LIKE 'port'};
-         PTDEBUG && _d($sql);
-         my (undef, $port) = eval { $dbh->selectrow_array($sql) };
-         PTDEBUG && _d('port:', $port);
-         $name .= $port || '';
-      }
-   }
-   my $id = md5_hex($name);
-
-   PTDEBUG && _d('MySQL instance:', $id, $name, Dumper($dsn));
-
-   return $name, $id;
-}
-
-
-sub get_uuid {
-    my $uuid_file = '/.percona-toolkit.uuid';
-    foreach my $dir (@vc_dirs) {
-        my $filename = $dir.$uuid_file;
-        my $uuid=_read_uuid($filename);
-        return $uuid if $uuid;
-    }
-
-    my $filename = $ENV{"HOME"} . $uuid_file;
-    my $uuid = _generate_uuid();
-
-    my $fh;
-    eval {
-        open($fh, '>', $filename);
-    };
-    if (!$EVAL_ERROR) {
-        print $fh $uuid;
-        close $fh;
-    }
-
-    return $uuid;
-}
-
-sub _generate_uuid {
-    return sprintf+($}="%04x")."$}-$}-$}-$}-".$}x3,map rand 65537,0..7;
-}
-
-sub _read_uuid {
-    my $filename = shift;
-    my $fh;
-
-    eval {
-        open($fh, '<:encoding(UTF-8)', $filename);
-    };
-    return if ($EVAL_ERROR);
-
-    my $uuid;
-    eval { $uuid = <$fh>; };
-    return if ($EVAL_ERROR);
-
-    chomp $uuid;
-    return $uuid;
-}
-
-
-sub pingback {
-   my (%args) = @_;
-   my @required_args = qw(url instances);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my $url       = $args{url};
-   my $instances = $args{instances};
-
-   my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
-
-   my $response = $ua->request('GET', $url);
-   PTDEBUG && _d('Server response:', Dumper($response));
-   die "No response from GET $url"
-      if !$response;
-   die("GET on $url returned HTTP status $response->{status}; expected 200\n",
-       ($response->{content} || '')) if $response->{status} != 200;
-   die("GET on $url did not return any programs to check")
-      if !$response->{content};
-
-   my $items = parse_server_response(
-      response => $response->{content}
-   );
-   die "Failed to parse server requested programs: $response->{content}"
-      if !scalar keys %$items;
-
-   my $versions = get_versions(
-      items     => $items,
-      instances => $instances,
-   );
-   die "Failed to get any program versions; should have at least gotten Perl"
-      if !scalar keys %$versions;
-
-   my $client_content = encode_client_response(
-      items      => $items,
-      versions   => $versions,
-      general_id => get_uuid(),
-   );
-
-   my $tool_name = $ENV{XTRABACKUP_VERSION} ? "Percona XtraBackup" : File::Basename::basename($0);
-   my $client_response = {
-      headers => { "X-Percona-Toolkit-Tool" => $tool_name },
-      content => $client_content,
-   };
-   PTDEBUG && _d('Client response:', Dumper($client_response));
-
-   $response = $ua->request('POST', $url, $client_response);
-   PTDEBUG && _d('Server suggestions:', Dumper($response));
-   die "No response from POST $url $client_response"
-      if !$response;
-   die "POST $url returned HTTP status $response->{status}; expected 200"
-      if $response->{status} != 200;
-
-   return unless $response->{content};
-
-   $items = parse_server_response(
-      response   => $response->{content},
-      split_vars => 0,
-   );
-   die "Failed to parse server suggestions: $response->{content}"
-      if !scalar keys %$items;
-   my @suggestions = map { $_->{vars} }
-                     sort { $a->{item} cmp $b->{item} }
-                     values %$items;
-
-   return \@suggestions;
-}
-
-sub encode_client_response {
-   my (%args) = @_;
-   my @required_args = qw(items versions general_id);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($items, $versions, $general_id) = @args{@required_args};
-
-   my @lines;
-   foreach my $item ( sort keys %$items ) {
-      next unless exists $versions->{$item};
-      if ( ref($versions->{$item}) eq 'HASH' ) {
-         my $mysql_versions = $versions->{$item};
-         for my $id ( sort keys %$mysql_versions ) {
-            push @lines, join(';', $id, $item, $mysql_versions->{$id});
-         }
-      }
-      else {
-         push @lines, join(';', $general_id, $item, $versions->{$item});
-      }
-   }
-
-   my $client_response = join("\n", @lines) . "\n";
-   return $client_response;
-}
-
-sub parse_server_response {
-   my (%args) = @_;
-   my @required_args = qw(response);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($response) = @args{@required_args};
-
-   my %items = map {
-      my ($item, $type, $vars) = split(";", $_);
-      if ( !defined $args{split_vars} || $args{split_vars} ) {
-         $vars = [ split(",", ($vars || '')) ];
-      }
-      $item => {
-         item => $item,
-         type => $type,
-         vars => $vars,
-      };
-   } split("\n", $response);
-
-   PTDEBUG && _d('Items:', Dumper(\%items));
-
-   return \%items;
-}
-
-my %sub_for_type = (
-   os_version          => \&get_os_version,
-   perl_version        => \&get_perl_version,
-   perl_module_version => \&get_perl_module_version,
-   mysql_variable      => \&get_mysql_variable,
-   xtrabackup          => \&get_xtrabackup_version,
-);
-
-sub valid_item {
-   my ($item) = @_;
-   return unless $item;
-   if ( !exists $sub_for_type{ $item->{type} } ) {
-      PTDEBUG && _d('Invalid type:', $item->{type});
-      return 0;
-   }
-   return 1;
-}
-
-sub get_versions {
-   my (%args) = @_;
-   my @required_args = qw(items);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my ($items) = @args{@required_args};
-
-   my %versions;
-   foreach my $item ( values %$items ) {
-      next unless valid_item($item);
-      eval {
-         my $version = $sub_for_type{ $item->{type} }->(
-            item      => $item,
-            instances => $args{instances},
-         );
-         if ( $version ) {
-            chomp $version unless ref($version);
-            $versions{$item->{item}} = $version;
-         }
-      };
-      if ( $EVAL_ERROR ) {
-         PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR);
-      }
-   }
-
-   return \%versions;
-}
-
-
-sub get_os_version {
-   if ( $OSNAME eq 'MSWin32' ) {
-      require Win32;
-      return Win32::GetOSDisplayName();
-   }
-
-  chomp(my $platform = `uname -s`);
-  PTDEBUG && _d('platform:', $platform);
-  return $OSNAME unless $platform;
-
-   chomp(my $lsb_release
-            = `which lsb_release 2>/dev/null | awk '{print \$1}'` || '');
-   PTDEBUG && _d('lsb_release:', $lsb_release);
-
-   my $release = "";
-
-   if ( $platform eq 'Linux' ) {
-      if ( -f "/etc/fedora-release" ) {
-         $release = `cat /etc/fedora-release`;
-      }
-      elsif ( -f "/etc/redhat-release" ) {
-         $release = `cat /etc/redhat-release`;
-      }
-      elsif ( -f "/etc/system-release" ) {
-         $release = `cat /etc/system-release`;
-      }
-      elsif ( $lsb_release ) {
-         $release = `$lsb_release -ds`;
-      }
-      elsif ( -f "/etc/lsb-release" ) {
-         $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`;
-         $release =~ s/^\w+="([^"]+)".+/$1/;
-      }
-      elsif ( -f "/etc/debian_version" ) {
-         chomp(my $rel = `cat /etc/debian_version`);
-         $release = "Debian $rel";
-         if ( -f "/etc/apt/sources.list" ) {
-             chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`);
-             $release .= " ($code_name)" if $code_name;
-         }
-      }
-      elsif ( -f "/etc/os-release" ) { # openSUSE
-         chomp($release = `grep PRETTY_NAME /etc/os-release`);
-         $release =~ s/^PRETTY_NAME="(.+)"$/$1/;
-      }
-      elsif ( `ls /etc/*release 2>/dev/null` ) {
-         if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) {
-            $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`;
-         }
-         else {
-            $release = `cat /etc/*release | head -n1`;
-         }
-      }
-   }
-   elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) {
-      my $rel = `uname -r`;
-      $release = "$platform $rel";
-   }
-   elsif ( $platform eq "SunOS" ) {
-      my $rel = `head -n1 /etc/release` || `uname -r`;
-      $release = "$platform $rel";
-   }
-
-   if ( !$release ) {
-      PTDEBUG && _d('Failed to get the release, using platform');
-      $release = $platform;
-   }
-   chomp($release);
-
-   $release =~ s/^"|"$//g;
-
-   PTDEBUG && _d('OS version =', $release);
-   return $release;
-}
-
-sub get_perl_version {
-   my (%args) = @_;
-   my $item = $args{item};
-   return unless $item;
-
-   my $version = sprintf '%vd', $PERL_VERSION;
-   PTDEBUG && _d('Perl version', $version);
-   return $version;
-}
-
-sub get_xtrabackup_version {
-    return $ENV{XTRABACKUP_VERSION};
-}
-
-sub get_perl_module_version {
-   my (%args) = @_;
-   my $item = $args{item};
-   return unless $item;
-
-   my $var     = '$' . $item->{item} . '::VERSION';
-   my $version = eval "use $item->{item}; $var;";
-   PTDEBUG && _d('Perl version for', $var, '=', $version);
-   return $version;
-}
-
-sub get_mysql_variable {
-   return get_from_mysql(
-      show => 'VARIABLES',
-      @_,
-   );
-}
-
-sub get_from_mysql {
-   my (%args) = @_;
-   my $show      = $args{show};
-   my $item      = $args{item};
-   my $instances = $args{instances};
-   return unless $show && $item;
-
-   if ( !$instances || !@$instances ) {
-      PTDEBUG && _d('Cannot check', $item,
-         'because there are no MySQL instances');
-      return;
-   }
-
-   if ($item->{item} eq 'MySQL' && $item->{type} eq 'mysql_variable') {
-      @{$item->{vars}} = grep { $_ eq 'version' || $_ eq 'version_comment' } @{$item->{vars}};
-   }
-
-
-   my @versions;
-   my %version_for;
-   foreach my $instance ( @$instances ) {
-      next unless $instance->{id};  # special system instance has id=0
-      my $dbh = $instance->{dbh};
-      local $dbh->{FetchHashKeyName} = 'NAME_lc';
-      my $sql = qq/SHOW $show/;
-      PTDEBUG && _d($sql);
-      my $rows = $dbh->selectall_hashref($sql, 'variable_name');
-
-      my @versions;
-      foreach my $var ( @{$item->{vars}} ) {
-         $var = lc($var);
-         my $version = $rows->{$var}->{value};
-         PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version,
-            'on', $instance->{name});
-         push @versions, $version;
-      }
-      $version_for{ $instance->{id} } = join(' ', @versions);
-   }
-
-   return \%version_for;
-}
-
-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 VersionCheck package
-# ###########################################################################
-
-# ###########################################################################
-# This is a combination of modules and programs in one -- a runnable module.
-# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
-# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
-#
-# Check at the end of this package for the call to main() which actually runs
-# the program.
-# ###########################################################################
-package pt_slave_restart;
-
-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 Percona::Toolkit;
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Data::Dumper;
-
-local $Data::Dumper::Indent    = 1;
-local $Data::Dumper::Sortkeys  = 1;
-local $Data::Dumper::Quotekeys = 0;
-
-$OUTPUT_AUTOFLUSH = 1;
-
-my $o;
-my $dp;
-my $q  = new Quoter();
-my %children;
-
-sub main {
-   local @ARGV = @_;  # set global ARGV for this package
-
-   # ########################################################################
-   # Get configuration information.
-   # ########################################################################
-   $o  = new OptionParser();
-   $o->get_specs();
-   $o->get_opts();
-
-   $dp = $o->DSNParser();
-   $dp->prop('set-vars', $o->set_vars());
-
-   $o->set('verbose', 0) if $o->get('quiet');
-
-   if ( !$o->get('help') ) {
-      if ( $o->get('until-master') ) {
-         if ( $o->get('until-master') !~ m/^[.\w-]+,\d+$/ ) {
-            $o->save_error("Invalid --until-master argument, must be file,pos");
-         }
-      }
-      if ( $o->get('until-relay') ) {
-         if ( $o->get('until-relay') !~ m/^[.\w-]+,\d+$/ ) {
-            $o->save_error("Invalid --until-relay argument, must be file,pos");
-         }
-      }
-   }
-
-   eval {
-      MasterSlave::check_recursion_method($o->get('recursion-method'));
-   };
-   if ( $EVAL_ERROR ) {
-      $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
-   }
-
-   $o->usage_or_errors();
-
-   # ########################################################################
-   # First things first: if --stop was given, create the sentinel file.
-   # ########################################################################
-   my $sentinel = $o->get('sentinel');
-   if ( $o->get('stop') ) {
-      PTDEBUG && _d('Creating sentinel file', $sentinel);
-      my $file = IO::File->new($sentinel, ">>")
-         or die "Cannot open $sentinel: $OS_ERROR\n";
-      print $file "Remove this file to permit pt-slave-restart to run\n"
-         or die "Cannot write to $sentinel: $OS_ERROR\n";
-      close $file
-         or die "Cannot close $sentinel: $OS_ERROR\n";
-      print STDOUT "Successfully created file $sentinel\n"
-         unless $o->get('quiet');
-      # Exit unlesss --monitor is given.
-      if ( !$o->got('monitor') ) {
-         PTDEBUG && _d('Nothing more to do, quitting');
-         return 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.
-         PTDEBUG && _d('Waiting for other instances to quit');
-         sleep $o->get('max-sleep');
-         PTDEBUG && _d('Unlinking', $sentinel);
-         unlink $sentinel
-            or die "Cannot unlink $sentinel: $OS_ERROR";
-      }
-   }
-
-   # ########################################################################
-   # Connect to MySQL.
-   # ########################################################################
-   if ( $o->get('ask-pass') ) {
-      $o->set('password', OptionParser::prompt_noecho("Enter password: "));
-   }
-   my $dsn_defaults = $dp->parse_options($o);
-   my $dsn          = @ARGV ? $dp->parse(shift @ARGV, $dsn_defaults)
-                    :         $dsn_defaults;
-   my $dbh          = $dp->get_dbh($dp->get_cxn_params($dsn),
-                              { AutoCommit => 1, });
-
-   $dbh->{InactiveDestroy}  = 1;         # Don't disconnect on fork/daemonize
-
-   # ########################################################################
-   # Daemonize only after (potentially) asking for passwords for --ask-pass.
-   # If option daemonize is not provided while option pid is provided,
-   # we're not daemoninzing, it just handles PID stuff.
-   # ########################################################################
-   my $daemon;
-   if ( $o->get('daemonize') || $o->get('pid')) {
-      $daemon = new Daemon(
-         log_file => $o->get('log'),
-         pid_file => $o->get('pid'),
-         daemonize => $o->get('daemonize'),
-      );
-      $daemon->run();
-      PTDEBUG && $o->get('daemonize') && _d('I am a daemon now');
-   }
-
-   # ########################################################################
-   # Set source and replica names.
-   # ########################################################################
-
-   my $vp = VersionParser->new($dbh);
-   my $source_name = 'source';
-   my $replica_name = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_name = 'master';
-      $replica_name = 'slave';
-   }
-
-   # ########################################################################
-   # Start monitoring the replica.
-   # ########################################################################
-   my $exit_status = 0;
-   my @servers_to_watch;
-
-   # Despite the name, recursing to replicas actually begins at the specified
-   # server, so the named server may also be watched, if it's a replica.
-   my $ms = new MasterSlave(
-      OptionParser => $o,
-      DSNParser    => $dp,
-      Quoter       => $q,
-   );
-   $ms->recurse_to_replicas(
-      {  dbh      => $dbh,
-         dsn      => $dsn,
-         callback => sub {
-            my ( $dsn, $dbh, $level ) = @_;
-            # Test whether we want to watch this server.
-            eval {
-               my $stat = $ms->get_replica_status($dbh);
-               if ( $stat ) {
-                  push @servers_to_watch, { dsn => $dsn, dbh => $dbh };
-               }
-               else {
-                  die "could not find ${replica_name} status on this server\n";
-               }
-            };
-            if ( $EVAL_ERROR ) {
-               chomp $EVAL_ERROR;
-               PTDEBUG && _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";
-         },
-      }
-   );
-
-   # ########################################################################
-   # Do the version-check
-   # ########################################################################
-   if ( $o->get('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
-      VersionCheck::version_check(
-         force     => $o->got('version-check'),
-         instances => [ { dbh => $dbh, dsn => $dsn }, @servers_to_watch ],
-      );
-   }
-
-   # ########################################################################
-   # 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, $ms);
-      }
-      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;
-   }
-
-   PTDEBUG && _d('Child PIDs:', values %children);
-   # Wait for the children to exit.
-   foreach my $host ( keys %children ) {
-      PTDEBUG && _d('Waiting to reap', $host);
-      my $pid = waitpid($children{$host}, 0);
-      $exit_status ||= $CHILD_ERROR >> 8;
-   }
-
-   $dp->disconnect($dbh);
-   return $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, $ms ) = @_;
-
-   PTDEBUG && _d('Watching server', $dp->as_string($dsn),
-      'forked:', $was_forked);
-
-   my $vp = VersionParser->new($dbh);
-   my $source_name   = 'source';
-   my $source_change = 'replication source';
-   my $replica_name  = 'replica';
-   if ( $vp < '8.1' || $vp->flavor() =~ m/maria/ ) {
-      $source_name   = 'master';
-      $source_change = 'master';
-      $replica_name  = 'slave';
-   }
-
-   my $start_sql = $vp >= '4.0.5' ? "START ${replica_name}" : 'SLAVE START';
-   if ( $o->get('until-master') ) {
-      my ( $file, $pos ) = split(',', $o->get('until-master'));
-      $start_sql .= " UNTIL ${source_name}_LOG_FILE = '$file', ${source_name}_LOG_POS = $pos";
-   }
-   elsif ( $o->get('until-relay') ) {
-      my ( $file, $pos ) = split(',', $o->get('until-relay'));
-      $start_sql .= " UNTIL RELAY_LOG_FILE = '$file', RELAY_LOG_POS = $pos";
-   }
-
-   my $start = $dbh->prepare($start_sql);
-   my $stop  = $dbh->prepare("STOP ${replica_name}");
-
-   # ########################################################################
-   # Detect if GTID is enabled. Skipping an event is done differently.
-   # ########################################################################
-   # When MySQL 5.6.5 or higher is used and gtid is enabled, skipping a
-   # transaction is not possible with SQL_REPLICA_SKIP_COUNTER
-   my $skip_event;
-   my $have_gtid = 0;
-   # We also check if version is lower than 10.0.0 because MariaDB has different
-   # versioning system than MySQL
-   if ( VersionParser->new($dbh) >= '5.6.5' && VersionParser->new($dbh) <= '10.0.0' ) {
-      my $row = $dbh->selectrow_arrayref('SELECT @@GLOBAL.gtid_mode');
-      PTDEBUG && _d('@@GLOBAL.gtid_mode:', $row->[0]);
-      if ( $row && $row->[0] =~ m/^ON/ ) {
-         $have_gtid = 1;
-      }
-   }
-   PTDEBUG && _d('Have GTID:', $have_gtid);
-
-   # If GTID is enabled, replica_parallel_workers should be == 0.
-   # It's currently not possible to know what GTID event the failed trx is.
-   if ( $have_gtid ) {
-      my $threads = $dbh->selectrow_hashref(
-         "SELECT \@\@GLOBAL.${replica_name}_parallel_workers AS threads");
-      if ( $threads->{threads} > 0 ) {
-         die "Cannot skip transactions properly because GTID is enabled "
-            . "and ${replica_name}_parallel_workers > 0.  See 'GLOBAL TRANSACTION IDS' "
-            . "in the tool's documentation.\n";
-      }
-   }
-
-   # ########################################################################
-   # 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/./ => ($have_gtid ? 'skip_gtid' : 'skip')                     ],
-   );
-
-   # ########################################################################
-   # These are actions to take when an error is found.
-   # ########################################################################
-   my %actions = (
-      refetch_relay_log => sub {
-         my ( $stat, $dbh ) = @_;
-         PTDEBUG && _d('Found relay log corruption');
-         # Can't do CHANGE MASTER TO with a running replica.
-         $stop->execute();
-
-         # Cannot use ? placeholders for CHANGE MASTER values:
-         # https://bugs.launchpad.net/percona-toolkit/+bug/932614
-         my $sql = "CHANGE ${source_change} TO "
-                 . "${source_name}_LOG_FILE='" 
-                 . $stat->{"relay_${source_name}_log_file"} . "', "
-                 . "${source_name}_LOG_POS=" . $stat->{"exec_${source_name}_log_pos"};
-         PTDEBUG && _d($sql);
-         $dbh->do($sql);
-      },
-      skip => sub {
-         my ( $stat, $dbh ) = @_;
-         my $set_skip = $dbh->prepare("SET GLOBAL SQL_${replica_name}_SKIP_COUNTER = "
-                          . $o->get('skip-count'));
-         $set_skip->execute();
-      },
-      skip_gtid => sub {
-         my ( $stat, $dbh ) = @_;
-
-         # Get master_uuid from SHOW REPLICA STATUS if a UUID is not specified
-         # with --source-uuid.
-         my $gtid_uuid = $o->get("source-uuid");
-         if ( !$gtid_uuid ) {
-            $gtid_uuid = $stat->{"${source_name}_uuid"};
-            die "No ${source_name}_uuid" unless $gtid_uuid;  # shouldn't happen
-         }
-
-         # We need the highest transaction in the executed_gtid_set.
-         # and then we need to increase it by 1 (the one we want to skip)
-         # Notes:
-         #  - does not work with parallel replication
-         #  - it skips the next transaction from the master_uuid
-         #    (when a replicaB is replicating from replicaA,
-         #     the master_uuid is it's own master, replicaA)
-         my ($gtid_exec_ids) = ($stat->{executed_gtid_set} || '') =~ m/$gtid_uuid([0-9-:]*)/;
-         $gtid_exec_ids =~ s/:[0-9]+-/:/g;
-         die "No executed GTIDs" unless $gtid_exec_ids;
-
-         my @gtid_exec_ranges = split(/:/, $gtid_exec_ids);
-         delete $gtid_exec_ranges[0]; # undef the first value, it's always empty
-
-         # Get the highest id by sorting the array, removing the undef value.
-         my @gtid_exec_sorted = sort { $a <=> $b }
-                                grep { defined($_) } @gtid_exec_ranges;
-         my $gtid_exec_last   = $gtid_exec_sorted[-1];
-
-         PTDEBUG && _d("\n",
-            "GTID: ${source_name}_uuid:",         $gtid_uuid, "\n",
-            "GTID: executed_gtid_set:",           $gtid_exec_ids, "\n",
-            "GTID: max for ${source_name}_uuid:", $gtid_exec_sorted[-1], "\n",
-            "GTID: last executed gtid:",          $gtid_uuid, ":", $gtid_exec_last);
-
-         # Set the sessions next gtid, write an empty transaction
-         my $skipped = 0;
-         while ( $skipped++ < $o->get('skip-count') ) {
-            my $gtid_next = $gtid_exec_last + $skipped;
-            my $sql       = "SET GTID_NEXT='$gtid_uuid:$gtid_next'";
-            PTDEBUG && _d($sql);
-            my $sth = $dbh->prepare($sql);
-            $sth->execute();
-            $dbh->begin_work();
-            $dbh->commit();
-         }
-
-         # Set the session back to the automatically generated GTID_NEXT.
-         $dbh->do("SET GTID_NEXT='AUTOMATIC'");
-      },
-      repair_table => sub {
-         my ( $stat, $dbh ) = @_;
-         PTDEBUG && _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);
-            PTDEBUG && _d($sql);
-            $dbh->do($sql);
-         }
-      },
-   );
-
-   my $err_text  = $o->get('error-text');
-   my $exit_time = time() + ($o->get('run-time') || 0);
-   my $sleep     = $o->get('sleep');
-   my ($last_log, $last_pos);
-
-   my $stat = {}; # Will hold SHOW REPLICA STATUS
-   STAT:
-   while ( $stat
-           && (!$o->get('run-time') || time() < $exit_time)
-           && !-f $o->get('sentinel') ) {
-      my $increase_sleep = 1;
-      $stat = $ms->get_replica_status($dbh);
-      if ( !$stat ) {
-         print STDERR "No ${replica_name} STATUS output found on ",
-            $dp->as_string($dsn), "\n";
-         next STAT;
-      }
-
-      PTDEBUG && _d('Last/current relay log file:',
-         $last_log, $stat->{relay_log_file});
-      PTDEBUG && _d('Last/current relay log pos:',
-         $last_pos, $stat->{relay_log_pos});
-      if ( !$last_log
-           || $last_log ne $stat->{relay_log_file}   # Avoid infinite loops
-           || $last_pos != $stat->{relay_log_pos}
-      ) {
-         $stat->{"${replica_name}_sql_running"} ||= 'No';
-         $stat->{last_error}        ||= '';
-         $stat->{last_errno}        ||= 0;
-
-         if ( $o->get('until-master') && pos_ge($stat, $source_name, $source_name) ) {
-            die "Replica has advanced past " . $o->get('until-master')
-               . " on master.\n";
-         }
-         elsif ( $o->get('until-relay') && pos_ge($stat, 'relay', $source_name) ) {
-            die "Replica has advanced past " . $o->get('until-relay')
-               . " in relay logs.\n";
-         }
-
-         if ( $stat->{"${replica_name}_sql_running"} eq 'No' ) {
-            # Print the time, error, etc
-            if ( $o->get('verbose') ) {
-               my $err = '';
-               if ( $o->get('verbose') > 1 ) {
-                  ($err = $stat->{last_error} || '' ) =~ s/\s+/ /g;
-                  if ( $o->get('error-length') ) {
-                     $err = substr($err, 0, $o->get('error-length'));
-                  }
-               }
-               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 ( $o->got('error-numbers')
-                 && !exists($o->get('error-numbers')->{$stat->{last_errno}}) ) {
-               die "Error $stat->{last_errno} is not in --error-numbers.\n";
-            }
-            elsif ( $err_text
-                    && $stat->{last_error}
-                    && $stat->{last_error} !~ m/$err_text/ ) {
-               die "Error does not match --error-text.\n";
-            }
-            elsif ( $stat->{last_error} || $o->get('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).
-               if ( $o->get('check-relay-log') ) {
-                  $last_log = $stat->{relay_log_file};
-                  $last_pos = $stat->{relay_log_pos};
-               }
-            }
-            else {
-               PTDEBUG && _d('The replica is stopped, but without error');
-               $increase_sleep = 1;
-            }
-         }
-         elsif ( $o->get('verbose') > 2 ) {
-            printf("%s delayed %s sec\n", $dp->as_string($dsn),
-               (defined $stat->{"seconds_behind_${source_name}"} ?
-               $stat->{"seconds_behind_${source_name}"} : 'NULL'));
-         }
-      }
-      else {
-         if ( $o->get('verbose') ) {
-            print "Not checking replica because relay log file or position has "
-               . "not changed "
-               . "(file " . ($last_log || '')
-               . " pos "  . ($last_pos || '') . ")\n";
-         }
-      }
-
-      # Adjust sleep time.
-      if ( $increase_sleep ) {
-         $sleep = min($o->get('max-sleep'), $sleep * 2);
-      }
-      else {
-         $sleep = max($o->get('min-sleep'), $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 pt-slave-restart finds an error; now $sleep is 256, but
-      # pt-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.
-      my $sleep_time = $increase_sleep ? $sleep : min($sleep, $o->get('sleep'));
-      if ( $o->get('verbose') > 2 ) {
-         printf("%s sleeping %f\n", $dp->as_string($dsn), $sleep_time);
-      }
-      sleep $sleep_time;
-   }
-
-   PTDEBUG && _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, $source_name ) = @_;
-   my $fmt  = '%s/%020d';
-   my $curr = $which eq $source_name
-      ? sprintf($fmt, @{$stat}{("relay_${source_name}_log_file", "exec_${source_name}_log_pos")})
-      : sprintf($fmt, @{$stat}{qw(relay_log_file relay_log_pos)});
-   my $stop = sprintf($fmt, split(',', $o->get("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);
-}
-
-# 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);
-}
-
-sub _d {
-   my ($package, undef, $line) = caller 0;
-   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
-        map { defined $_ ? $_ : 'undef' }
-        @_;
-   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
-}
-
-# ############################################################################
-# Run the program.
-# ############################################################################
-if ( !caller ) { exit main(@ARGV); }
-
-1; # Because this is a module as well as a script.
-
-# ############################################################################
-# Documentation.
-# ############################################################################
-
-=pod
-
-=head1 NAME
-
-pt-slave-restart - Watch and restart MySQL replication after errors.
-
-=head1 SYNOPSIS
-
-Usage: pt-slave-restart [OPTIONS] [DSN]
-
-pt-slave-restart watches one or more MySQL replication slaves for
-errors, and tries to restart replication if it stops.
-
-=head1 RISKS
-
-Percona Toolkit is mature, proven in the real world, and well tested,
-but all database tools can pose a risk to the system and the database
-server.  Before using this tool, please:
-
-=over
-
-=item * Read the tool's documentation
-
-=item * Review the tool's known L<"BUGS">
-
-=item * Test the tool on a non-production server
-
-=item * Backup your production server and verify the backups
-
-=back
-
-=head1 DESCRIPTION
-
-pt-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.
-
-Although this tool can help a slave advance past errors, you should not
-rely on it to "fix" replication.  If slave errors occur frequently or
-unexpectedly, you should identify and fix the root cause.
-
-=head1 OUTPUT
-
-pt-slave-restart prints a line every time it sees the slave has an error.
-By default this line is: a timestamp, connection information, relay_log_file,
-relay_log_pos, and last_errno.
-You can add more information using the L<"--verbose"> option.
-You can suppress all output using the L<"--quiet"> option.
-
-=head1 SLEEP
-
-pt-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<"--min-sleep"> and above by
-L<"--max-sleep">.
-
-=item *
-
-Immediately after finding an error, pt-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 GLOBAL TRANSACTION IDS
-
-As of Percona Toolkit 2.2.8, pt-slave-restart supports Global Transaction IDs
-introduced in MySQL 5.6.5.  It's important to keep in mind that:
-
-=over
-
-=item *
-
-pt-slave-restart will not skip transactions when multiple replication threads
-are being used (slave_parallel_workers > 0).  pt-slave-restart does not know
-what the GTID event is of the failed transaction of a specific slave thread.
-
-=item *
-
-The default behavior is to skip the next transaction from the slave's master.
-Writes can originate on different servers, each with their own UUID.
-
-See L<"--master-uuid">.
-
-=back
-
-=head1 EXIT STATUS
-
-An exit status of 0 (sometimes also called a return value or return code)
-indicates success.  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
-
-pt-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 OPTIONS
-
-This tool accepts additional command-line arguments.  Refer to the
-L<"SYNOPSIS"> and usage information for details.
-
-=over
-
-=item --always
-
-Start slaves even when there is no error.  With this option enabled,
-pt-slave-restart will not let you stop the slave manually if you want to!
-
-=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 --[no]check-relay-log
-
-default: yes
-
-Check the last relay log file and position before checking for slave errors.
-
-By default pt-slave-restart will not doing anything (it will just sleep)
-if neither the relay log file nor the relay log position have changed since
-the last check.  This prevents infinite loops (i.e. restarting the same
-error in the same relay log file at the same relay log position).
-
-For certain slave errors, however, this check needs to be disabled by
-specifying C<--no-check-relay-log>.  Do not do this unless you know what
-you are doing!
-
-=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
-
-Database to use.
-
-=item --defaults-file
-
-short form: -F; type: string
-
-Only read mysql options from the given file.  You must give an absolute
-pathname.
-
-=item --error-length
-
-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
-
-type: hash
-
-Only restart this comma-separated list of errors.  Makes pt-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
-
-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,
-pt-slave-restart will try to restart the slave.  If it exists but doesn't match,
-pt-slave-restart will exit.
-
-The error text is in the C<last_error> column of C<SHOW SLAVE STATUS>.
-
-=item --help
-
-Show help and exit.
-
-=item --host
-
-short form: -h; type: string
-
-Connect to host.
-
-=item --log
-
-type: string
-
-Print all output to this file when daemonized.
-
-=item --max-sleep
-
-type: float; default: 64
-
-Maximum sleep seconds.
-
-The maximum time pt-slave-restart will sleep before polling the slave again.
-This is also the time that pt-slave-restart will wait for all other running
-instances to quit if both L<"--stop"> and L<"--monitor"> are specified.
-
-See L<"SLEEP">.
-
-=item --min-sleep
-
-type: float; default: 0.015625
-
-The minimum time pt-slave-restart will sleep before polling the slave again.
-See L<"SLEEP">.
-
-=item --monitor
-
-Whether to monitor the slave (default).  Unless you specify --monitor
-explicitly, L<"--stop"> will disable it.
-
-=item --password
-
-short form: -p; type: string
-
-Password to use when connecting.
-If password contains commas they must be escaped with a backslash: "exam\,ple"
-
-=item --pid
-
-type: string
-
-Create the given PID file.  The tool won't start if the PID file already
-exists and the PID it contains is different than the current PID.  However,
-if the PID file exists and the PID it contains is no longer running, the
-tool will overwrite the PID file with the current PID.  The PID file is
-removed automatically when the tool 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
-
-type: int; default: 0
-
-Watch slaves of the specified server, up to the specified number of servers deep
-in the hierarchy.  The default depth of 0 means "just watch the slave
-specified."
-
-pt-slave-restart examines C<SHOW PROCESSLIST> and tries to determine which
-connections are from slaves, then connect to them.  See L<"--recursion-method">.
-
-Recursion works by finding all slaves when the program starts, then watching
-them.  If there is more than one slave, C<pt-slave-restart> uses C<fork()> to
-monitor them.
-
-This also 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.
-
-=item --recursion-method
-
-type: array; default: processlist,hosts
-
-Preferred recursion method used to find slaves.
-
-Possible methods are:
-
-  METHOD       USES
-  ===========  ==================
-  processlist  SHOW PROCESSLIST
-  hosts        SHOW SLAVE HOSTS
-  none         Do not find slaves
-
-The processlist method is preferred because SHOW SLAVE HOSTS is not reliable.
-However, the hosts method is required if the server uses a non-standard
-port (not 3306).  Usually pt-slave-restart does the right thing and finds
-the slaves, but you may give a preferred method and it will be used first.
-If it doesn't find any slaves, the other methods will be tried.
-
-=item --run-time
-
-type: time
-
-Time to run before exiting.  Causes pt-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 --sentinel
-
-type: string; default: /tmp/pt-slave-restart-sentinel
-
-Exit if this file exists.
-
-=item --slave-user
-
-type: string
-
-Sets the user to be used to connect to the slaves.
-This parameter allows you to have a different user with less privileges on the
-slaves but that user must exist on all slaves.
-
-=item --slave-password
-
-type: string
-
-Sets the password to be used to connect to the slaves.
-It can be used with --slave-user and the password for the user must be the same
-on all slaves.
-
-=item --set-vars
-
-type: Array
-
-Set the MySQL variables in this comma-separated list of C<variable=value> pairs.
-
-By default, the tool sets:
-
-=for comment ignore-pt-internal-value
-MAGIC_set_vars
-
-   wait_timeout=10000
-
-Variables specified on the command line override these defaults.  For
-example, specifying C<--set-vars wait_timeout=500> overrides the defaultvalue of C<10000>.
-
-The tool prints a warning and continues if a variable cannot be set.
-
-=item --skip-count
-
-type: int; default: 1
-
-Number of statements to skip when restarting the slave.
-
-=item --source-uuid
-
-type: string
-
-When using GTID, an empty transaction should be created in order to skip it.
-If writes are coming from different nodes in the replication tree above, it is
-not possible to know which event from which UUID to skip.
-
-By default, transactions from the slave's master (C<'Master_UUID'> from
-C<SHOW SLAVE STATUS>) are skipped.
-
-For example, with
-
-  master1 -> slave1 -> slave2
-
-When skipping events on slave2 that were written to master1, you must specify
-the UUID of master1, else the tool will use the UUID of slave1 by default.
-
-See L<"GLOBAL TRANSACTION IDS">.
-
-=item --sleep
-
-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<pt-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<pt-slave-restart> will exit after creating the file.  If it is
-specified, C<pt-slave-restart> will wait the interval given by
-L<"--max-sleep">, 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<pt-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 * * * * pt-slave-restart --monitor --stop --sentinel /tmp/pt-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 --until-master
-
-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 pt-slave-restart
-will exit.
-
-=item --until-relay
-
-type: string
-
-Run until this relay log file and position.  Like L<"--until-master">, 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
-
-Adds more information to the output.
-This flag can be specified multiple times. e.g. -v -v OR -vv.
-By default (no verbose flag) the tool outputs connection information, a timestamp,
-relay_log_file, relay_log_pos, and last_errno.
-One flag (-v) adds last_error.  See also L<"--error-length">.
-Two flags (-vv) prints the current sleep time each time pt-slave-restart sleeps.
-To suppress all output use the L<"--quiet"> option.
-
-=item --version
-
-Show version and exit.
-
-=item --[no]version-check
-
-default: yes
-
-Check for the latest version of Percona Toolkit, MySQL, and other programs.
-
-This is a standard "check for updates automatically" feature, with two
-additional features.  First, the tool checks its own version and also the
-versions of the following software: operating system, Percona Monitoring and
-Management (PMM), MySQL, Perl, MySQL driver for Perl (DBD::mysql), and
-Percona Toolkit. Second, it checks for and warns about versions with known
-problems. For example, MySQL 5.5.25 had a critical bug and was re-released
-as 5.5.25a.
-
-A secure connection to Percona’s Version Check database server is done to
-perform these checks. Each request is logged by the server, including software
-version numbers and unique ID of the checked system. The ID is generated by the
-Percona Toolkit installation script or when the Version Check database call is
-done for the first time.
-
-Any updates or known problems are printed to STDOUT before the tool's normal
-output.  This feature should never interfere with the normal operation of the
-tool.
-
-For more information, visit L<https://www.percona.com/doc/percona-toolkit/LATEST/version-check.html>.
-
-=back
-
-Show version and exit.
-
-=head1 DSN OPTIONS
-
-These DSN options are used to create a DSN.  Each option is given like
-C<option=value>.  The options are case-sensitive, so P and p are not the
-same option.  There cannot be whitespace before or after the C<=> and
-if the value contains whitespace it must be quoted.  DSN options are
-comma-separated.  See the L<percona-toolkit> manpage for full details.
-
-=over
-
-=item * A
-
-dsn: charset; copy: yes
-
-Default character set.
-
-=item * D
-
-dsn: database; copy: yes
-
-Default database.
-
-=item * F
-
-dsn: mysql_read_default_file; copy: yes
-
-Only read default options from the given file
-
-=item * h
-
-dsn: host; copy: yes
-
-Connect to host.
-
-=item * p
-
-dsn: password; copy: yes
-
-Password to use when connecting.
-If password contains commas they must be escaped with a backslash: "exam\,ple"
-
-=item * P
-
-dsn: port; copy: yes
-
-Port number to use for connection.
-
-=item * S
-
-dsn: mysql_socket; copy: yes
-
-Socket file to use for connection.
-
-=item * u
-
-dsn: user; copy: yes
-
-User for login if not current user.
-
-=back
-
-=head1 ENVIRONMENT
-
-The environment variable C<PTDEBUG> enables verbose debugging output to STDERR.
-To enable debugging and capture all output to a file, run the tool like:
-
-   PTDEBUG=1 pt-slave-restart ... > FILE 2>&1
-
-Be careful: debugging output is voluminous and can generate several megabytes
-of output.
-
-=head1 ATTENTION
-
-Using <PTDEBUG> might expose passwords. When debug is enabled, all command line
-parameters are shown in the output.
-
-=head1 SYSTEM REQUIREMENTS
-
-You need Perl, DBI, DBD::mysql, and some core packages that ought to be
-installed in any reasonably new version of Perl.
-
-=head1 BUGS
-
-For a list of known bugs, see L<https://jira.percona.com/projects/PT/issues>.
-
-Please report bugs at L<https://jira.percona.com/projects/PT>.
-Include the following information in your bug report:
-
-=over
-
-=item * Complete command-line used to run the tool
-
-=item * Tool L<"--version">
-
-=item * MySQL version of all servers involved
-
-=item * Output from the tool including STDERR
-
-=item * Input files (log/dump/config files, etc.)
-
-=back
-
-If possible, include debugging output by running the tool with C<PTDEBUG>;
-see L<"ENVIRONMENT">.
-
-=head1 DOWNLOADING
-
-Visit L<http://www.percona.com/software/percona-toolkit/> to download the
-latest release of Percona Toolkit.  Or, get the latest release from the
-command line:
-
-   wget percona.com/get/percona-toolkit.tar.gz
-
-   wget percona.com/get/percona-toolkit.rpm
-
-   wget percona.com/get/percona-toolkit.deb
-
-You can also get individual tools from the latest release:
-
-   wget percona.com/get/TOOL
-
-Replace C<TOOL> with the name of any tool.
-
-=head1 AUTHORS
-
-Baron Schwartz
-
-=head1 ABOUT PERCONA TOOLKIT
-
-This tool is part of Percona Toolkit, a collection of advanced command-line
-tools for MySQL developed by Percona.  Percona Toolkit was forked from two
-projects in June, 2011: Maatkit and Aspersa.  Those projects were created by
-Baron Schwartz and primarily developed by him and Daniel Nichter.  Visit
-L<http://www.percona.com/software/> to learn about other free, open-source
-software from Percona.
-
-=head1 COPYRIGHT, LICENSE, AND WARRANTY
-
-This program is copyright 2011-2024 Percona LLC and/or its affiliates,
-2007-2011 Baron Schwartz.
-
-THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
-WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-
-This program is free software; you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
-systems, you can issue `man perlgpl' or `man perlartistic' to read these
-licenses.
-
-You should have received a copy of the GNU General Public License along with
-this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-Place, Suite 330, Boston, MA  02111-1307  USA.
-
-=head1 VERSION
-
-pt-slave-restart 3.6.0
-
-=cut
diff --git a/bin/pt-slave-restart b/bin/pt-slave-restart
new file mode 120000
index 00000000..2c40dd31
--- /dev/null
+++ b/bin/pt-slave-restart
@@ -0,0 +1 @@
+pt-replica-restart
\ No newline at end of file
diff --git a/t/pt-replica-restart/deprecation.t b/t/pt-replica-restart/deprecation.t
new file mode 100644
index 00000000..ee88cae3
--- /dev/null
+++ b/t/pt-replica-restart/deprecation.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More ;
+
+use PerconaTest;
+require "$trunk/bin/pt-replica-restart";
+
+my $output;
+my $cnf = '/tmp/12346/my.sandbox.cnf';
+my $cmd = "$trunk/bin/pt-replica-restart -F $cnf h=127.1";
+my $legacy_cmd = "$trunk/bin/pt-slave-restart -F $cnf h=127.1";
+
+$output = `$cmd --help 2>&1`;
+unlike(
+   $output, 
+   qr/pt-slave-restart is a link to pt-replica-restart/, 
+   'Deprecation warning not printed for pt-replica-restart'
+);
+
+$output = `$legacy_cmd --help 2>&1`;
+like(
+   $output, 
+   qr/pt-slave-restart is a link to pt-replica-restart/, 
+   'Deprecation warning printed for pt-slave-restart'
+);
+
+done_testing();
+exit;
diff --git a/t/pt-slave-restart/gtid.t b/t/pt-replica-restart/gtid.t
similarity index 90%
rename from t/pt-slave-restart/gtid.t
rename to t/pt-replica-restart/gtid.t
index fab66e03..255ff80f 100644
--- a/t/pt-slave-restart/gtid.t
+++ b/t/pt-replica-restart/gtid.t
@@ -14,7 +14,7 @@ use Data::Dumper;
 
 use PerconaTest;
 use Sandbox;
-require "$trunk/bin/pt-slave-restart";
+require "$trunk/bin/pt-replica-restart";
 
 if ( $sandbox_version lt '5.6' ) {
    plan skip_all => "Requires MySQL 5.6";
@@ -45,7 +45,7 @@ my $replica2_dsn = $sb->dsn_for("replica2");
 
 my $pid_file = "/tmp/pt-replica-restart-test-$PID.pid";
 my $log_file = "/tmp/pt-replica-restart-test-$PID.log";
-my $cmd      = "$trunk/bin/pt-slave-restart --daemonize --run-time 5 --max-sleep 0.25 --pid $pid_file --log $log_file";
+my $cmd      = "$trunk/bin/pt-replica-restart --daemonize --run-time 5 --max-sleep 0.25 --pid $pid_file --log $log_file";
 
 sub start {
    my ( $extra ) = @_;
@@ -56,9 +56,9 @@ sub start {
 
 sub stop() {
    return 1 if !is_running();
-   diag(`$trunk/bin/pt-slave-restart --stop -q >/dev/null 2>&1 &`);
+   diag(`$trunk/bin/pt-replica-restart --stop -q >/dev/null 2>&1 &`);
    wait_until(sub { !-f $pid_file }, 0.3, 2);
-   diag(`rm -f /tmp/pt-slave-restart-sentinel`);
+   diag(`rm -f /tmp/pt-replica-restart-sentinel`);
    return is_running() ? 0 : 1;
 }
 
@@ -112,9 +112,9 @@ wait_repl_broke($replica1_dbh) or die "Failed to break replication";
 my $r = $replica1_dbh->selectrow_hashref("show ${replica_name} status");
 like($r->{last_error}, qr/Table 'test.t' doesn't exist'/, 'replica: Replication broke');
 
-# Start pt-slave-restart and wait up to 5s for it to fix replication
+# Start pt-replica-restart and wait up to 5s for it to fix replication
 # (it should take < 1s but tests can be really slow sometimes).
-start("$replica1_dsn") or die "Failed to start pt-slave-restart";
+start("$replica1_dsn") or die "Failed to start pt-replica-restart";
 wait_repl_ok($replica1_dbh);
 
 # Check if replication is fixed.
@@ -125,8 +125,8 @@ like(
    'Event is skipped',
 ) or BAIL_OUT("Replication is broken");
 
-# Stop pt-slave-restart.
-stop() or die "Failed to stop pt-slave-restart";
+# Stop pt-replica-restart.
+stop() or die "Failed to stop pt-replica-restart";
 
 # #############################################################################
 # Test the replica of the source.
@@ -160,7 +160,7 @@ like(
    'Skips event from source on replica2'
 ) or BAIL_OUT("Replication is broken");
 
-stop() or die "Failed to stop pt-slave-restart";
+stop() or die "Failed to stop pt-replica-restart";
 
 # #############################################################################
 # Test skipping 2 events in a row.
@@ -195,7 +195,7 @@ like(
    'Skips multiple events'
 ) or BAIL_OUT("Replication is broken");
 
-stop() or die "Failed to stop pt-slave-restart";
+stop() or die "Failed to stop pt-replica-restart";
 
 # #############################################################################
 # Done.
diff --git a/t/pt-slave-restart/gtid_parallelreplication.t b/t/pt-replica-restart/gtid_parallelreplication.t
similarity index 88%
rename from t/pt-slave-restart/gtid_parallelreplication.t
rename to t/pt-replica-restart/gtid_parallelreplication.t
index 4246238d..c0f7d0d6 100644
--- a/t/pt-slave-restart/gtid_parallelreplication.t
+++ b/t/pt-replica-restart/gtid_parallelreplication.t
@@ -13,7 +13,7 @@ use Test::More;
 
 use PerconaTest;
 use Sandbox;
-require "$trunk/bin/pt-slave-restart";
+require "$trunk/bin/pt-replica-restart";
 
 if ( $sandbox_version lt '5.6' ) {
    plan skip_all => 'MySQL Version ' . $sandbox_version 
@@ -42,15 +42,15 @@ elsif ( !$replica2_dbh ) {
 }
 
 # #############################################################################
-# pt-slave-restart should exit!
+# pt-replica-restart should exit!
 # #############################################################################
 # Start an instance
-my $output=`$trunk/bin/pt-slave-restart --run-time=1s -h 127.0.0.1 -P 12346 -u msandbox -p msandbox 2>&1`;
+my $output=`$trunk/bin/pt-replica-restart --run-time=1s -h 127.0.0.1 -P 12346 -u msandbox -p msandbox 2>&1`;
 
 like(
    $output,
    qr/Cannot skip transactions properly.*${replica_name}_parallel_workers/,
-   "pt-slave-restart exits with multiple replication threads"
+   "pt-replica-restart exits with multiple replication threads"
 ) or diag($output);
 
 # #############################################################################
diff --git a/t/pt-replica-restart/pt-replica-restart.t b/t/pt-replica-restart/pt-replica-restart.t
new file mode 100644
index 00000000..2db4da27
--- /dev/null
+++ b/t/pt-replica-restart/pt-replica-restart.t
@@ -0,0 +1,146 @@
+#!/usr/bin/env perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+use PerconaTest;
+use Sandbox;
+require "$trunk/bin/pt-replica-restart";
+
+diag('Restarting the sandbox');
+diag(`SAKILA=0 REPLICATION_THREADS=0 GTID=1 $trunk/sandbox/test-env restart`);
+diag("Sandbox restarted");
+
+my $dp = new DSNParser(opts=>$dsn_opts);
+my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
+my $source_dbh = $sb->get_dbh_for('source');
+my $replica_dbh  = $sb->get_dbh_for('replica1');
+
+if ( !$source_dbh ) {
+   plan skip_all => 'Cannot connect to sandbox source';
+}
+elsif ( !$replica_dbh ) {
+   plan skip_all => 'Cannot connect to sandbox replica';
+}
+
+$source_dbh->do('DROP DATABASE IF EXISTS test');
+$source_dbh->do('CREATE DATABASE test');
+$source_dbh->do('CREATE TABLE test.t (a INT)');
+$sb->wait_for_replicas;
+
+# Bust replication
+$replica_dbh->do('DROP TABLE test.t');
+$source_dbh->do('INSERT INTO test.t SELECT 1');
+wait_until(
+   sub {
+      my $row = $replica_dbh->selectrow_hashref("show ${replica_name} status");
+      return $row->{last_sql_errno};
+   }
+);
+
+my $r = $replica_dbh->selectrow_hashref("show ${replica_name} status");
+like($r->{last_error}, qr/Table 'test.t' doesn't exist'/, 'It is busted');
+
+# Start an instance
+diag(`$trunk/bin/pt-replica-restart --max-sleep 0.25 -h 127.0.0.1 -P 12346 -u msandbox -p msandbox --daemonize --pid /tmp/pt-replica-restart.pid --log /tmp/pt-replica-restart.log`);
+my $output = `ps x | grep 'pt-replica-restart \-\-max\-sleep ' | grep -v grep | grep -v pt-replica-restart.t`;
+like($output, qr/pt-replica-restart --max/, 'It lives');
+
+unlike($output, qr/Table 'test.t' doesn't exist'/, 'It is not busted');
+
+ok(-f '/tmp/pt-replica-restart.pid', 'PID file created');
+ok(-f '/tmp/pt-replica-restart.log', 'Log file created');
+
+my ($pid) = $output =~ /^\s*(\d+)\s+/;
+$output = `cat /tmp/pt-replica-restart.pid`;
+chomp($output);
+is($output, $pid, 'PID file has correct PID');
+
+diag(`$trunk/bin/pt-replica-restart --stop -q`);
+sleep 1;
+$output = `ps -eaf | grep pt-replica-restart | grep -v grep`;
+unlike($output, qr/pt-replica-restart --max/, 'It is dead');
+
+diag(`rm -f /tmp/pt-replica-re*`);
+ok(! -f '/tmp/pt-replica-restart.pid', 'PID file removed');
+
+# #############################################################################
+# Issue 118: pt-replica-restart --error-numbers option is broken
+# #############################################################################
+$output = `$trunk/bin/pt-replica-restart --stop --sentinel /tmp/pt-replica-restartup --error-numbers=1205,1317`;
+like($output, qr{Successfully created file /tmp/pt-replica-restartup}, '--error-numbers works (issue 118)');
+
+diag(`rm -f /tmp/pt-replica-re*`);
+
+# #############################################################################
+# Issue 459: mk-slave-restart --error-text is broken
+# #############################################################################
+# Bust replication again.  At this point, the source has test.t but
+# the replica does not.
+$source_dbh->do('DROP TABLE IF EXISTS test.t');
+$source_dbh->do('CREATE TABLE test.t (a INT)');
+sleep 1;
+$replica_dbh->do('DROP TABLE test.t');
+$source_dbh->do('INSERT INTO test.t SELECT 1');
+$output = `/tmp/12346/use -e "show ${replica_name} status"`;
+like(
+   $output,
+   qr/Table 'test.t' doesn't exist'/,
+   'It is busted again'
+);
+
+# Start an instance
+$output = `$trunk/bin/pt-replica-restart --max-sleep 0.25 -h 127.0.0.1 -P 12346 -u msandbox -p msandbox --error-text "doesn't exist" --run-time 1s 2>&1`;
+unlike(
+   $output,
+   qr/Error does not match/,
+   '--error-text works (issue 459)'
+);
+
+# ###########################################################################
+# Issue 391: Add --pid option to all scripts
+# ###########################################################################
+`touch /tmp/pt-script.pid`;
+$output = `$trunk/bin/pt-replica-restart --max-sleep 0.25 -h 127.0.0.1 -P 12346 -u msandbox -p msandbox --pid /tmp/pt-script.pid 2>&1`;
+like(
+   $output,
+   qr{PID file /tmp/pt-script.pid exists},
+   'Dies if PID file already exists (--pid without --daemonize) (issue 391)'
+);
+`rm -rf /tmp/pt-script.pid`;
+
+# #############################################################################
+# Issue 662: Option maxlength does not exist
+# #############################################################################
+my $ret = system("$trunk/bin/pt-replica-restart -h 127.0.0.1 -P 12346 -u msandbox -p msandbox --monitor --stop --max-sleep 1 --run-time 1 >/dev/null 2>&1");
+is(
+   $ret >> 8,
+   0,
+   "--monitor --stop doesn't cause error"
+);
+
+# #############################################################################
+#  Issue 673: Use of uninitialized value in numeric gt (>)
+# #############################################################################
+$output = `$trunk/bin/pt-replica-restart --monitor  --error-numbers 1205,1317 --quiet -F /tmp/12346/my.sandbox.cnf  --run-time 1 2>&1`;
+is(
+   $output,
+   '',
+   'No error with --quiet (issue 673)'
+);
+
+# #############################################################################
+# Done.
+# #############################################################################
+diag(`rm -f /tmp/pt-replica-re*`);
+diag(`$trunk/sandbox/test-env restart`);
+ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
+done_testing;
diff --git a/t/pt-slave-restart/pt-slave-restart.t b/t/pt-replica-restart/pt-slave-restart.t
similarity index 96%
rename from t/pt-slave-restart/pt-slave-restart.t
rename to t/pt-replica-restart/pt-slave-restart.t
index 46b7a101..3cd3a516 100644
--- a/t/pt-slave-restart/pt-slave-restart.t
+++ b/t/pt-replica-restart/pt-slave-restart.t
@@ -131,6 +131,7 @@ is(
 #  Issue 673: Use of uninitialized value in numeric gt (>)
 # #############################################################################
 $output = `$trunk/bin/pt-slave-restart --monitor  --error-numbers 1205,1317 --quiet -F /tmp/12346/my.sandbox.cnf  --run-time 1 2>&1`;
+$output =~ s/pt-slave-restart is a link to pt-replica-restart.\nThis file name is deprecated and will be removed in future releases. Use pt-replica-restart instead.\n\n//;
 is(
    $output,
    '',