Merge lp:~percona-toolkit-dev/percona-toolkit/pt-deadlock-logger-2.2 into lp:~percona-toolkit-dev/percona-toolkit/pt-fke-logger-2.2

[Daniel Nichter]

[Daniel Nichter (daniel-nichter)]

Passes all its tests.

review: Approve

=== modified file 'bin/pt-deadlock-logger'
--- bin/pt-deadlock-logger	2013-02-22 17:47:57 +0000
+++ bin/pt-deadlock-logger	2013-02-26 01:08:24 +0000
@@ -23,9 +23,11 @@
       VersionParser
       Quoter
       DSNParser
+      Cxn
       Daemon
       HTTPMicro
       VersionCheck
+      Runtime
    ));
 }
 
@@ -2439,6 +2441,177 @@
 # ###########################################################################
 
 # ###########################################################################
+# 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 $self = {
+      dsn             => $dsn,
+      dbh             => $args{dbh},
+      dsn_name        => $dp->as_string($dsn, [qw(h P S)]),
+      hostname        => '',
+      set             => $args{set},
+      NAME_lc         => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
+      dbh_set         => 0,
+      OptionParser    => $o,
+      DSNParser       => $dp,
+      is_cluster_node => undef,
+      parent          => $args{parent},
+   };
+
+   return bless $self, $class;
+}
+
+sub connect {
+   my ( $self, %opts ) = @_;
+   my $dsn = $self->{dsn};
+   my $dp  = $self->{DSNParser};
+   my $o   = $self->{OptionParser};
+
+   my $dbh = $self->{dbh};
+   if ( !$dbh || !$dbh->ping() ) {
+      if ( $o->get('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,
+         },
+      );
+   }
+   PTDEBUG && _d($dbh, 'Connected dbh to', $self->{name});
+
+   return $self->set_dbh($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 @@hostname, @@server_id';
+   PTDEBUG && _d($dbh, $sql);
+   my ($hostname, $server_id) = $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 DESTROY {
+   my ($self) = @_;
+
+   if ( $self->{parent} ) {
+      PTDEBUG && _d('Not disconnecting dbh in parent');
+   }
+   elsif ( $self->{dbh}
+           && blessed($self->{dbh})
+           && $self->{dbh}->can("disconnect") )
+   {
+      PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{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
+# ###########################################################################
+
+# ###########################################################################
 # 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,
@@ -3865,6 +4038,139 @@
 # ###########################################################################
 
 # ###########################################################################
+# Runtime 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/Runtime.pm
+#   t/lib/Runtime.t
+# See https://launchpad.net/percona-toolkit for more information.
+# ###########################################################################
+{
+package Runtime;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+sub new {
+   my ( $class, %args ) = @_;
+   my @required_args = qw(run_time now);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless exists $args{$arg};
+   }
+
+   my $run_time = $args{run_time};
+   if ( defined $run_time ) {
+      die "run_time must be > 0" if $run_time <= 0;
+   }
+
+   my $now = $args{now};
+   die "now must be a callback" unless ref $now eq 'CODE';
+
+   my $self = {
+      run_time   => $run_time,
+      now        => $now,
+      start_time => undef,
+      end_time   => undef,
+      time_left  => undef,
+      stop       => 0,
+   };
+
+   return bless $self, $class;
+}
+
+sub time_left {
+   my ( $self, %args ) = @_;
+
+   if ( $self->{stop} ) {
+      PTDEBUG && _d("No time left because stop was called");
+      return 0;
+   }
+
+   my $now = $self->{now}->(%args);
+   PTDEBUG && _d("Current time:", $now);
+
+   if ( !defined $self->{start_time} ) {
+      $self->{start_time} = $now;
+   }
+
+   return unless defined $now;
+
+   my $run_time = $self->{run_time};
+   return unless defined $run_time;
+
+   if ( !$self->{end_time} ) {
+      $self->{end_time} = $now + $run_time;
+      PTDEBUG && _d("End time:", $self->{end_time});
+   }
+
+   $self->{time_left} = $self->{end_time} - $now;
+   PTDEBUG && _d("Time left:", $self->{time_left});
+   return $self->{time_left};
+}
+
+sub have_time {
+   my ( $self, %args ) = @_;
+   my $time_left = $self->time_left(%args);
+   return 1 if !defined $time_left;  # run forever
+   return $time_left <= 0 ? 0 : 1;   # <=0s means run time has elapsed
+}
+
+sub time_elapsed {
+   my ( $self, %args ) = @_;
+
+   my $start_time = $self->{start_time};
+   return 0 unless $start_time;
+
+   my $now = $self->{now}->(%args);
+   PTDEBUG && _d("Current time:", $now);
+
+   my $time_elapsed = $now - $start_time;
+   PTDEBUG && _d("Time elapsed:", $time_elapsed);
+   if ( $time_elapsed < 0 ) {
+      warn "Current time $now is earlier than start time $start_time";
+   }
+   return $time_elapsed;
+}
+
+sub reset {
+   my ( $self ) = @_;
+   $self->{start_time} = undef;
+   $self->{end_time}   = undef;
+   $self->{time_left}  = undef;
+   $self->{stop}       = 0;
+   PTDEBUG && _d("Reset run time");
+   return;
+}
+
+sub stop {
+   my ( $self ) = @_;
+   $self->{stop} = 1;
+   return;
+}
+
+sub start {
+   my ( $self ) = @_;
+   $self->{stop} = 0;
+   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 Runtime package
+# ###########################################################################
+
+# ###########################################################################
 # This is a combination of modules and programs in one -- a runnable module.
 # http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
 # Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
@@ -3877,21 +4183,15 @@
 use English qw(-no_match_vars);
 use List::Util qw(max);
 use Socket qw(inet_aton);
-use sigtrap qw(handler finish untrapped normal-signals);
+use Time::HiRes qw(sleep);
+use File::Temp qw(tempfile);
+use File::Spec;
+
+use sigtrap 'handler', \&sig_int, 'normal-signals';
 
 use Percona::Toolkit;
 use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
-my $o;
-my $oktorun;
-my $dp;
-
-# ########################################################################
-# Configuration info.
-# ########################################################################
-my $source_dsn;
-my $dest_dsn;
-
 # Some common patterns and variables
 my $d = qr/(\d+)/;                    # Digit
 my $t  = qr/((?:\d+ \d+)|(?:[A-Fa-f0-9]+))/;                # Transaction ID
@@ -3934,48 +4234,54 @@
    'update'                       => 1,
 );
 
+my $oktorun     = 1;
+my $exit_status = 0;
+
 sub main {
-   local @ARGV = @_;  # set global ARGV for this package
-
-   my $q  = new Quoter();
+   local @ARGV  = @_;  # set global ARGV for this package
+   $oktorun     = 1;
+   $exit_status = 0;
 
    # ########################################################################
    # Get configuration information.
    # ########################################################################
-   $o = new OptionParser();
+   my $o = new OptionParser();
    $o->get_specs();
    $o->get_opts();
 
-   $o->set('collapse', $o->get('print')) unless $o->got('collapse'); 
-
-   $dp = $o->DSNParser(); 
-   my $dsn_defaults = $dp->parse_options($o);
-   $source_dsn = @ARGV ? $dp->parse(shift @ARGV,$dsn_defaults) : $dsn_defaults;
-   $dest_dsn   = $o->get('dest');
-
-   # The source dsn is not an option so --dest cannot use OptionParser
-   # to inherit values from it.  Thus, we do it manually.  --dest will
-   # inherit from --user, --port, etc.
-   if ( $source_dsn && $dest_dsn ) {
-      # If dest DSN only has D and t, this will copy h, P, S, etc.
-      # from the source DSN.
-      $dest_dsn = $dp->copy($source_dsn, $dest_dsn);
+   my $dp = $o->DSNParser();
+   $dp->prop('set-vars', $o->get('set-vars'));
+
+   my $src;
+   if ( my $src_dsn_string = shift @ARGV ) {
+      $src = Cxn->new(
+         dsn_string   => $src_dsn_string,
+         DSNParser    => $dp,
+         OptionParser => $o,
+         parent       => $o->get('daemonize'),
+      );
+   }
+
+   my $dst;
+   if ( my $dst_dsn = $o->get('dest') ) {
+      $dst = Cxn->new(
+         dsn          => $dst_dsn,
+         prev_dsn     => ($src ? $src->dsn : undef),
+         DSNParser    => $dp,
+         OptionParser => $o,
+         parent       => $o->get('daemonize'),
+      );
    }
 
    if ( !$o->get('help') ) {
-      if ( !$source_dsn ) {
-         $o->save_error('Missing or invalid source host');
-      }
-      if ( $dest_dsn && !$dest_dsn->{D} ) {
-         $o->save_error("--dest requires a 'D' (database) part");
-      }
-      if ( $dest_dsn && !$dest_dsn->{t} ) {
-         $o->save_error("--dest requires a 't' (table) part");
-      }
-
-      # Avoid running forever with zero second interval.
-      if ( $o->get('run-time') && !$o->get('interval') ) {
-         $o->set('interval', 1);
+      if ( !$src ) {
+         $o->save_error('No DSN was specified.');
+      }
+      if ( $dst && !$dst->dsn->{D} ) {
+         $o->save_error("--dest requires a 'D' (database) part.");
+      }
+      if ( $dst && !$dst->dsn->{t} ) {
+         $o->save_error("--dest requires a 't' (table) part.");
       }
    }
 
@@ -3984,43 +4290,29 @@
    # ########################################################################
    # Connect to MySQL and set up the --dest, if any.
    # ########################################################################
-   my $dbh   = get_cxn($source_dsn, 1);
-   my $dest_dbh;
-   my $sth;
+   my $q = new Quoter();
+
+   $src->connect();
+
+   my @cols = @{ $o->get('columns') };
    my $ins_sth;
-
-   # Since the user might not have specified a hostname for the connection,
-   # try to extract it from the $dbh
-   if ( !$source_dsn->{h} ) {
-      ($source_dsn->{h}) = $dbh->{mysql_hostinfo} =~ m/(\w+) via/;
-      PTDEBUG && _d('Got source host from dbh:', $source_dsn->{h});
-   }
-
-   my @cols = qw( server ts thread txn_id txn_time user hostname ip db tbl idx
-                  lock_type lock_mode wait_hold victim query );
-   if ( $o->got('columns') ) {
-      @cols = grep { $o->get('columns')->{$_} } @cols;
-   }
-
-   if ( $dest_dsn ) {
-      my $db_tbl = 
-         join('.',
-         map  {  $q->quote($_) }
-         grep { $_ }
-         ( $dest_dsn->{D}, $dest_dsn->{t} ));
-      $dest_dbh = get_cxn($dest_dsn, 0);
+   my $ins_sql;
+   if ( $dst ) {
+      $dst->connect(AutoCommit => 0);
+
+      my $db_tbl = $q->join_quote($dst->dsn->{D}, $dst->dsn->{t});
       my $cols  = join(',', map { $q->quote($_) } @cols);
-      my $parms = join(',', map { '?' } @cols);
-      my $sql   = "INSERT IGNORE INTO $db_tbl($cols) VALUES($parms)";
-      PTDEBUG && _d($sql);
-      $ins_sth  = $dest_dbh->prepare($sql);
+      my $parms = join(',', map { '?' }           @cols);
+      $ins_sql  = "INSERT IGNORE INTO $db_tbl ($cols) VALUES ($parms) "
+                . "/* pt-deadlock-logger */";
+      PTDEBUG && _d($ins_sql);
+      $ins_sth  = $dst->dbh->prepare($ins_sql);
 
       if ( $o->get('create-dest-table') ) {
-         my $db_tbl = $q->quote($dest_dsn->{D}, $dest_dsn->{t});
-         $sql       = $o->read_para_after(__FILE__, qr/MAGIC_dest_table/);
-         $sql       =~ s/deadlocks/IF NOT EXISTS $db_tbl/;
+         my $sql = $o->read_para_after(__FILE__, qr/MAGIC_dest_table/);
+         $sql =~ s/deadlocks/IF NOT EXISTS $db_tbl/;
          PTDEBUG && _d($sql);
-         $dest_dbh->do($sql);
+         $dst->dbh->do($sql);
       }
    }
 
@@ -4039,6 +4331,10 @@
       $daemon->make_PID_file();
    }
 
+   # Let Cxn::DESTROY() disconenct the dbh.
+   $src->{parent} = 0;
+   $dst->{parent} = 0 if $dst;
+
    # ########################################################################
    # Do the version-check
    # ########################################################################
@@ -4046,117 +4342,155 @@
       VersionCheck::version_check(
          force     => $o->got('version-check'),
          instances => [
-            { dbh => $dbh, dsn => $source_dsn },
-            ($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
+            { dbh => $src->dbh, dsn => $src->dsn },
+            ($dst ? { dbh => $dst->dbh, dsn => $dst->dsn } : ())
          ],
       );
    }
 
    # ########################################################################
+   # Set upt the --clear-deadlocks table.
+   # ########################################################################
+   my $clear_deadlocks_table_def;
+   my $clear_deadlocks_table = $o->get('clear-deadlocks');
+   if ( $clear_deadlocks_table ) { 
+      $clear_deadlocks_table_def
+         = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/);
+      if ( VersionParser->new($src->dbh) < '4.1.2') {
+         $clear_deadlocks_table_def =~ s/ENGINE=/TYPE=/;
+      }
+      $clear_deadlocks_table_def
+         =~ s/percona_schema.clear_deadlocks/$clear_deadlocks_table/;
+      PTDEBUG && _d('--clear-deadlocks table:', $clear_deadlocks_table_def);
+   }
+
+   # ########################################################################
    # Start looking for and logging deadlocks.
    # ########################################################################
-   my $last_fingerprint = '';
-
-   $oktorun  = 1;
-   my $start = time();
-   my $end   = $start + ($o->get('run-time') || 0); # When we should exit
-   my $now   = $start;
-   while (                            # Quit if:
-      ($start == $end || $now < $end) # time is exceeded
-      && $oktorun                     # or instructed to quit
-      )
-   {
-      my $text        = $dbh->selectrow_hashref("SHOW /*!40100 ENGINE*/ INNODB STATUS")->{Status};
-      my $parse_deadlocks_options = {
-            'numeric-ip' => $o->got('numeric-ip'),
-            'collapse'   => $o->got('collapse'),
+   my $sep                     = $o->get('tab') ? "\t" : ' ';
+   my $last_fingerprint        = '';
+   my $parse_deadlocks_options = {
+      'server'     => $src->dsn->{h} || $src->{hostname},
+      'numeric-ip' => $o->got('numeric-ip'),
+   };
+
+   my $run_time = Runtime->new(
+      run_time => $o->get('run-time'),
+      now      => sub { return time },
+   );
+
+   my $interval = $o->get('interval');
+   my $iters    = $o->get('iterations');
+   PTDEBUG && _d('iterations:', $iters, 'interval:', $interval);
+
+   ITERATION:
+   while (
+      $oktorun
+      && $run_time->have_time()
+      && (!defined $iters || $iters--)
+   ) {
+
+      my %txns;
+      my $fingerprint;
+      eval {
+         my $sql  = "SHOW /*!40100 ENGINE*/ INNODB STATUS "
+                  . "/* pt-deadlock-logger */";
+         my $text = $src->dbh->selectrow_hashref($sql)->{status};
+
+         %txns        = %{parse_deadlocks($text, $parse_deadlocks_options)};
+         $fingerprint = fingerprint(\%txns);
       };
-      my %txns        = %{parse_deadlocks($text, $parse_deadlocks_options)};
-      my $fingerprint = fingerprint(\%txns);
-
-      if ( $ins_sth ) {
-         foreach my $txn (sort { $a->{thread} <=> $b->{thread} } values %txns) {
-            $ins_sth->execute(@{$txn}{@cols});
-         }
-         $dest_dbh->commit();
+      if ( my $e = $EVAL_ERROR ) {
+         PTDEBUG && _d('Error getting InnoDB status:', $e);
+         if ( $src->lost_connection($e) ) {
+            eval { $src->connect() };
+            if ( $EVAL_ERROR ) {
+               warn "Lost connection to " . $src->name . ".  Will try "
+                  . "to reconnect in the next iteration.\n";
+            }
+            else {
+               PTDEBUG && _d('Reconnected to MySQL');
+               redo ITERATION;
+            }
+         }
+         else {
+            warn "Error getting SHOW ENGINE INNODB STATUS: $EVAL_ERROR";
+            $exit_status |= 1;
+         }
       }
+      else {
+         if ( $ins_sth ) {
+            eval {
+               PTDEBUG && _d('Saving deadlock to --dest');
+               foreach my $txn (
+                  sort { $a->{thread} <=> $b->{thread} } values %txns
+               ) {
+                  $ins_sth->execute(@{$txn}{@cols});
+               }
+               $dst->dbh->commit();
+            };
+            if ( my $e = $EVAL_ERROR ) {
+               PTDEBUG && _d('Error saving to --dest:', $e);
+               if ( $dst->lost_connection($e) ) {
+                  eval {
+                     $ins_sth->finish() if $ins_sth;
+                     $dst->dbh->disconnect() if $dst->dbh;
+                     $dst->connect(AutoCommit => 0);
+                     $ins_sth = $dst->dbh->prepare($ins_sql);
+                  }; 
+                  if ( $EVAL_ERROR ) {
+                     warn "Lost connection to " . $dst->name . ".  Will try "
+                        . "to reconnect in the next iteration.\n";
+                  }
+                  else {
+                     PTDEBUG && _d('Reconnected to MySQL (--dest)');
+                     redo ITERATION;
+                  }
+               }
+               else {
+                  warn "Error saving to --dest: $EVAL_ERROR";
+                  $exit_status |= 1;
+               }
+            }
+         }
 
-      if ( $fingerprint ne $last_fingerprint ) {
-         PTDEBUG && _d('New deadlock');
-         if ( $o->got('print') || !$o->got('dest') ) {
-            my $sep = $o->get('tab') ? "\t" : ' ';
-            print join($sep, @cols), "\n";
-            foreach my $txn (sort {$a->{thread}<=>$b->{thread}} values %txns) {
-               # If 'collapse' is on, it's already been taken care of,
-               # but if it's unset, by default strip whitespace.
-               if ( !$o->got('collapse') ) {
+         if ( $fingerprint ne $last_fingerprint ) {
+            PTDEBUG && _d('New deadlock');
+            if ( !$o->get('quiet') ) {
+               print join($sep, @cols), "\n";
+               foreach my $txn (
+                  sort { $a->{thread} <=> $b->{thread} } values %txns
+               ) {
                   $txn->{query} =~ s/\s+/ /g;
+                  print join($sep, map { $txn->{$_} } @cols), "\n";
                }
-               print join($sep, map { $txn->{$_} } @cols), "\n";
             }
          }
-      }
-      else {
-         PTDEBUG && _d('Same deadlock, not printing');
-      }
-      # Save deadlock's fingerprint for next interval.
-      $last_fingerprint = $fingerprint;
-
-      # If specified, clear the deadlock... 
-      if ( my $db_tbl = $o->get('clear-deadlocks') ) {
-         PTDEBUG && _d('Creating --clear-deadlocks table', $db_tbl);
-         $dbh->{AutoCommit} = 0;
-         my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/);
-
-         if ( VersionParser->new($dbh) < '4.1.2') {
-            $sql =~ s/ENGINE=/TYPE=/;
-         }
-         $sql =~ s/test.deadlock_maker/$db_tbl/;
-         PTDEBUG && _d($sql);
-         $dbh->do($sql);
-         $sql = "INSERT INTO $db_tbl(a) VALUES(1)";
-         PTDEBUG && _d($sql);
-         $dbh->do($sql); # I'm holding locks on the table now.
-
-         # Fork off a child to try to take a lock on the table.
-         my $pid = fork();
-         if ( defined($pid) && $pid == 0 ) { # I am a child
-            my $dbh_child = get_cxn($source_dsn, 0);
-            $sql = "SELECT * FROM $db_tbl FOR UPDATE";
-            PTDEBUG && _d($sql);
-            eval { $dbh_child->do($sql); }; # Should block against parent.
-            PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0.
-            $sql = "COMMIT";
-            PTDEBUG && _d($sql);
-            $dbh_child->do($sql);
-            exit;
-         }
-         elsif ( !defined($pid) ) {
-            die("Unable to fork for clearing deadlocks!\n");
-         }
-         sleep 1;
-         $sql = "INSERT INTO $db_tbl(a) VALUES(0)";# Will make child deadlock
-         PTDEBUG && _d($sql);
-         eval { $dbh->do($sql); };
-         PTDEBUG && _d($EVAL_ERROR);
-         waitpid($pid, 0);
-         $sql = "DROP TABLE $db_tbl";
-         PTDEBUG && _d($sql);
-         $dbh->do($sql);
-      }
-      
-      # If there's an --interval argument, run forever or till specified.
-      # Otherwise just run once.
-      if ( $o->get('interval') ) {
-         sleep($o->get('interval'));
-         $now = time();
-      }
-      else {
-         $oktorun = 0;
+         else {
+            PTDEBUG && _d('Same deadlock, not printing');
+         }
+
+         $last_fingerprint = $fingerprint;
+
+         if ( $clear_deadlocks_table ) {
+            clear_deadlocks(
+               dsn       => $src->dsn,
+               table     => $clear_deadlocks_table,
+               table_def => $clear_deadlocks_table_def,
+               DSNParser => $dp,
+            );
+         }
+      }
+
+      # Sleep if there's an --iteration left.
+      if ( !defined $iters || $iters ) {
+         PTDEBUG && _d('Sleeping', $interval, 'seconds');
+         sleep $interval;
       }
    }
 
-   return 0;
+   PTDEBUG && _d('Done running, exiting', $exit_status);
+   return $exit_status;
 }
 
 # ############################################################################
@@ -4244,7 +4578,7 @@
 
          my ( $query_text ) = $body =~ m/\nMySQL thread id .*\n((?s).*)/;
          $query_text =~ s/\s+$//;
-         $query_text =~ s/\s+/ /g if $args->{'collapse'};
+         $query_text =~ s/\s+/ /g;
 
          @{$hash}{qw(thread hostname ip user query)}
             = ($mysql_thread_id, $hostname, $ip, $user, $query_text);
@@ -4290,13 +4624,101 @@
    foreach my $txn ( values %txns ) {
       $txn->{victim} = $txn->{id} == $victim ? 1 : 0;
       $txn->{ts}     = $ts;
-      $txn->{server} = $source_dsn->{h} || '';
+      $txn->{server} = $args->{server} || '';
       $txn->{ip}     = inet_aton($txn->{ip}) if $args->{'numeric-ip'};
    }
 
    return \%txns;
 }
 
+sub clear_deadlocks {
+   my (%args) = @_;
+   my @required_args = qw(dsn table table_def DSNParser);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my $dsn       = $args{dsn};
+   my $table     = $args{table};
+   my $table_def = $args{table_def};
+   my $dp        = $args{DSNParser};
+   PTDEBUG && _d('Clearing deadlocks with table', $table, $table_def);
+
+   my $parent_dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit=>0 });
+   $parent_dbh->{AutoCommit} = 0;
+   $parent_dbh->{InactiveDestroy} = 1; # because of forking
+
+   # Create the deadlocks table.
+   PTDEBUG && _d($table_def);
+   $parent_dbh->do($table_def);
+
+   # Get a lock on it.
+   my $sql = "INSERT INTO $table (a) VALUES (1) "
+           . "/* pt-deadlock-logger clear deadlocks parent */";
+   PTDEBUG && _d($sql);
+   $parent_dbh->do($sql);
+
+   my ($sync_fh, $sync_file) = tempfile(
+      'pt-deadlock-logger-clear-deadlocks.XXXXXXX',
+      DIR => File::Spec->tmpdir(),
+   );
+   PTDEBUG && _d('Sync file:', $sync_file);
+   close $sync_fh;
+   unlink $sync_file;
+
+   # Fork a child to try to take a lock on the table.
+   my $pid = fork();
+   if ( defined($pid) && $pid == 0 ) {
+      # I am the child
+      PTDEBUG && _d('Clear deadlocks child', $PID);
+      my $child_dbh = $dp->get_dbh($dp->get_cxn_params($dsn), {AutoCommit=>0});
+      my $sql = "SELECT * FROM $table FOR UPDATE "
+              . "/* pt-deadlock-logger clear deadlocks child */";
+      PTDEBUG && _d($sql);
+      open my $fh, '>', $sync_file
+         or die "Error creating $sync_file: $OS_ERROR";
+      close $fh;
+      PTDEBUG && _d('Clear deadlocks child ready (child)');
+      eval { $child_dbh->do($sql); }; # Should block against parent.
+      PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0.
+      $child_dbh->commit();
+      $child_dbh->disconnect();
+      exit;
+   }
+   elsif ( !defined($pid) ) {
+      die "Failed to fork for --clear-deadlocks: " . ($OS_ERROR || '');
+   }
+
+   # Wait up to 10s for the child to connect and become ready.
+   for ( 1..40 ) {
+      last if -f $sync_file;
+      PTDEBUG && _d('Waiting for the clear deadlocks child');
+      sleep 0.25;
+   }
+   PTDEBUG && _d('Clear deadlocks child ready (parent)');
+   sleep 0.25;  # wait for child to exec its SELECT statement
+
+   # Make the child deadlock.
+   $sql = "INSERT INTO $table (a) VALUES (0) "
+        . "/* pt-deadlock-logger clear deadlocks parent */";
+   PTDEBUG && _d($sql);
+   eval { $parent_dbh->do($sql); };
+   PTDEBUG && _d($EVAL_ERROR);
+
+   # Reap the child.
+   waitpid($pid, 0);
+
+   # Drop the table.
+   $sql = "DROP TABLE IF EXISTS $table";
+   PTDEBUG && _d($sql);
+   $parent_dbh->do($sql);
+
+   $parent_dbh->disconnect();
+
+   unlink $sync_file;
+
+   return;
+}
+
 sub fingerprint {
    my ( $txns ) = @_;
    my $fingerprint = '';
@@ -4308,21 +4730,11 @@
    return $fingerprint;
 }
 
-# Catches signals so the program can exit gracefully.
-sub finish {
-   my ($signal) = @_;
-   print STDERR "Exiting on SIG$signal.\n";
+sub sig_int {
+   my ( $signal ) = @_;
    $oktorun = 0;
-}
-
-sub get_cxn {
-   my ( $dsn, $ac ) = @_;
-   if ( $o->get('ask-pass') ) {
-      $dsn->{p} = OptionParser::prompt_noecho("Enter password: "); 
-   }
-   my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), {AutoCommit => $ac});
-   $dbh->{InactiveDestroy} = 1; # Because of forking.
-   return $dbh;
+   print STDERR "# Caught SIG$signal.  Use 'kill -ABRT $PID' if "
+      . "the tool does not exit normally in a few seconds.\n";
 }
 
 sub _d {
@@ -4347,32 +4759,28 @@
 
 =head1 NAME
 
-pt-deadlock-logger - Extract and log MySQL deadlock information.
+pt-deadlock-logger - Log MySQL deadlocks.
 
 =head1 SYNOPSIS
 
-Usage: pt-deadlock-logger [OPTION...] SOURCE_DSN
-
-pt-deadlock-logger extracts and saves information about the most recent deadlock
-in a MySQL server.
-
-Print deadlocks on SOURCE_DSN:
-
-   pt-deadlock-logger SOURCE_DSN
-
-Store deadlock information from SOURCE_DSN in test.deadlocks table on SOURCE_DSN
-(source and destination are the same host):
-
-   pt-deadlock-logger SOURCE_DSN --dest D=test,t=deadlocks
-
-Store deadlock information from SOURCE_DSN in test.deadlocks table on DEST_DSN
-(source and destination are different hosts):
-
-   pt-deadlock-logger SOURCE_DSN --dest DEST_DSN,D=test,t=deadlocks
-
-Daemonize and check for deadlocks on SOURCE_DSN every 30 seconds for 4 hours:
-
-   pt-deadlock-logger SOURCE_DSN --dest D=test,t=deadlocks --daemonize --run-time 4h --interval 30s
+Usage: pt-deadlock-logger [OPTIONS] DSN
+
+pt-deadlock-logger logs information about MySQL deadlocks on the given
+DSN.  Information is printed to C<STDOUT>, and it can also be saved to a
+table by specifying L<"--dest">.  The tool runs for forever unless
+L<"--run-time"> or L<"--iterations"> is specified.
+
+Print deadlocks on host1:
+
+   pt-fk-error-logger h=host1
+
+Print deadlocks on host1 once then exit:
+
+   pt-fk-error-logger h=host1 --iterations 1
+
+Save deadlocks on host1 to percona_schema.fke on host2:
+
+  pt-fk-error-logger h=host1 --dest h=host2,D=percona_schema,t=deadlocks
 
 =head1 RISKS
 
@@ -4398,116 +4806,24 @@
 
 =head1 DESCRIPTION
 
-pt-deadlock-logger extracts deadlock data from a MySQL server.  Currently only
-InnoDB deadlock information is available.  You can print the information to
-standard output, store it in a database table, or both.  If neither
-L<"--print"> nor L<"--dest"> are given, then the deadlock information is
-printed by default.  If only L<"--dest"> is given, then the deadlock
-information is only stored.  If both options are given, then the deadlock
-information is printed and stored.
-
-The source host can be specified using one of two methods.  The first method is
-to use at least one of the standard connection-related command line options:
-L<"--defaults-file">, L<"--password">, L<"--host">, L<"--port">, L<"--socket">
-or L<"--user">.  These options only apply to the source host; they cannot be
-used to specify the destination host.
-
-The second method to specify the source host, or the optional destination host
-using L<"--dest">, is a DSN.  A DSN is a special syntax that can be either just
-a hostname (like C<server.domain.com> or C<1.2.3.4>), or a
-C<key=value,key=value> string. Keys are a single letter:
-
-  KEY MEANING
-  === =======
-  h   Connect to host
-  P   Port number to use for connection
-  S   Socket file to use for connection
-  u   User for login if not current user
-  p   Password to use when connecting
-  F   Only read default options from the given file
-
-If you omit any values from the destination host DSN, they are filled in with
-values from the source host, so you don't need to specify them in both places.
-C<pt-deadlock-logger> reads all normal MySQL option files, such as ~/.my.cnf, so
-you may not need to specify username, password and other common options at all.
+pt-deadlock-logger prints information about MySQL deadlocks by polling
+and parsing C<SHOW ENGINE INNODB STATUS>.  When a new deadlock occurs,
+it's printed to C<STDOUT> and, if specified, saved to L<"--dest">.
+
+Only new deadlocks are printed.  A fingerprint for each deadlock is created
+using the deadlock's server, ts, and thread values (even if these
+columns are not specified by L<"--columns">).  A deadlock is printed if
+its fingerprint is different than the last deadlock's fingerprint.
+
+The L<"--dest"> statement uses C<INSERT IGNORE> to eliminate duplicate
+deadlocks, so every deadlock is saved for every L<"--iterations">.
 
 =head1 OUTPUT
 
-You can choose which columns are output and/or saved to L<"--dest"> with the
-L<"--columns"> argument.  The default columns are as follows:
-
-=over
-
-=item server
-
-The (source) server on which the deadlock occurred.  This might be useful if
-you're tracking deadlocks on many servers.
-
-=item ts
-
-The date and time of the last detected deadlock.
-
-=item thread
-
-The MySQL thread number, which is the same as the connection ID in SHOW FULL
-PROCESSLIST.
-
-=item txn_id
-
-The InnoDB transaction ID, which InnoDB expresses as two unsigned integers.  I
-have multiplied them out to be one number.
-
-=item txn_time
-
-How long the transaction was active when the deadlock happened.
-
-=item user
-
-The connection's database username.
-
-=item hostname
-
-The connection's host.
-
-=item ip
-
-The connection's IP address.  If you specify L<"--numeric-ip">, this is
-converted to an unsigned integer.
-
-=item db
-
-The database in which the deadlock occurred.
-
-=item tbl
-
-The table on which the deadlock occurred.
-
-=item idx
-
-The index on which the deadlock occurred.
-
-=item lock_type
-
-The lock type the transaction held on the lock that caused the deadlock.
-
-=item lock_mode
-
-The lock mode of the lock that caused the deadlock.
-
-=item wait_hold
-
-Whether the transaction was waiting for the lock or holding the lock.  Usually
-you will see the two waited-for locks.
-
-=item victim
-
-Whether the transaction was selected as the deadlock victim and rolled back.
-
-=item query
-
-The query that caused the deadlock.
-
-=back
+New deadlocks are printed to C<STDOUT>, unless L<"--quiet"> is specified.
+Errors and warnings  are printed to C<STDERR>.
+
+See also L<"--columns"> and L<"--tab">.
 
 =head1 INNODB CAVEATS AND DETAILS
 
@@ -4562,24 +4878,89 @@
 C<SHOW INNODB STATUS>.  The table must not exist.  pt-deadlock-logger will
 create it with the following MAGIC_clear_deadlocks structure:
 
-  CREATE TABLE test.deadlock_maker(a INT PRIMARY KEY) ENGINE=InnoDB;
+  CREATE TABLE percona_schema.clear_deadlocks (a INT PRIMARY KEY) ENGINE=InnoDB;
 
 After creating the table and causing a small deadlock, the tool will drop the
 table again.
 
-=item --[no]collapse
-
-Collapse whitespace in queries to a single space.  This might make it easier to
-inspect on the command line or in a query.  By default, whitespace is collapsed
-when printing with L<"--print">, but not modified when storing to L<"--dest">.
-(That is, the default is different for each action).
-
 =item --columns
 
-type: hash
-
-Output only this comma-separated list of columns.  See L<"OUTPUT"> for more
-details on columns.
+type: Array; default: server, ts, thread, txn_id, txn_time, user, hostname, ip, db, tbl, idx, lock_type, lock_mode, wait_hold, victim, query
+
+The columns are:
+
+=over
+
+=item server
+
+The (source) server on which the deadlock occurred.  This might be useful if
+you're tracking deadlocks on many servers.
+
+=item ts
+
+The date and time of the last detected deadlock.
+
+=item thread
+
+The MySQL thread number, which is the same as the connection ID in SHOW FULL
+PROCESSLIST.
+
+=item txn_id
+
+The InnoDB transaction ID, which InnoDB expresses as two unsigned integers.  I
+have multiplied them out to be one number.
+
+=item txn_time
+
+How long the transaction was active when the deadlock happened.
+
+=item user
+
+The connection's database username.
+
+=item hostname
+
+The connection's host.
+
+=item ip
+
+The connection's IP address.  If you specify L<"--numeric-ip">, this is
+converted to an unsigned integer.
+
+=item db
+
+The database in which the deadlock occurred.
+
+=item tbl
+
+The table on which the deadlock occurred.
+
+=item idx
+
+The index on which the deadlock occurred.
+
+=item lock_type
+
+The lock type the transaction held on the lock that caused the deadlock.
+
+=item lock_mode
+
+The lock mode of the lock that caused the deadlock.
+
+=item wait_hold
+
+Whether the transaction was waiting for the lock or holding the lock.  Usually
+you will see the two waited-for locks.
+
+=item victim
+
+Whether the transaction was selected as the deadlock victim and rolled back.
+
+=item query
+
+The query that caused the deadlock.
+
+=back
 
 =item --config
 
@@ -4617,9 +4998,6 @@
 can usually omit most parts of this argument if you're storing deadlocks on the
 same server on which they happen.
 
-By default, whitespace in the query column is left intact;
-use L<"--[no]collapse"> if you want whitespace collapsed.
-
 The following MAGIC_dest_table is suggested if you want to store all the
 information pt-deadlock-logger can extract about deadlocks:
 
@@ -4658,12 +5036,23 @@
 
 =item --interval
 
-type: time
+type: time; default: 30
 
 How often to check for deadlocks.  If no L<"--run-time"> is specified,
 pt-deadlock-logger runs forever, checking for deadlocks at every interval.
 See also L<"--run-time">.
 
+=item --iterations
+
+type: int
+
+How many times to check for deadlocks.  By default, this option
+is undefined which means an infinite number of iterations.  The tool always
+exits for L<"--run-time">, regardless of the value specified for this option.
+For example, the tool will exit after 1 minute with
+C<--run-time 1m --iterations 4 --interval 30> because 4 iterations at 30
+second intervals would take 2 minutes, longer than the 1 mintue run-time.
+
 =item --log
 
 type: string
@@ -4695,16 +5084,9 @@
 
 Port number to use for connection.
 
-=item --print
-
-Print results on standard output.  See L<"OUTPUT"> for more.  By default,
-enables L<"--[no]collapse"> unless you explicitly disable it.
-
-If L<"--interval"> or L<"--run-time"> is specified, only new deadlocks are
-printed at each interval.  A fingerprint for each deadlock is created using
-L<"--columns"> server, ts and thread (even if those columns were not specified
-by L<"--columns">) and if the current deadlock's fingerprint is different from
-the last deadlock's fingerprint, then it is printed.
+=item --quiet
+
+Do not deadlocks; only print errors and warnings to C<STDERR>.
 
 =item --run-time
 
@@ -4729,7 +5111,7 @@
 
 =item --tab
 
-Print tab-separated columns, instead of aligned.
+Use tabs to separate columns instead of spaces.
 
 =item --user
 
@@ -4886,7 +5268,7 @@
 
 =head1 AUTHORS
 
-Baron Schwartz
+Baron Schwartz and Daniel Nichter
 
 =head1 ABOUT PERCONA TOOLKIT
 

=== modified file 'bin/pt-fk-error-logger'
--- bin/pt-fk-error-logger	2013-02-25 18:55:06 +0000
+++ bin/pt-fk-error-logger	2013-02-26 01:08:24 +0000
@@ -3915,7 +3915,8 @@
 
 pt-fk-error-logger logs information about foreign key errors on the given
 DSN.  Information is printed to C<STDOUT>, and it can also be saved to a
-table by specifying L<"--dest">.
+table by specifying L<"--dest">.  The tool runs for forever unless
+L<"--run-time"> or L<"--iterations"> is specified.
 
 Print foreign key errors on host1:
 

=== modified file 'lib/Cxn.pm'
--- lib/Cxn.pm	2013-02-25 18:52:22 +0000
+++ lib/Cxn.pm	2013-02-26 01:08:24 +0000
@@ -98,23 +98,24 @@
    }
 
    my $self = {
-      dsn          => $dsn,
-      dbh          => $args{dbh},
-      dsn_name     => $dp->as_string($dsn, [qw(h P S)]),
-      hostname     => '',
-      set          => $args{set},
-      NAME_lc      => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
-      dbh_set      => 0,
-      OptionParser => $o,
-      DSNParser    => $dp,
+      dsn             => $dsn,
+      dbh             => $args{dbh},
+      dsn_name        => $dp->as_string($dsn, [qw(h P S)]),
+      hostname        => '',
+      set             => $args{set},
+      NAME_lc         => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
+      dbh_set         => 0,
+      OptionParser    => $o,
+      DSNParser       => $dp,
       is_cluster_node => undef,
+      parent          => $args{parent},
    };
 
    return bless $self, $class;
 }
 
 sub connect {
-   my ( $self ) = @_;
+   my ( $self, %opts ) = @_;
    my $dsn = $self->{dsn};
    my $dp  = $self->{DSNParser};
    my $o   = $self->{OptionParser};
@@ -126,7 +127,13 @@
          $dsn->{p} = OptionParser::prompt_noecho("Enter MySQL password: ");
          $self->{asked_for_pass} = 1;
       }
-      $dbh = $dp->get_dbh($dp->get_cxn_params($dsn),  { AutoCommit => 1 });
+      $dbh = $dp->get_dbh(
+         $dp->get_cxn_params($dsn),
+         {
+            AutoCommit => 1,
+            %opts,
+         },
+      );
    }
    PTDEBUG && _d($dbh, 'Connected dbh to', $self->{name});
 
@@ -163,6 +170,11 @@
       $self->{hostname} = $hostname;
    }
 
+   if ( $self->{parent} ) {
+      PTDEBUG && _d($dbh, 'Setting InactiveDestroy=1 in parent');
+      $dbh->{InactiveDestroy} = 1;
+   }
+
    # Call the set callback to let the caller SET any MySQL variables.
    if ( my $set = $self->{set}) {
       $set->($dbh);
@@ -206,12 +218,18 @@
 
 sub DESTROY {
    my ($self) = @_;
-   if ( $self->{dbh}
-         && blessed($self->{dbh})
-         && $self->{dbh}->can("disconnect") ) {
+
+   if ( $self->{parent} ) {
+      PTDEBUG && _d('Not disconnecting dbh in parent');
+   }
+   elsif ( $self->{dbh}
+           && blessed($self->{dbh})
+           && $self->{dbh}->can("disconnect") )
+   {
       PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});
       $self->{dbh}->disconnect();
    }
+
    return;
 }
 

=== modified file 't/pt-deadlock-logger/basics.t'
--- t/pt-deadlock-logger/basics.t	2012-10-22 21:30:29 +0000
+++ t/pt-deadlock-logger/basics.t	2013-02-26 01:08:24 +0000
@@ -11,6 +11,8 @@
 use English qw(-no_match_vars);
 use Test::More;
 
+$ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} = 1;
+
 use PerconaTest;
 use Sandbox;
 require "$trunk/bin/pt-deadlock-logger";
@@ -25,8 +27,8 @@
 }
 
 my $output;
-my $cnf = "/tmp/12345/my.sandbox.cnf";
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
+my $dsn  = $sb->dsn_for('master');
+my @args = ($dsn, qw(--iterations 1));
 
 $dbh1->commit;
 $dbh2->commit;
@@ -90,21 +92,30 @@
 $output = $dbh1->selectrow_hashref('show /*!40101 engine*/ innodb status')->{status};
 like($output, qr/WE ROLL BACK/, 'There was a deadlock');
 
-$output = `$cmd --print`;
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args);
+   }
+);
+
 like(
    $output,
    qr/127\.1.+msandbox.+GEN_CLUST_INDEX/,
    'Deadlock logger prints the output'
 );
 
-$output = `$cmd`;
-like(
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, qw(--quiet));
+   }
+);
+
+is(
    $output,
-   qr/127\.1.+msandbox.+GEN_CLUST_INDEX/,
-   '--print is implicit'
+   "",
+   "No output with --quiet"
 );
 
-
 # #############################################################################
 # Issue 943: mk-deadlock-logger reports the same deadlock with --interval
 # #############################################################################
@@ -112,55 +123,59 @@
 # The deadlock from above won't be re-printed so even after running for
 # 3 seconds and checking multiple times only the single, 3 line deadlock
 # should be reported.
-chomp($output = `$cmd --run-time 3 | wc -l`);
+
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, qw(--run-time 3));
+   }
+);
 $output =~ s/^\s+//;
+my @lines = split("\n", $output);
 is(
-   $output,
+   scalar @lines,
    3,
    "Doesn't re-print same deadlock (issue 943)"
-);
+) or diag($output);
 
 # #############################################################################
 # Check that deadlocks from previous test were stored in table.
 # #############################################################################
-`$cmd --dest D=test,t=deadlocks --create-dest-table`;
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, '--dest', 'D=test,t=deadlocks',
+         qw(--create-dest-table))
+   }
+);
+
 my $res = $dbh1->selectall_arrayref('SELECT * FROM test.deadlocks');
 ok(
    scalar @$res,
-   'Deadlocks recorded in --dest table'
-);
-
-# #############################################################################
-# Check that --dest suppress --print output unless --print is explicit.
-# #############################################################################
-$output = 'foo';
-$dbh1->do('TRUNCATE TABLE test.deadlocks');
-$output = `$cmd --dest D=test,t=deadlocks`;
-is(
-   $output,
-   '',
-   'No output with --dest'
-);
-
-$res = $dbh1->selectall_arrayref('SELECT * FROM test.deadlocks');
-ok(
-   scalar @$res,
-   'Deadlocks still recorded in table'
-);
-
+   'Deadlock saved in --dest table'
+) or diag($output);
+
+# #############################################################################
+# In 2.1, --dest suppressed output (--print).  In 2.2, output is only
+# suppressed by --quiet.
+# #############################################################################
 $output = '';
 $dbh1->do('TRUNCATE TABLE test.deadlocks');
-$output = `$trunk/bin/pt-deadlock-logger --print --dest D=test,t=deadlocks --host 127.1 --port 12345 --user msandbox --password msandbox`;
-like(
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, '--dest', 'D=test,t=deadlocks',
+         qw(--quiet))
+   }
+);
+
+is(
    $output,
-   qr/127\.1.+msandbox.+GEN_CLUST_INDEX/,
-   'Prints output with --dest and explicit --print'
+   "",
+   "No output with --dest and --quiet"
 );
 
 $res = $dbh1->selectall_arrayref('SELECT * FROM test.deadlocks');
 ok(
    scalar @$res,
-   'Deadlocks recorded in table again'
+   "... deadlock still saved in the table"
 );
 
 # #############################################################################
@@ -180,9 +195,7 @@
    make_deadlock();
 
    $output = output(
-      sub { pt_deadlock_logger::main("F=/tmp/12345/my.sandbox.cnf",
-         qw(--print) );
-      }
+      sub { pt_deadlock_logger::main(@args) }
    );
 
    like(
@@ -200,4 +213,3 @@
 $sb->wipe_clean($dbh1);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
 done_testing;
-exit;

=== modified file 't/pt-deadlock-logger/clear_deadlocks.t'
--- t/pt-deadlock-logger/clear_deadlocks.t	2012-06-03 19:14:30 +0000
+++ t/pt-deadlock-logger/clear_deadlocks.t	2013-02-26 01:08:24 +0000
@@ -22,9 +22,6 @@
 if ( !$dbh1 ) {
    plan skip_all => 'Cannot connect to sandbox master';
 }
-else {
-   plan tests => 4;
-}
 
 my $output;
 my $cnf = "/tmp/12345/my.sandbox.cnf";
@@ -39,7 +36,7 @@
 
 # The clear-deadlocks table comes and goes quickly so we can really
 # only search the debug output for evidence that it was created.
-$output = `PTDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock 2>&1`;
+$output = `PTDEBUG=1 $trunk/bin/pt-deadlock-logger F=$cnf,D=test --clear-deadlocks test.make_deadlock --iterations 1 2>&1`;
 like(
    $output,
    qr/INSERT INTO test.make_deadlock/,
@@ -67,4 +64,4 @@
 # #############################################################################
 $sb->wipe_clean($dbh1);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;

=== modified file 't/pt-deadlock-logger/create_dest_table.t'
--- t/pt-deadlock-logger/create_dest_table.t	2012-06-09 18:43:33 +0000
+++ t/pt-deadlock-logger/create_dest_table.t	2013-02-26 01:08:24 +0000
@@ -22,15 +22,10 @@
 if ( !$dbh1 ) {
    plan skip_all => 'Cannot connect to sandbox master';
 }
-else {
-   plan tests => 3;
-}
 
 my $output;
-my $cnf = "/tmp/12345/my.sandbox.cnf";
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
+my $dsn = $sb->dsn_for('master');
 
-$sb->wipe_clean($dbh1);
 $sb->create_dbs($dbh1, ['test']);
 
 # #############################################################################
@@ -42,17 +37,25 @@
    'Deadlocks table does not exit (issue 386)'
 );
 
-`$cmd --dest D=test,t=issue_386 --run-time 1s --interval 1s --create-dest-table`;
+$output = output(
+   sub {
+      pt_deadlock_logger::main($dsn,
+         '--dest', 'D=test,t=issue_386',
+         qw(--iterations 1 --create-dest-table)
+      )
+   },
+   stderr => 1,
+);
 
 is_deeply(
    $dbh1->selectall_arrayref(q{show tables from `test` like 'issue_386'}),
    [['issue_386']],
    'Deadlocks table created with --create-dest-table (issue 386)'
-);
+) or diag($output);
 
 # #############################################################################
 # Done.
 # #############################################################################
 $sb->wipe_clean($dbh1);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;

=== modified file 't/pt-deadlock-logger/option_sanity.t'
--- t/pt-deadlock-logger/option_sanity.t	2012-10-22 18:16:42 +0000
+++ t/pt-deadlock-logger/option_sanity.t	2013-02-26 01:08:24 +0000
@@ -21,7 +21,7 @@
 $output = `$trunk/bin/pt-deadlock-logger --dest D=test,t=deadlocks 2>&1`;
 like(
    $output,
-   qr/Missing or invalid source host/,
+   qr/No DSN was specified/,
    'Requires source host'
 );
 

=== renamed file 't/pt-deadlock-logger/deadlocks_tbl.sql' => 't/pt-deadlock-logger/samples/deadlocks_tbl.sql'
=== modified file 't/pt-deadlock-logger/standard_options.t'
--- t/pt-deadlock-logger/standard_options.t	2012-07-23 04:52:41 +0000
+++ t/pt-deadlock-logger/standard_options.t	2013-02-26 01:08:24 +0000
@@ -17,69 +17,96 @@
 
 my $dp   = new DSNParser(opts=>$dsn_opts);
 my $sb   = new Sandbox(basedir => '/tmp', DSNParser => $dp);
-my $dbh1 = $sb->get_dbh_for('master');
+my $dbh = $sb->get_dbh_for('master');
 
-if ( !$dbh1 ) {
+if ( !$dbh ) {
    plan skip_all => 'Cannot connect to sandbox master';
 }
-else {
-   plan tests => 10;
-}
 
 my $output;
-my $cnf = "/tmp/12345/my.sandbox.cnf";
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
+my $dsn  = $sb->dsn_for('master');
+my @args = ($dsn, qw(--iterations 1));
 
-$sb->wipe_clean($dbh1);
-$sb->create_dbs($dbh1, ['test']);
+$sb->wipe_clean($dbh);
+$sb->create_dbs($dbh, ['test']);
 
 # #############################################################################
 # Issue 248: Add --user, --pass, --host, etc to all tools
 # #############################################################################
 
 # Test that source DSN inherits from --user, etc.
-$output = `$trunk/bin/pt-deadlock-logger h=127.1,D=test,u=msandbox,p=msandbox --clear-deadlocks test.make_deadlock --port 12345 2>&1`;
+$output = output(
+   sub {
+      pt_deadlock_logger::main(
+         "h=127.1,D=test,u=msandbox,p=msandbox",
+         qw(--clear-deadlocks test.make_deadlock --port 12345),
+         qw(--iterations 1)
+      )
+   }
+);
+
 unlike(
    $output,
    qr/failed/,
    'Source DSN inherits from standard connection options (issue 248)'
 );
 
-# #########################################################################
+# #############################################################################
 # Issue 391: Add --pid option to all scripts
-# #########################################################################
-`touch /tmp/mk-script.pid`;
-$output = `$cmd --clear-deadlocks test.make_deadlock --port 12345 --pid /tmp/mk-script.pid 2>&1`;
+# #############################################################################
+
+my $pid_file = "/tmp/pt-deadlock-logger-test.pid.$PID";
+diag(`touch $pid_file`);
+
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, '--pid', $pid_file)
+   },
+   stderr => 1,
+);
+
 like(
    $output,
-   qr{PID file /tmp/mk-script.pid already exists},
+   qr{PID file $pid_file already exists},
    'Dies if PID file already exists (--pid without --daemonize) (issue 391)'
 );
-`rm -rf /tmp/mk-script.pid`;
+
+unlink $pid_file if -f $pid_file;
 
 # #############################################################################
 # Check daemonization
 # #############################################################################
-my $deadlocks_tbl = load_file('t/pt-deadlock-logger/deadlocks_tbl.sql');
-$dbh1->do('USE test');
-$dbh1->do('DROP TABLE IF EXISTS deadlocks');
-$dbh1->do("$deadlocks_tbl");
-
-my $pid_file = '/tmp/mk-deadlock-logger.pid';
-unlink $pid_file
-   and diag("Unlinked existing $pid_file");
-
-`$cmd --dest D=test,t=deadlocks --daemonize --run-time 6s --interval 1s --pid $pid_file 1>/dev/null 2>/dev/null`;
-$output = `ps -eaf | grep '$cmd \-\-dest '`;
-like($output, qr/\Q$cmd/, 'It lives daemonized');
+$dbh->do('USE test');
+$dbh->do('DROP TABLE IF EXISTS deadlocks');
+$sb->load_file('master', 't/pt-deadlock-logger/samples/deadlocks_tbl.sql', 'test');
+
+$output = `$trunk/bin/pt-deadlock-logger $dsn --dest D=test,t=deadlocks --daemonize --run-time 10 --interval 1 --pid $pid_file 1>/dev/null 2>/dev/null`;
 
 PerconaTest::wait_for_files($pid_file);
-ok(-f $pid_file, 'PID file created');
-my ($pid) = $output =~ /\s+(\d+)\s+/;
+
+$output = `ps x | grep 'pt-deadlock-logger $dsn' | grep -v grep`;
+like(
+   $output,
+   qr/\Qpt-deadlock-logger $dsn/,
+   'It lives daemonized'
+) or diag($output);
+
+my ($pid) = $output =~ /(\d+)/;
+
+ok(
+   -f $pid_file,
+   'PID file created'
+) or diag($output);
+
 chomp($output = slurp_file($pid_file));
-is($output, $pid, 'PID file has correct PID');
+is(
+   $output,
+   $pid,
+   'PID file has correct PID'
+);
 
 # Kill it
+kill 2, $pid;
 PerconaTest::wait_until(sub { !kill 0, $pid });
 ok(! -f $pid_file, 'PID file removed');
 
@@ -90,17 +117,25 @@
    'PID file already exists'
 );
 
-$output = `$cmd --dest D=test,t=deadlocks --daemonize --run-time 1s --interval 1s --pid $pid_file 2>&1`;
+$output = output(
+   sub {
+      pt_deadlock_logger::main(@args, '--pid', $pid_file,
+         qw(--daemonize))
+   },
+   stderr => 1,
+);
+
 like(
    $output,
-   qr/PID file .+ already exists/,
+   qr/PID file $pid_file already exists/,
    'Does not run if PID file already exists'
 );
 
-$output = `ps -eaf | grep 'pt-deadlock-logger \-\-dest '`;
-unlike(
+$output = `ps x | grep 'pt-deadlock-logger $dsn' | grep -v grep`;
+
+is(
    $output,
-   qr/$cmd/,
+   "",
    'It does not lived daemonized'
 );
 
@@ -109,6 +144,6 @@
 # #############################################################################
 # Done.
 # #############################################################################
-$sb->wipe_clean($dbh1);
+$sb->wipe_clean($dbh);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;