Merge lp:~percona-toolkit-dev/percona-toolkit/remove-pt-agent into lp:~percona-toolkit-dev/percona-toolkit/release-2.2.8

[Daniel Nichter]

[Daniel Nichter (daniel-nichter)]

review: Approve

[lp:~percona-toolkit-dev/percona-toolkit/remove-pt-agent]

600. By Daniel Nichter on 2014-04-26

Remove pt-agent.

=== modified file 'Changelog'
--- Changelog	2014-02-20 08:10:16 +0000
+++ Changelog	2014-04-26 04:29:24 +0000
@@ -1,5 +1,7 @@
 Changelog for Percona Toolkit
 
+  * Removed pt-agent
+
 v2.2.7 released 2014-02-20
 
   * Fixed bug 1279502: --version-check behaves like spyware
 
=== removed file 'bin/pt-agent'
--- bin/pt-agent	2014-02-20 08:10:16 +0000
+++ bin/pt-agent	1970-01-01 00:00:00 +0000
@@ -1,9802 +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
-      Lmo::Utils
-      Lmo::Meta
-      Lmo::Object
-      Lmo::Types
-      Lmo
-      Percona::WebAPI::Representation
-      Percona::WebAPI::Client
-      Percona::WebAPI::Exception::Request
-      Percona::WebAPI::Exception::Resource
-      Percona::WebAPI::Resource::Agent
-      Percona::WebAPI::Resource::Config
-      Percona::WebAPI::Resource::Service
-      Percona::WebAPI::Resource::Task
-      Percona::WebAPI::Resource::LogEntry
-      VersionCheck
-      DSNParser
-      OptionParser
-      Cxn
-      Quoter
-      VersionParser
-      Daemon
-      Transformers
-      Safeguards
-      Percona::Agent::Logger
-   ));
-}
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/Percona/Toolkit.pm
-#   t/lib/Percona/Toolkit.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::Toolkit;
-
-our $VERSION = '2.2.7';
-
-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
-# ###########################################################################
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/Lmo/Utils.pm
-#   t/lib/Lmo/Utils.t
-# See https://launchpad.net/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 Bazaar repository at,
-#   lib/Lmo/Meta.pm
-#   t/lib/Lmo/Meta.t
-# See https://launchpad.net/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 Bazaar repository at,
-#   lib/Lmo/Object.pm
-#   t/lib/Lmo/Object.t
-# See https://launchpad.net/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 Bazaar repository at,
-#   lib/Lmo/Types.pm
-#   t/lib/Lmo/Types.t
-# See https://launchpad.net/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_constaints {
-   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 Bazaar repository at,
-#   lib/Lmo.pm
-#   t/lib/Lmo.t
-# See https://launchpad.net/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_constaints($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
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Representation package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Representation.pm
-#   t/lib/Percona/WebAPI/Representation.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Representation;
-
-eval {
-   require JSON;
-};
-
-require Exporter;
-our @ISA       = qw(Exporter);
-our @EXPORT_OK = qw(
-   as_hashref
-   as_json
-   as_config
-);
-
-sub as_hashref {
-   my ($resource, %args) = @_;
-
-   my $as_hashref = { %$resource };
-
-   if ( !defined $args{with_links} || !$args{with_links} ) {
-      delete $as_hashref->{links};
-   }
-
-   return $as_hashref;
-}
-
-sub as_json {
-   my ($resource, %args) = @_;
-
-   my $json = $args{json} || JSON->new;
-   $json->allow_blessed([]);
-   $json->convert_blessed([]);
-
-   my $text = $json->encode(
-      ref $resource eq 'ARRAY' ? $resource : as_hashref($resource, %args)
-   );
-   if ( $args{json} && $text ) {  # for testing
-      chomp($text);
-      $text .= "\n";
-   }
-   return $text;
-}
-
-sub as_config {
-   my $resource = shift;
-   if ( !$resource->isa('Percona::WebAPI::Resource::Config') ) {
-      die "Only Config resources can be represented as config.\n";
-   }
-   my $as_hashref = as_hashref($resource);
-   my $options    = $as_hashref->{options};
-   my $config     = join("\n",
-      map { defined $options->{$_} ?  "$_=$options->{$_}" : "$_" }
-      sort keys %$options
-   ) . "\n";
-   return $config;
-}
-
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Representation package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Client package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Client.pm
-#   t/lib/Percona/WebAPI/Client.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Client;
-
-our $VERSION = '0.01';
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-eval {
-   require LWP;
-   require JSON;
-};
-
-use Scalar::Util qw(blessed); 
-
-use Lmo;
-use Percona::Toolkit;
-use Percona::WebAPI::Representation;
-use Percona::WebAPI::Exception::Request;
-use Percona::WebAPI::Exception::Resource;
-
-Percona::WebAPI::Representation->import(qw(as_json));
-Percona::Toolkit->import(qw(_d Dumper have_required_args));
-
-has 'api_key' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'entry_link' => (
-   is       => 'rw',
-   isa      => 'Str',
-   required => 0,
-   default  => sub { return 'https://cloud-api.percona.com' },
-);
-
-has 'ua' => (
-   is       => 'rw',
-   isa      => 'Object',
-   lazy     => 1,
-   required => 0,
-   builder  => '_build_ua',
-);
-
-has 'response' => (
-   is       => 'rw',
-   isa      => 'Object',
-   required => 0,
-   default  => undef,
-);
-
-sub _build_ua {
-   my $self = shift;
-   my $ua = LWP::UserAgent->new;
-   $ua->agent("Percona::WebAPI::Client/$Percona::WebAPI::Client::VERSION");
-   $ua->default_header('Content-Type', 'application/json');
-   $ua->default_header('X-Percona-API-Key', $self->api_key);
-   return $ua;
-}
-
-sub get {
-   my ($self, %args) = @_;
-   
-   have_required_args(\%args, qw(
-      link
-   )) or die;
-   my ($link) = $args{link};
-
-   eval {
-      $self->_request(
-         method => 'GET',
-         link   => $link,
-      );
-   };
-   if ( my $e = $EVAL_ERROR ) {
-      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
-         die $e;
-      }
-      else {
-         die "Unknown error: $e";
-      }
-   }
-
-   my $resource = eval {
-      JSON::decode_json($self->response->content);
-   };
-   if ( $EVAL_ERROR ) {
-      warn sprintf "Error decoding resource: %s: %s",
-         $self->response->content,
-         $EVAL_ERROR;
-      return;
-   }
-
-   my $resource_objects;
-   if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
-      eval {
-         $type = "Percona::WebAPI::Resource::$type";
-         if ( ref $resource eq 'ARRAY' ) {
-            PTDEBUG && _d('Got a list of', $type, 'resources');
-            $resource_objects = [];
-            foreach my $attribs ( @$resource ) {
-               my $obj = $type->new(%$attribs);
-               push @$resource_objects, $obj;
-            }
-         }
-         else {
-            PTDEBUG && _d('Got a', $type, 'resource', Dumper($resource));
-            $resource_objects = $type->new(%$resource);
-         }
-      };
-      if ( my $e = $EVAL_ERROR ) {
-         die Percona::WebAPI::Exception::Resource->new(
-            type  => $type,
-            link  => $link,
-            data  => (ref $resource eq 'ARRAY' ? $resource : [ $resource ]),
-            error => $e,
-         );
-      }
-   }
-   elsif ( exists $resource->{links} ) {
-      $resource_objects = $resource->{links};
-   }
-   elsif ( exists $resource->{pong} ) {
-      PTDEBUG && _d("Ping pong!");
-   }
-   else {
-      warn "Did not get X-Percona-Resource-Type or links from $link\n";
-   }
-
-   return $resource_objects;
-}
-
-sub post {
-   my $self = shift;
-   $self->_set(
-      @_,
-      method => 'POST',
-   );
-   return $self->response->header('Location');
-}
-
-sub put {
-   my $self = shift;
-   $self->_set(
-      @_,
-      method => 'PUT',
-   );
-   return $self->response->header('Location');
-}
-
-sub delete {
-   my ($self, %args) = @_;
-   have_required_args(\%args, qw(
-      link 
-   )) or die;
-   my ($link) = $args{link};
-
-   eval {
-      $self->_request(
-         method  => 'DELETE',
-         link    => $link,
-         headers => { 'Content-Length' => 0 },
-      ); 
-   };
-   if ( my $e = $EVAL_ERROR ) {
-      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
-         die $e;
-      }
-      else {
-         die "Unknown error: $e";
-      }
-   }
-
-   return;
-}
-
-sub _set {
-   my ($self, %args) = @_;
-   have_required_args(\%args, qw(
-      method
-      resources
-      link
-   )) or die;
-   my $method = $args{method};
-   my $res    = $args{resources};
-   my $link   = $args{link};
-
-   my $headers = $args{headers};
-
-   my $content = '';
-   if ( ref($res) eq 'ARRAY' ) {
-      PTDEBUG && _d('List of resources');
-      $content = '[' . join(",\n", map { as_json($_) } @$res) . ']';
-   }
-   elsif ( ref($res) ) {
-      PTDEBUG && _d('Resource object');
-      $content = as_json($res);
-   }
-   elsif ( $res !~ m/\n/ && -f $res ) {
-      PTDEBUG && _d('List of resources in file', $res);
-      $content = '[';
-      my $data = do {
-         local $INPUT_RECORD_SEPARATOR = undef;
-         open my $fh, '<', $res
-            or die "Error opening $res: $OS_ERROR";
-         <$fh>;
-      };
-      $data =~ s/,?\s*$/]/;
-      $content .= $data;
-   }
-   else {
-      PTDEBUG && _d('Resource text');
-      $content = $res;
-   }
-
-   eval {
-      $self->_request(
-         method  => $method,
-         link    => $link,
-         content => $content,
-         headers => $headers,
-      );
-   };
-   if ( my $e = $EVAL_ERROR ) {
-      if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
-         die $e;
-      }
-      else {
-         die "Unknown error: $e";
-      }
-   }
-
-   return;
-}
-
-sub _request {
-   my ($self, %args) = @_;
-
-   have_required_args(\%args, qw(
-      method
-      link 
-   )) or die;
-   my $method = $args{method};
-   my $link   = $args{link};
-   
-   my $content = $args{content};
-   my $headers = $args{headers};
-
-   my $req = HTTP::Request->new($method => $link);
-   if ( $content ) {
-      $req->content($content);
-   }
-   if ( $headers ) {
-      map { $req->header($_ => $headers->{$_}) } keys %$headers;
-   }
-   PTDEBUG && _d('Request', $method, $link, Dumper($req));
-
-   my $response = $self->ua->request($req);
-   PTDEBUG && _d('Response', Dumper($response));
-
-   $self->response($response);
-
-   if ( !($response->code >= 200 && $response->code < 400) ) {
-      die Percona::WebAPI::Exception::Request->new(
-         method  => $method,
-         url     => $link,
-         content => $content,
-         status  => $response->code,
-         error   => "Failed to $method $link",
-      );
-   }
-
-   return;
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Client package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Exception::Request package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Exception/Request.pm
-#   t/lib/Percona/WebAPI/Exception/Request.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Exception::Request;
-
-use Lmo;
-use overload '""' => \&as_string;
-
-has 'method' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'url' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'content' => (
-   is       => 'ro',
-   isa      => 'Maybe[Str]',
-   required => 0,
-);
-
-has 'status' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'error' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-sub as_string {
-   my $self = shift;
-   chomp(my $error = $self->error);
-   $error =~ s/\n/ /g;
-   return sprintf "%s\nRequest: %s %s %s\nStatus: %d\n",
-      $error, $self->method, $self->url, $self->content || '', $self->status;
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Exception::Request package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Exception::Resource package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Exception/Resource.pm
-#   t/lib/Percona/WebAPI/Exception/Resource.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Exception::Resource;
-
-use Lmo;
-use overload '""' => \&as_string;
-use Data::Dumper;
-
-has 'type' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'link' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'data' => (
-   is       => 'ro',
-   isa      => 'ArrayRef',
-   required => 1,
-);
-
-has 'error' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-sub as_string {
-   my $self = shift;
-   chomp(my $error = $self->error);
-   local $Data::Dumper::Indent    = 1;
-   local $Data::Dumper::Sortkeys  = 1;
-   local $Data::Dumper::Quotekeys = 0;
-   return sprintf "Invalid %s resource from %s:\n\n%s\nError: %s\n\n",
-      $self->type, $self->link, Dumper($self->data), $error;
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Exception::Resource package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Resource::Agent package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Resource/Agent.pm
-#   t/lib/Percona/WebAPI/Resource/Agent.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Resource::Agent;
-
-use Lmo;
-
-has 'uuid' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 0,
-);
-
-has 'username' => (
-   is       => 'rw',
-   isa      => 'Str',
-   required => 0,
-   default  => sub { return $ENV{USER} || $ENV{LOGNAME} },
-);
-
-has 'hostname' => (
-   is       => 'rw',
-   isa      => 'Str',
-   required => 0,
-   default  => sub {
-      chomp(my $hostname = `hostname`);
-      return $hostname;
-   },
-);
-
-has 'alias' => (
-   is       => 'rw',
-   isa      => 'Str',
-   required => 0,
-);
-
-has 'versions' => (
-   is       => 'rw',
-   isa      => 'Maybe[HashRef]',
-   required => 0,
-);
-
-has 'links' => (
-   is       => 'rw',
-   isa      => 'Maybe[HashRef]',
-   required => 0,
-   default  => sub { return {} },
-);
-
-sub name {
-   my ($self) = @_;
-   return $self->alias || $self->hostname || $self->uuid || 'Unknown';
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Resource::Agent package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Resource::Config package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Resource/Config.pm
-#   t/lib/Percona/WebAPI/Resource/Config.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Resource::Config;
-
-use Lmo;
-
-has 'ts' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'name' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'options' => (
-   is       => 'ro',
-   isa      => 'HashRef',
-   required => 1,
-);
-
-has 'links' => (
-   is       => 'rw',
-   isa      => 'Maybe[HashRef]',
-   required => 0,
-   default  => sub { return {} },
-);
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Resource::Config package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Resource::Service package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Resource/Service.pm
-#   t/lib/Percona/WebAPI/Resource/Service.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Resource::Service;
-
-use Lmo;
-
-has 'ts' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'name' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'tasks' => (
-   is       => 'ro',
-   isa      => 'ArrayRef[Percona::WebAPI::Resource::Task]',
-   required => 1,
-);
-
-has 'run_schedule' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 0,
-);
-
-has 'spool_schedule' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 0,
-);
-
-has 'meta' => (
-   is       => 'ro',
-   isa      => 'Bool',
-   required => 0,
-   default  => sub { return 0 },
-);
-
-has 'run_once' => (
-   is       => 'ro',
-   isa      => 'Bool',
-   required => 0,
-   default  => sub { return 0 },
-);
-
-has 'links' => (
-   is       => 'rw',
-   isa      => 'Maybe[HashRef]',
-   required => 0,
-   default  => sub { return {} },
-);
-
-sub BUILDARGS {
-   my ($class, %args) = @_;
-   if ( ref $args{tasks} eq 'ARRAY' ) {
-      my @tasks;
-      foreach my $run_hashref ( @{$args{tasks}} ) {
-         my $task = Percona::WebAPI::Resource::Task->new(%$run_hashref);
-         push @tasks, $task;
-      }
-      $args{tasks} = \@tasks;
-   }
-   return $class->SUPER::BUILDARGS(%args);
-}
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Resource::Service package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Resource::Task package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Resource/Task.pm
-#   t/lib/Percona/WebAPI/Resource/Task.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Resource::Task;
-
-use Lmo;
-
-has 'name' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'number' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'program' => (
-   is       => 'ro',
-   isa      => 'Maybe[Str]',
-   required => 0,
-);
-
-has 'query' => (
-   is       => 'ro',
-   isa      => 'Maybe[Str]',
-   required => 0,
-);
-
-has 'output' => (
-   is       => 'ro',
-   isa      => 'Maybe[Str]',
-   required => 0,
-);
-
-sub TO_JSON { return { %{ shift() } }; }
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Resource::Task package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::WebAPI::Resource::LogEntry package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/WebAPI/Resource/LogEntry.pm
-#   t/lib/Percona/WebAPI/Resource/LogEntry.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::WebAPI::Resource::LogEntry;
-
-use Lmo;
-
-has 'pid' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'service' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 0,
-);
-
-has 'data_ts' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 0,
-);
-
-has 'entry_ts' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-has 'log_level' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'message' => (
-   is       => 'ro',
-   isa      => 'Str',
-   required => 1,
-);
-
-no Lmo;
-1;
-}
-# ###########################################################################
-# End Percona::WebAPI::Resource::LogEntry 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 Bazaar repository at,
-#   lib/VersionCheck.pm
-#   t/lib/VersionCheck.t
-# See https://launchpad.net/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 $file    = 'percona-version-check';
-   my $home    = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
-   my @vc_dirs = (
-      '/etc/percona',
-      '/etc/percona-toolkit',
-      '/tmp',
-      "$home",
-   );
-
-   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") ) {
-         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';  # optimistic, but...
-      eval { require IO::Socket::SSL; };
-      if ( $EVAL_ERROR ) {
-         PTDEBUG && _d($EVAL_ERROR);
-         $protocol = 'http';
-      }
-      PTDEBUG && _d('Using', $protocol);
-
-      my $advice = pingback(
-         instances => $instances_to_check,
-         protocol  => $protocol,
-         url       => $args{url}                       # testing
-                   || $ENV{PERCONA_VERSION_CHECK_URL}  # testing
-                   || "$protocol://v.percona.com",
-      );
-      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('Intsance', $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 pingback {
-   my (%args) = @_;
-   my @required_args = qw(url instances);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg arugment" 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 => md5_hex( hostname() ),
-   );
-
-   my $client_response = {
-      headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) },
-      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 arugment" 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 arugment" 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,
-);
-
-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 arugment" 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_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;
-   }
-
-   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
-# ###########################################################################
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/DSNParser.pm
-#   t/lib/DSNParser.t
-# See https://launchpad.net/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))
-         . ';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    pgk 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;
-
-      $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";
-      }
-
-      if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
-         $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";
-         }
-         PTDEBUG && _d('Enabling charset for STDOUT');
-         if ( $charset eq 'utf8' ) {
-            binmode(STDOUT, ':utf8')
-               or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
-         }
-         else {
-            binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
-         }
-      }
-
-      if ( my $vars = $self->prop('set-vars') ) {
-         $self->set_vars($dbh, $vars);
-      }
-
-      $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
-# ###########################################################################
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/OptionParser.pm
-#   t/lib/OptionParser.t
-# See https://launchpad.net/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,
-   );
-
-   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'),
-         };
-      }
-      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_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 {
-         $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] 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";
-      }
-      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);
-      $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
-   }
-   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 $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
-         && (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
-# ###########################################################################
-
-# ###########################################################################
-# Cxn package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Cxn.pm
-#   t/lib/Cxn.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Cxn;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use Scalar::Util qw(blessed);
-use constant {
-   PTDEBUG => $ENV{PTDEBUG} || 0,
-   PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0,
-};
-
-sub new {
-   my ( $class, %args ) = @_;
-   my @required_args = qw(DSNParser OptionParser);
-   foreach my $arg ( @required_args ) {
-      die "I need a $arg argument" unless $args{$arg};
-   };
-   my ($dp, $o) = @args{@required_args};
-
-   my $dsn_defaults = $dp->parse_options($o);
-   my $prev_dsn     = $args{prev_dsn};
-   my $dsn          = $args{dsn};
-   if ( !$dsn ) {
-      $args{dsn_string} ||= 'h=' . ($dsn_defaults->{h} || 'localhost');
-
-      $dsn = $dp->parse(
-         $args{dsn_string}, $prev_dsn, $dsn_defaults);
-   }
-   elsif ( $prev_dsn ) {
-      $dsn = $dp->copy($prev_dsn, $dsn);
-   }
-
-   my $dsn_name = $dp->as_string($dsn, [qw(h P S)])
-               || $dp->as_string($dsn, [qw(F)])
-               || '';
-
-   my $self = {
-      dsn             => $dsn,
-      dbh             => $args{dbh},
-      dsn_name        => $dsn_name,
-      hostname        => '',
-      set             => $args{set},
-      NAME_lc         => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
-      dbh_set         => 0,
-      ask_pass        => $args{ask_pass},
-      DSNParser       => $dp,
-      is_cluster_node => undef,
-      parent          => $args{parent},
-   };
-
-   return bless $self, $class;
-}
-
-sub connect {
-   my ( $self, %opts ) = @_;
-   my $dsn = $opts{dsn} || $self->{dsn};
-   my $dp  = $self->{DSNParser};
-
-   my $dbh = $self->{dbh};
-   if ( !$dbh || !$dbh->ping() ) {
-      if ( $self->{ask_pass} && !$self->{asked_for_pass} ) {
-         $dsn->{p} = OptionParser::prompt_noecho("Enter MySQL password: ");
-         $self->{asked_for_pass} = 1;
-      }
-      $dbh = $dp->get_dbh(
-         $dp->get_cxn_params($dsn),
-         {
-            AutoCommit => 1,
-            %opts,
-         },
-      );
-   }
-
-   $dbh = $self->set_dbh($dbh);
-   if ( $opts{dsn} ) {
-      $self->{dsn}      = $dsn;
-      $self->{dsn_name} = $dp->as_string($dsn, [qw(h P S)])
-                       || $dp->as_string($dsn, [qw(F)])
-                       || '';
-
-   }
-   PTDEBUG && _d($dbh, 'Connected dbh to', $self->{hostname},$self->{dsn_name});
-   return $dbh;
-}
-
-sub set_dbh {
-   my ($self, $dbh) = @_;
-
-   if ( $self->{dbh} && $self->{dbh} == $dbh && $self->{dbh_set} ) {
-      PTDEBUG && _d($dbh, 'Already set dbh');
-      return $dbh;
-   }
-
-   PTDEBUG && _d($dbh, 'Setting dbh');
-
-   $dbh->{FetchHashKeyName} = 'NAME_lc' if $self->{NAME_lc};
-
-   my $sql = 'SELECT @@server_id /*!50038 , @@hostname*/';
-   PTDEBUG && _d($dbh, $sql);
-   my ($server_id, $hostname) = $dbh->selectrow_array($sql);
-   PTDEBUG && _d($dbh, 'hostname:', $hostname, $server_id);
-   if ( $hostname ) {
-      $self->{hostname} = $hostname;
-   }
-
-   if ( $self->{parent} ) {
-      PTDEBUG && _d($dbh, 'Setting InactiveDestroy=1 in parent');
-      $dbh->{InactiveDestroy} = 1;
-   }
-
-   if ( my $set = $self->{set}) {
-      $set->($dbh);
-   }
-
-   $self->{dbh}     = $dbh;
-   $self->{dbh_set} = 1;
-   return $dbh;
-}
-
-sub lost_connection {
-   my ($self, $e) = @_;
-   return 0 unless $e;
-   return $e =~ m/MySQL server has gone away/
-       || $e =~ m/Lost connection to MySQL server/;
-}
-
-sub dbh {
-   my ($self) = @_;
-   return $self->{dbh};
-}
-
-sub dsn {
-   my ($self) = @_;
-   return $self->{dsn};
-}
-
-sub name {
-   my ($self) = @_;
-   return $self->{dsn_name} if PERCONA_TOOLKIT_TEST_USE_DSN_NAMES;
-   return $self->{hostname} || $self->{dsn_name} || 'unknown host';
-}
-
-sub remove_duplicate_cxns {
-   my ($self, %args) = @_;
-   my @cxns     = @{$args{cxns}};
-   my $seen_ids = $args{seen_ids} || {};
-   PTDEBUG && _d("Removing duplicates from ", join(" ", map { $_->name } @cxns));
-   my @trimmed_cxns;
-
-   for my $cxn ( @cxns ) {
-      my $dbh  = $cxn->dbh();
-      my $sql  = q{SELECT @@server_id};
-      PTDEBUG && _d($sql);
-      my ($id) = $dbh->selectrow_array($sql);
-      PTDEBUG && _d('Server ID for ', $cxn->name, ': ', $id);
-
-      if ( ! $seen_ids->{$id}++ ) {
-         push @trimmed_cxns, $cxn
-      }
-      else {
-         PTDEBUG && _d("Removing ", $cxn->name,
-                       ", ID ", $id, ", because we've already seen it");
-      }
-   }
-
-   return \@trimmed_cxns;
-}
-
-sub DESTROY {
-   my ($self) = @_;
-
-   PTDEBUG && _d('Destroying cxn');
-
-   if ( $self->{parent} ) {
-      PTDEBUG && _d($self->{dbh}, 'Not disconnecting dbh in parent');
-   }
-   elsif ( $self->{dbh}
-           && blessed($self->{dbh})
-           && $self->{dbh}->can("disconnect") )
-   {
-      PTDEBUG && _d($self->{dbh}, 'Disconnecting dbh on', $self->{hostname},
-         $self->{dsn_name});
-      $self->{dbh}->disconnect();
-   }
-
-   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 Cxn 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 Bazaar repository at,
-#   lib/Quoter.pm
-#   t/lib/Quoter.t
-# See https://launchpad.net/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
-# ###########################################################################
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/VersionParser.pm
-#   t/lib/VersionParser.t
-# See https://launchpad.net/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
-# ###########################################################################
-
-# ###########################################################################
-# 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 Bazaar repository at,
-#   lib/Daemon.pm
-#   t/lib/Daemon.t
-# See https://launchpad.net/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,
-   };
-   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};
-
-   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";
-
-         close STDERR;
-         open  STDERR, ">&STDOUT"
-            or die "Cannot dupe STDERR to STDOUT: $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
-# ###########################################################################
-
-# ###########################################################################
-# Transformers package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Transformers.pm
-#   t/lib/Transformers.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Transformers;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use Time::Local qw(timegm timelocal);
-use Digest::MD5 qw(md5_hex);
-use B qw();
-
-BEGIN {
-   require Exporter;
-   our @ISA         = qw(Exporter);
-   our %EXPORT_TAGS = ();
-   our @EXPORT      = ();
-   our @EXPORT_OK   = qw(
-      micro_t
-      percentage_of
-      secs_to_time
-      time_to_secs
-      shorten
-      ts
-      parse_timestamp
-      unix_timestamp
-      any_unix_timestamp
-      make_checksum
-      crc32
-      encode_json
-   );
-}
-
-our $mysql_ts  = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
-our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;
-our $n_ts      = qr/(\d{1,5})([shmd]?)/; # Limit \d{1,5} because \d{6} looks
-
-sub micro_t {
-   my ( $t, %args ) = @_;
-   my $p_ms = defined $args{p_ms} ? $args{p_ms} : 0;  # precision for ms vals
-   my $p_s  = defined $args{p_s}  ? $args{p_s}  : 0;  # precision for s vals
-   my $f;
-
-   $t = 0 if $t < 0;
-
-   $t = sprintf('%.17f', $t) if $t =~ /e/;
-
-   $t =~ s/\.(\d{1,6})\d*/\.$1/;
-
-   if ($t > 0 && $t <= 0.000999) {
-      $f = ($t * 1000000) . 'us';
-   }
-   elsif ($t >= 0.001000 && $t <= 0.999999) {
-      $f = sprintf("%.${p_ms}f", $t * 1000);
-      $f = ($f * 1) . 'ms'; # * 1 to remove insignificant zeros
-   }
-   elsif ($t >= 1) {
-      $f = sprintf("%.${p_s}f", $t);
-      $f = ($f * 1) . 's'; # * 1 to remove insignificant zeros
-   }
-   else {
-      $f = 0;  # $t should = 0 at this point
-   }
-
-   return $f;
-}
-
-sub percentage_of {
-   my ( $is, $of, %args ) = @_;
-   my $p   = $args{p} || 0; # float precision
-   my $fmt = $p ? "%.${p}f" : "%d";
-   return sprintf $fmt, ($is * 100) / ($of ||= 1);
-}
-
-sub secs_to_time {
-   my ( $secs, $fmt ) = @_;
-   $secs ||= 0;
-   return '00:00' unless $secs;
-
-   $fmt ||= $secs >= 86_400 ? 'd'
-          : $secs >= 3_600  ? 'h'
-          :                   'm';
-
-   return
-      $fmt eq 'd' ? sprintf(
-         "%d+%02d:%02d:%02d",
-         int($secs / 86_400),
-         int(($secs % 86_400) / 3_600),
-         int(($secs % 3_600) / 60),
-         $secs % 60)
-      : $fmt eq 'h' ? sprintf(
-         "%02d:%02d:%02d",
-         int(($secs % 86_400) / 3_600),
-         int(($secs % 3_600) / 60),
-         $secs % 60)
-      : sprintf(
-         "%02d:%02d",
-         int(($secs % 3_600) / 60),
-         $secs % 60);
-}
-
-sub time_to_secs {
-   my ( $val, $default_suffix ) = @_;
-   die "I need a val argument" unless defined $val;
-   my $t = 0;
-   my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
-   $suffix = $suffix || $default_suffix || 's';
-   if ( $suffix =~ m/[smhd]/ ) {
-      $t = $suffix eq 's' ? $num * 1        # Seconds
-         : $suffix eq 'm' ? $num * 60       # Minutes
-         : $suffix eq 'h' ? $num * 3600     # Hours
-         :                  $num * 86400;   # Days
-
-      $t *= -1 if $prefix && $prefix eq '-';
-   }
-   else {
-      die "Invalid suffix for $val: $suffix";
-   }
-   return $t;
-}
-
-sub shorten {
-   my ( $num, %args ) = @_;
-   my $p = defined $args{p} ? $args{p} : 2;     # float precision
-   my $d = defined $args{d} ? $args{d} : 1_024; # divisor
-   my $n = 0;
-   my @units = ('', qw(k M G T P E Z Y));
-   while ( $num >= $d && $n < @units - 1 ) {
-      $num /= $d;
-      ++$n;
-   }
-   return sprintf(
-      $num =~ m/\./ || $n
-         ? "%.${p}f%s"
-         : '%d',
-      $num, $units[$n]);
-}
-
-sub ts {
-   my ( $time, $gmt ) = @_;
-   my ( $sec, $min, $hour, $mday, $mon, $year )
-      = $gmt ? gmtime($time) : localtime($time);
-   $mon  += 1;
-   $year += 1900;
-   my $val = sprintf("%d-%02d-%02dT%02d:%02d:%02d",
-      $year, $mon, $mday, $hour, $min, $sec);
-   if ( my ($us) = $time =~ m/(\.\d+)$/ ) {
-      $us = sprintf("%.6f", $us);
-      $us =~ s/^0\././;
-      $val .= $us;
-   }
-   return $val;
-}
-
-sub parse_timestamp {
-   my ( $val ) = @_;
-   if ( my($y, $m, $d, $h, $i, $s, $f)
-         = $val =~ m/^$mysql_ts$/ )
-   {
-      return sprintf "%d-%02d-%02d %02d:%02d:"
-                     . (defined $f ? '%09.6f' : '%02d'),
-                     $y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s);
-   }
-   elsif ( $val =~ m/^$proper_ts$/ ) {
-      return $val;
-   }
-   return $val;
-}
-
-sub unix_timestamp {
-   my ( $val, $gmt ) = @_;
-   if ( my($y, $m, $d, $h, $i, $s, $us) = $val =~ m/^$proper_ts$/ ) {
-      $val = $gmt
-         ? timegm($s, $i, $h, $d, $m - 1, $y)
-         : timelocal($s, $i, $h, $d, $m - 1, $y);
-      if ( defined $us ) {
-         $us = sprintf('%.6f', $us);
-         $us =~ s/^0\././;
-         $val .= $us;
-      }
-   }
-   return $val;
-}
-
-sub any_unix_timestamp {
-   my ( $val, $callback ) = @_;
-
-   if ( my ($n, $suffix) = $val =~ m/^$n_ts$/ ) {
-      $n = $suffix eq 's' ? $n            # Seconds
-         : $suffix eq 'm' ? $n * 60       # Minutes
-         : $suffix eq 'h' ? $n * 3600     # Hours
-         : $suffix eq 'd' ? $n * 86400    # Days
-         :                  $n;           # default: Seconds
-      PTDEBUG && _d('ts is now - N[shmd]:', $n);
-      return time - $n;
-   }
-   elsif ( $val =~ m/^\d{9,}/ ) {
-      PTDEBUG && _d('ts is already a unix timestamp');
-      return $val;
-   }
-   elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) {
-      PTDEBUG && _d('ts is MySQL slow log timestamp');
-      $val .= ' 00:00:00' unless $hms;
-      return unix_timestamp(parse_timestamp($val));
-   }
-   elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) {
-      PTDEBUG && _d('ts is properly formatted timestamp');
-      $val .= ' 00:00:00' unless $hms;
-      return unix_timestamp($val);
-   }
-   else {
-      PTDEBUG && _d('ts is MySQL expression');
-      return $callback->($val) if $callback && ref $callback eq 'CODE';
-   }
-
-   PTDEBUG && _d('Unknown ts type:', $val);
-   return;
-}
-
-sub make_checksum {
-   my ( $val ) = @_;
-   my $checksum = uc substr(md5_hex($val), -16);
-   PTDEBUG && _d($checksum, 'checksum for', $val);
-   return $checksum;
-}
-
-sub crc32 {
-   my ( $string ) = @_;
-   return unless $string;
-   my $poly = 0xEDB88320;
-   my $crc  = 0xFFFFFFFF;
-   foreach my $char ( split(//, $string) ) {
-      my $comp = ($crc ^ ord($char)) & 0xFF;
-      for ( 1 .. 8 ) {
-         $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1;
-      }
-      $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp;
-   }
-   return $crc ^ 0xFFFFFFFF;
-}
-
-my $got_json = eval { require JSON };
-sub encode_json {
-   return JSON::encode_json(@_) if $got_json;
-   my ( $data ) = @_;
-   return (object_to_json($data) || '');
-}
-
-
-sub object_to_json {
-   my ($obj) = @_;
-   my $type  = ref($obj);
-
-   if($type eq 'HASH'){
-      return hash_to_json($obj);
-   }
-   elsif($type eq 'ARRAY'){
-      return array_to_json($obj);
-   }
-   else {
-      return value_to_json($obj);
-   }
-}
-
-sub hash_to_json {
-   my ($obj) = @_;
-   my @res;
-   for my $k ( sort { $a cmp $b } keys %$obj ) {
-      push @res, string_to_json( $k )
-         .  ":"
-         . ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) );
-   }
-   return '{' . ( @res ? join( ",", @res ) : '' )  . '}';
-}
-
-sub array_to_json {
-   my ($obj) = @_;
-   my @res;
-
-   for my $v (@$obj) {
-      push @res, object_to_json($v) || value_to_json($v);
-   }
-
-   return '[' . ( @res ? join( ",", @res ) : '' ) . ']';
-}
-
-sub value_to_json {
-   my ($value) = @_;
-
-   return 'null' if(!defined $value);
-
-   my $b_obj = B::svref_2object(\$value);  # for round trip problem
-   my $flags = $b_obj->FLAGS;
-   return $value # as is 
-      if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
-
-   my $type = ref($value);
-
-   if( !$type ) {
-      return string_to_json($value);
-   }
-   else {
-      return 'null';
-   }
-
-}
-
-my %esc = (
-   "\n" => '\n',
-   "\r" => '\r',
-   "\t" => '\t',
-   "\f" => '\f',
-   "\b" => '\b',
-   "\"" => '\"',
-   "\\" => '\\\\',
-   "\'" => '\\\'',
-);
-
-sub string_to_json {
-   my ($arg) = @_;
-
-   $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
-   $arg =~ s/\//\\\//g;
-   $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
-
-   utf8::upgrade($arg);
-   utf8::encode($arg);
-
-   return '"' . $arg . '"';
-}
-
-sub _d {
-   my ($package, undef, $line) = caller 0;
-   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
-        map { defined $_ ? $_ : 'undef' }
-        @_;
-   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
-}
-
-1;
-}
-# ###########################################################################
-# End Transformers package
-# ###########################################################################
-
-# ###########################################################################
-# Safeguards package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Safeguards.pm
-#   t/lib/Safeguards.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Safeguards;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-sub new {
-   my ($class, %args) = @_;
-   my $self = {
-      disk_bytes_free => $args{disk_bytes_free} || 104857600,  # 100 MiB
-      disk_pct_free   => $args{disk_pct_free}   || 5,
-   };
-   return bless $self, $class;
-}
-
-sub get_disk_space {
-   my ($self, %args) = @_;
-   my $filesystem = $args{filesystem} || $ENV{PWD};
-
-   my $disk_space = `df -P -k "$filesystem"`;
-   chop($disk_space) if $disk_space;
-   PTDEBUG && _d('Disk space on', $filesystem, $disk_space);
-
-   return $disk_space;
-}
-
-sub check_disk_space() {
-   my ($self, %args) = @_;
-   my $disk_space = $args{disk_space};
-   PTDEBUG && _d("Checking disk space:\n", $disk_space);
-
-   my ($partition) = $disk_space =~ m/^\s*(\/.+)/m;
-   PTDEBUG && _d('Partition:', $partition);
-   die "Failed to parse partition from disk space:\n$disk_space"
-      unless $partition;
-
-   my (undef, undef, $bytes_used, $bytes_free, $pct_used, undef)
-      = $partition =~ m/(\S+)/g;
-   PTDEBUG && _d('Bytes used:', $bytes_used, 'free:', $bytes_free,
-      'Percentage used:', $pct_used);
-
-   $bytes_used = ($bytes_used || 0) * 1024;
-   $bytes_free = ($bytes_free || 0) * 1024;
-
-   $pct_used =~ s/%//;
-   my $pct_free = 100 - ($pct_used || 0);
-
-   return $bytes_free >= $self->{disk_bytes_free}
-       && $pct_free   >= $self->{disk_pct_free};
-}
-
-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 Safeguards package
-# ###########################################################################
-
-# ###########################################################################
-# Percona::Agent::Logger package
-# This package is a copy without comments from the original.  The original
-# with comments and its test file can be found in the Bazaar repository at,
-#   lib/Percona/Agent/Logger.pm
-#   t/lib/Percona/Agent/Logger.t
-# See https://launchpad.net/percona-toolkit for more information.
-# ###########################################################################
-{
-package Percona::Agent::Logger;
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-
-use constant PTDEBUG => $ENV{PTDEBUG} || 0;
-
-use POSIX qw(SIGALRM);
-
-use Lmo;
-use Transformers;
-use Percona::WebAPI::Resource::LogEntry;
-
-Transformers->import(qw(ts));
-
-has 'exit_status' => (
-   is       => 'rw',
-   isa      => 'ScalarRef',
-   required => 1,
-);
-
-has 'pid' => (
-   is       => 'ro',
-   isa      => 'Int',
-   required => 1,
-);
-
-has 'service' => (
-   is       => 'rw',
-   isa      => 'Maybe[Str]',
-   required => 0,
-   default  => sub { return; },
-);
-
-has 'data_ts' => (
-   is       => 'rw',
-   isa      => 'Maybe[Int]',
-   required => 0,
-   default  => sub { return; },
-);
-
-has 'online_logging' => (
-   is       => 'ro',
-   isa      => 'Bool',
-   required => 0,
-   default  => sub { return 1 },
-);
-
-has 'online_logging_enabled' => (
-   is       => 'rw',
-   isa      => 'Bool',
-   required => 0,
-   default  => sub { return 0 },
-);
-
-has 'quiet' => (
-   is       => 'rw',
-   isa      => 'Int',
-   required => 0,
-   default  => sub { return 0 },
-);
-
-has '_buffer' => (
-   is       => 'rw',
-   isa      => 'ArrayRef',
-   required => 0,
-   default  => sub { return []; },
-);
-
-has '_pipe_write' => (
-   is       => 'rw',
-   isa      => 'Maybe[FileHandle]',
-   required => 0,
-);
-
-sub read_stdin {
-   my ( $t ) = @_;
-
-   POSIX::sigaction(
-      SIGALRM,
-      POSIX::SigAction->new(sub { die 'read timeout'; }),
-   ) or die "Error setting SIGALRM handler: $OS_ERROR";
-
-   my $timeout = 0;
-   my @lines;
-   eval {
-      alarm $t;
-      while(defined(my $line = <STDIN>)) {
-         push @lines, $line;
-      }
-      alarm 0;
-   };
-   if ( $EVAL_ERROR ) {
-      PTDEBUG && _d('Read error:', $EVAL_ERROR);
-      die $EVAL_ERROR unless $EVAL_ERROR =~ m/read timeout/;
-      $timeout = 1;
-   }
-   return unless scalar @lines || $timeout;
-   return \@lines;
-}
-
-sub start_online_logging {
-   my ($self, %args) = @_;
-   my $client       = $args{client};
-   my $log_link     = $args{log_link};
-   my $read_timeout = $args{read_timeout} || 3;
-
-   return unless $self->online_logging;
-
-   my $pid = open(my $pipe_write, "|-");
-
-   if ($pid) {
-      select $pipe_write;
-      $OUTPUT_AUTOFLUSH = 1;
-      $self->_pipe_write($pipe_write);
-      $self->online_logging_enabled(1);
-   }
-   else {
-      my @log_entries;
-      my $n_errors = 0;
-      my $oktorun  = 1;
-      QUEUE:
-      while ($oktorun) {
-         my $lines = read_stdin($read_timeout);
-         last QUEUE unless $lines;
-         LINE: