Update the code to work on current trunk.

Changes for 941469 conflicted with this fix, so this had to be updated.

bin/pt-kill

@@ -1280,7 +1280,7 @@ sub parse {
    }
 
    foreach my $key ( keys %given_props ) {
-      die "Unknown DSN option '$key' in '$dsn'.  For more details, "
+      die "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};
@@ -2076,6 +2076,436 @@ sub _d {
 # End Transformers package
 # ###########################################################################
 
+# ###########################################################################
+# TableParser 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/TableParser.pm
+#   t/lib/TableParser.t
+# See https://launchpad.net/percona-toolkit for more information.
+# ###########################################################################
+{
+package TableParser;
+
+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 ) = @_;
+   my @required_args = qw(Quoter);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my $self = { %args };
+   return bless $self, $class;
+}
+
+sub get_create_table {
+   my ( $self, $dbh, $db, $tbl ) = @_;
+   die "I need a dbh parameter" unless $dbh;
+   die "I need a db parameter"  unless $db;
+   die "I need a tbl parameter" unless $tbl;
+   my $q = $self->{Quoter};
+
+   my $new_sql_mode
+      = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
+      . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
+      . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
+      . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
+
+   my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
+                     . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
+
+   PTDEBUG && _d($new_sql_mode);
+   eval { $dbh->do($new_sql_mode); };
+   PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
+
+   my $use_sql = 'USE ' . $q->quote($db);
+   PTDEBUG && _d($dbh, $use_sql);
+   $dbh->do($use_sql);
+
+   my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
+   PTDEBUG && _d($show_sql);
+   my $href;
+   eval { $href = $dbh->selectrow_hashref($show_sql); };
+   if ( $EVAL_ERROR ) {
+      PTDEBUG && _d($EVAL_ERROR);
+
+      PTDEBUG && _d($old_sql_mode);
+      $dbh->do($old_sql_mode);
+
+      return;
+   }
+
+   PTDEBUG && _d($old_sql_mode);
+   $dbh->do($old_sql_mode);
+
+   my ($key) = grep { m/create (?:table|view)/i } keys %$href;
+   if ( !$key ) {
+      die "Error: no 'Create Table' or 'Create View' in result set from "
+         . "$show_sql: " . Dumper($href);
+   }
+
+   return $href->{$key};
+}
+
+sub parse {
+   my ( $self, $ddl, $opts ) = @_;
+   return unless $ddl;
+
+   if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
+      die "Cannot parse table definition; is ANSI quoting "
+         . "enabled or SQL_QUOTE_SHOW_CREATE disabled?";
+   }
+
+   my ($name)     = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
+   (undef, $name) = $self->{Quoter}->split_unquote($name) if $name;
+
+   $ddl =~ s/(`[^`]+`)/\L$1/g;
+
+   my $engine = $self->get_engine($ddl);
+
+   my @defs   = $ddl =~ m/^(\s+`.*?),?$/gm;
+   my @cols   = map { $_ =~ m/`([^`]+)`/ } @defs;
+   PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols));
+
+   my %def_for;
+   @def_for{@cols} = @defs;
+
+   my (@nums, @null);
+   my (%type_for, %is_nullable, %is_numeric, %is_autoinc);
+   foreach my $col ( @cols ) {
+      my $def = $def_for{$col};
+      my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/;
+      die "Can't determine column type for $def" unless $type;
+      $type_for{$col} = $type;
+      if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) {
+         push @nums, $col;
+         $is_numeric{$col} = 1;
+      }
+      if ( $def !~ m/NOT NULL/ ) {
+         push @null, $col;
+         $is_nullable{$col} = 1;
+      }
+      $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0;
+   }
+
+   my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable);
+
+   my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/;
+
+   return {
+      name           => $name,
+      cols           => \@cols,
+      col_posn       => { map { $cols[$_] => $_ } 0..$#cols },
+      is_col         => { map { $_ => 1 } @cols },
+      null_cols      => \@null,
+      is_nullable    => \%is_nullable,
+      is_autoinc     => \%is_autoinc,
+      clustered_key  => $clustered_key,
+      keys           => $keys,
+      defs           => \%def_for,
+      numeric_cols   => \@nums,
+      is_numeric     => \%is_numeric,
+      engine         => $engine,
+      type_for       => \%type_for,
+      charset        => $charset,
+   };
+}
+
+sub sort_indexes {
+   my ( $self, $tbl ) = @_;
+
+   my @indexes
+      = sort {
+         (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY'))
+         || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} )
+         || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} )
+         || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) )
+      }
+      grep {
+         $tbl->{keys}->{$_}->{type} eq 'BTREE'
+      }
+      sort keys %{$tbl->{keys}};
+
+   PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes));
+   return @indexes;
+}
+
+sub find_best_index {
+   my ( $self, $tbl, $index ) = @_;
+   my $best;
+   if ( $index ) {
+      ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}};
+   }
+   if ( !$best ) {
+      if ( $index ) {
+         die "Index '$index' does not exist in table";
+      }
+      else {
+         ($best) = $self->sort_indexes($tbl);
+      }
+   }
+   PTDEBUG && _d('Best index found is', $best);
+   return $best;
+}
+
+sub find_possible_keys {
+   my ( $self, $dbh, $database, $table, $quoter, $where ) = @_;
+   return () unless $where;
+   my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table)
+      . ' WHERE ' . $where;
+   PTDEBUG && _d($sql);
+   my $expl = $dbh->selectrow_hashref($sql);
+   $expl = { map { lc($_) => $expl->{$_} } keys %$expl };
+   if ( $expl->{possible_keys} ) {
+      PTDEBUG && _d('possible_keys =', $expl->{possible_keys});
+      my @candidates = split(',', $expl->{possible_keys});
+      my %possible   = map { $_ => 1 } @candidates;
+      if ( $expl->{key} ) {
+         PTDEBUG && _d('MySQL chose', $expl->{key});
+         unshift @candidates, grep { $possible{$_} } split(',', $expl->{key});
+         PTDEBUG && _d('Before deduping:', join(', ', @candidates));
+         my %seen;
+         @candidates = grep { !$seen{$_}++ } @candidates;
+      }
+      PTDEBUG && _d('Final list:', join(', ', @candidates));
+      return @candidates;
+   }
+   else {
+      PTDEBUG && _d('No keys in possible_keys');
+      return ();
+   }
+}
+
+sub check_table {
+   my ( $self, %args ) = @_;
+   my @required_args = qw(dbh db tbl);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($dbh, $db, $tbl) = @args{@required_args};
+   my $q      = $self->{Quoter};
+   my $db_tbl = $q->quote($db, $tbl);
+   PTDEBUG && _d('Checking', $db_tbl);
+
+   my $sql = "SHOW TABLES FROM " . $q->quote($db)
+           . ' LIKE ' . $q->literal_like($tbl);
+   PTDEBUG && _d($sql);
+   my $row;
+   eval {
+      $row = $dbh->selectrow_arrayref($sql);
+   };
+   if ( $EVAL_ERROR ) {
+      PTDEBUG && _d($EVAL_ERROR);
+      return 0;
+   }
+   if ( !$row->[0] || $row->[0] ne $tbl ) {
+      PTDEBUG && _d('Table does not exist');
+      return 0;
+   }
+
+   PTDEBUG && _d('Table exists; no privs to check');
+   return 1 unless $args{all_privs};
+
+   $sql = "SHOW FULL COLUMNS FROM $db_tbl";
+   PTDEBUG && _d($sql);
+   eval {
+      $row = $dbh->selectrow_hashref($sql);
+   };
+   if ( $EVAL_ERROR ) {
+      PTDEBUG && _d($EVAL_ERROR);
+      return 0;
+   }
+   if ( !scalar keys %$row ) {
+      PTDEBUG && _d('Table has no columns:', Dumper($row));
+      return 0;
+   }
+   my $privs = $row->{privileges} || $row->{Privileges};
+
+   $sql = "DELETE FROM $db_tbl LIMIT 0";
+   PTDEBUG && _d($sql);
+   eval {
+      $dbh->do($sql);
+   };
+   my $can_delete = $EVAL_ERROR ? 0 : 1;
+
+   PTDEBUG && _d('User privs on', $db_tbl, ':', $privs,
+      ($can_delete ? 'delete' : ''));
+
+   if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/
+          && $can_delete) ) {
+      PTDEBUG && _d('User does not have all privs');
+      return 0;
+   }
+
+   PTDEBUG && _d('User has all privs');
+   return 1;
+}
+
+sub get_engine {
+   my ( $self, $ddl, $opts ) = @_;
+   my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/;
+   PTDEBUG && _d('Storage engine:', $engine);
+   return $engine || undef;
+}
+
+sub get_keys {
+   my ( $self, $ddl, $opts, $is_nullable ) = @_;
+   my $engine        = $self->get_engine($ddl);
+   my $keys          = {};
+   my $clustered_key = undef;
+
+   KEY:
+   foreach my $key ( $ddl =~ m/^  ((?:[A-Z]+ )?KEY .*)$/gm ) {
+
+      next KEY if $key =~ m/FOREIGN/;
+
+      my $key_ddl = $key;
+      PTDEBUG && _d('Parsed key:', $key_ddl);
+
+      if ( $engine !~ m/MEMORY|HEAP/ ) {
+         $key =~ s/USING HASH/USING BTREE/;
+      }
+
+      my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
+      my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
+      $type = $type || $special || 'BTREE';
+      if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
+         && $engine =~ m/HEAP|MEMORY/i )
+      {
+         $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
+      }
+
+      my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
+      my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
+      my @cols;
+      my @col_prefixes;
+      foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) {
+         my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/;
+         push @cols, $name;
+         push @col_prefixes, $prefix;
+      }
+      $name =~ s/`//g;
+
+      PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols));
+
+      $keys->{$name} = {
+         name         => $name,
+         type         => $type,
+         colnames     => $cols,
+         cols         => \@cols,
+         col_prefixes => \@col_prefixes,
+         is_unique    => $unique,
+         is_nullable  => scalar(grep { $is_nullable->{$_} } @cols),
+         is_col       => { map { $_ => 1 } @cols },
+         ddl          => $key_ddl,
+      };
+
+      if ( $engine =~ m/InnoDB/i && !$clustered_key ) {
+         my $this_key = $keys->{$name};
+         if ( $this_key->{name} eq 'PRIMARY' ) {
+            $clustered_key = 'PRIMARY';
+         }
+         elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) {
+            $clustered_key = $this_key->{name};
+         }
+         PTDEBUG && $clustered_key && _d('This key is the clustered key');
+      }
+   }
+
+   return $keys, $clustered_key;
+}
+
+sub get_fks {
+   my ( $self, $ddl, $opts ) = @_;
+   my $q   = $self->{Quoter};
+   my $fks = {};
+
+   foreach my $fk (
+      $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg )
+   {
+      my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/;
+      my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/;
+      my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/;
+
+      my ($db, $tbl) = $q->split_unquote($parent, $opts->{database});
+      my %parent_tbl = (tbl => $tbl);
+      $parent_tbl{db} = $db if $db;
+
+      if ( $parent !~ m/\./ && $opts->{database} ) {
+         $parent = $q->quote($opts->{database}) . ".$parent";
+      }
+
+      $fks->{$name} = {
+         name           => $name,
+         colnames       => $cols,
+         cols           => [ map { s/[ `]+//g; $_; } split(',', $cols) ],
+         parent_tbl     => \%parent_tbl,
+         parent_tblname => $parent,
+         parent_cols    => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ],
+         parent_colnames=> $parent_cols,
+         ddl            => $fk,
+      };
+   }
+
+   return $fks;
+}
+
+sub remove_auto_increment {
+   my ( $self, $ddl ) = @_;
+   $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m;
+   return $ddl;
+}
+
+sub get_table_status {
+   my ( $self, $dbh, $db, $like ) = @_;
+   my $q = $self->{Quoter};
+   my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db);
+   my @params;
+   if ( $like ) {
+      $sql .= ' LIKE ?';
+      push @params, $like;
+   }
+   PTDEBUG && _d($sql, @params);
+   my $sth = $dbh->prepare($sql);
+   eval { $sth->execute(@params); };
+   if ($EVAL_ERROR) {
+      PTDEBUG && _d($EVAL_ERROR);
+      return;
+   }
+   my @tables = @{$sth->fetchall_arrayref({})};
+   @tables = map {
+      my %tbl; # Make a copy with lowercased keys
+      @tbl{ map { lc $_ } keys %$_ } = values %$_;
+      $tbl{engine} ||= $tbl{type} || $tbl{comment};
+      delete $tbl{type};
+      \%tbl;
+   } @tables;
+   return @tables;
+}
+
+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 TableParser package
+# ###########################################################################
+
 # ###########################################################################
 # Processlist package
 # This package is a copy without comments from the original.  The original
@@ -2125,6 +2555,7 @@ sub new {
       last_poll   => 0,
       active_cxn  => {},  # keyed off ID
       event_cache => [],
+      _reasons_for_matching => {},
    };
    return bless $self, $class;
 }
@@ -2335,7 +2766,9 @@ sub find {
             PTDEBUG && _d("Query isn't running long enough");
             next QUERY;
          }
-         PTDEBUG && _d('Exceeds busy time');
+         my $reason = 'Exceeds busy time';
+         PTDEBUG && _d($reason);
+         push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
          $matched++;
       }
 
@@ -2345,7 +2778,9 @@ sub find {
             PTDEBUG && _d("Query isn't idle long enough");
             next QUERY;
          }
-         PTDEBUG && _d('Exceeds idle time');
+         my $reason = 'Exceeds idle time';
+         PTDEBUG && _d($reason);
+         push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
          $matched++;
       }
  
@@ -2362,7 +2797,9 @@ sub find {
                PTDEBUG && _d('Query does not match', $property, 'spec');
                next QUERY;
             }
-            PTDEBUG && _d('Query matches', $property, 'spec');
+            my $reason = 'Query matches ' . $property . ' spec';
+            PTDEBUG && _d($reason);
+            push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
             $matched++;
          }
       }
@@ -3284,6 +3721,125 @@ sub _d {
 # End MasterSlave 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;
+
+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 ) = @_;
+
+   return 'NULL' unless defined $val;          # undef = NULL
+   return "''" if $val eq '';                  # blank string = ''
+   return $val if $val =~ m/^0x[0-9a-fA-F]+$/;  # hex data
+
+   $val =~ s/(['\\])/\\$1/g;
+   return "'$val'";
+}
+
+sub split_unquote {
+   my ( $self, $db_tbl, $default_db ) = @_;
+   $db_tbl =~ s/`//g;
+   my ( $db, $tbl ) = split(/[.]/, $db_tbl);
+   if ( !$tbl ) {
+      $tbl = $db;
+      $db  = $default_db;
+   }
+   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 ) = @_;
+   return unless @args;
+
+   return $args[0] if @args == 1 && !defined $args[0];
+
+   die "Cannot serialize multiple values with undef/NULL"
+      if grep { !defined $_ } @args;
+
+   return join ',', map { quotemeta } @args;
+}
+
+sub deserialize_list {
+   my ( $self, $string ) = @_;
+   return $string unless defined $string;
+   my @escaped_parts = $string =~ /
+         \G             # Start of string, or end of previous match.
+         (              # Each of these is an element in the original list.
+            [^\\,]*     # Anything not a backslash or a comma
+            (?:         # When we get here, we found one of the above.
+               \\.      # A backslash followed by something so we can continue
+               [^\\,]*  # Same as above.
+            )*          # Repeat zero of more times.
+         )
+         ,              # Comma dividing elements
+      /sxgc;
+
+   push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
+
+   my @unescaped_parts = map {
+      my $part = $_;
+
+      my $char_class = utf8::is_utf8($part)  # If it's a UTF-8 string,
+                     ? qr/(?=\p{ASCII})\W/   # We only care about non-word
+                     : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
+      $part =~ s/\\($char_class)/$1/g;
+      $part;
+   } @escaped_parts;
+
+   return @unescaped_parts;
+}
+
+1;
+}
+# ###########################################################################
+# End Quoter package
+# ###########################################################################
+
 # ###########################################################################
 # QueryRewriter package
 # This package is a copy without comments from the original.  The original
@@ -4136,6 +4692,93 @@ sub main {
       };
    }
 
+   my $log;
+   my @processlist_columns = qw(
+         Id User Host db Command
+         Time State Info Time_ms
+      );
+
+   if ( my $log_dsn = $o->get('log-dsn') ) {
+      my $db    = $log_dsn->{D};
+      my $table = $log_dsn->{t};
+      die "--log-dsn does not specify a database (D) "
+        . "or a database-qualified table (t)"
+         unless defined $table && defined $db;
+      my $log_cxn   = Cxn->new(
+         dsn_string   => ($dp->get_cxn_params($log_dsn))[0],
+         NAME_lc      => 0,
+         DSNParser    => $dp,
+         OptionParser => $o,
+      );
+      my $log_dbh   = $log_cxn->connect();
+      my $log_table = Quoter->quote($db, $table);
+
+      # Create the log-table table if it doesn't exist and --create-log-table
+      # was passed in
+      my $tp = TableParser->new( Quoter => "Quoter" );
+      if ( !$tp->check_table( dbh => $log_dbh, db => $db, tbl => $table ) ) {
+         if ($o->get('create-log-table') ) {
+            my $sql = $o->read_para_after(
+               __FILE__, qr/MAGIC_create_log_table/);
+            $sql =~ s/kill_log/IF NOT EXISTS $log_table/;
+            PTDEBUG && _d($sql);
+            $log_dbh->do($sql);
+         }
+         else {
+            die "--log-dsn table does not exist. Please create it or specify "
+            . "--create-log-table.";
+         }
+      }
+
+      # All the columns of the table that we care about
+      my @all_log_columns = ( qw( server_id timestamp reason kill_error ),
+                              @processlist_columns );
+
+      my $sql            = 'SELECT @@SERVER_ID';
+      PTDEBUG && _d($sql);
+      my ($server_id)    = $dbh->selectrow_array($sql);
+
+      $sql = "INSERT INTO $log_table ("
+           . join(", ", @all_log_columns)
+           . ") VALUES("
+           . join(", ", $server_id, ("?") x (@all_log_columns-1))
+           . ")";
+      PTDEBUG && _d($sql);
+      my $log_sth = $log_dbh->prepare( $sql );
+
+      my $retry = Retry->new();
+
+      $log = sub {
+         my (@params) = @_;
+         PTDEBUG && _d('Logging values:', @params);
+         return $retry->retry(
+            tries => 20,
+            wait  => sub { sleep 3; },
+            try   => sub { return $log_sth->execute(@params); },
+            fail  => sub {
+               my (%args) = @_;
+               my $error = $args{error};
+               # The 1st pattern means that MySQL itself died or was stopped.
+               # The 2nd pattern means that our cxn was killed (KILL <id>).
+               if (    $error =~ m/MySQL server has gone away/
+                    || $error =~ m/Lost connection to MySQL server/ ) {
+                  eval {
+                     $log_dbh = $log_cxn->connect();
+                     $log_sth = $log_dbh->prepare( $sql );
+                     msg('Reconnected to ' . $cxn->name());
+                  };
+                  return 1 unless $EVAL_ERROR; # try again
+               }
+               return 0; # call final_fail
+            },
+            final_fail => sub {
+               my (%args) = @_;
+               die $args{error};
+            },
+         );
+      };
+   }
+
    # ########################################################################
    # Daemonize only after (potentially) asking for passwords for --ask-pass.
    # ########################################################################
@@ -4339,7 +4982,17 @@ sub main {
                      . " seconds before kill");
                   sleep $o->get('wait-before-kill');
                }
+               local $@;
                eval { $kill->($query->{Id}) };
+               if ( $log ) {
+                  log_to_table(
+                     log        => $log,
+                     query      => $query,
+                     proclist   => $pl,
+                     columns    => \@processlist_columns,
+                     eval_error => $EVAL_ERROR,
+                  );
+               }
                if ( $EVAL_ERROR ) {
                   msg("Error killing $query->{Id}: $EVAL_ERROR");
                }
@@ -4407,6 +5060,21 @@ sub msg {
    return;
 }
 
+sub log_to_table {
+   my (%args) = @_;
+   my ($log, $query, $pl, $processlist_columns)
+            = @args{qw( log query proclist columns )};
+
+   my $ts      = Transformers::ts(localtime);
+   my $reasons = join "\n", map {
+         defined($_) ? $_ : "Unkown reason"
+      } @{ $pl->{_reasons_for_matching}->{$query} };
+   $log->(
+         $ts, $reasons, $args{eval_error},
+         @{$query}{@$processlist_columns}
+   );
+}
+
 sub group_queries {
    my ( %args ) = @_;
    my ($proclist, $group_by, $qr) = @args{qw(proclist group_by QueryRewriter)};
@@ -4632,6 +5300,13 @@ short form: -D; type: string
 
 The database to use for the connection.
 
+=item --create-log-table
+
+Create the L<"--log-dsn"> table if it does not exist.
+
+This option causes the table specified by L<"--log-dsn"> to be created with the
+default structure shown in the documentation for that option.
+
 =item --daemonize
 
 Fork to the background and detach from the shell.  POSIX operating systems
@@ -4736,6 +5411,37 @@ type: string
 
 Print all output to this file when daemonized.
 
+=item --log-dsn
+
+type: DSN
+
+Store each query killed in this DSN.
+
+The argument specifies a table to store all killed queries.  The DSN
+passed in must have the databse (D) and table (t) options. The
+table must have at least the following columns.  You can add more columns for
+your own special purposes, but they won't be used by pt-kill.  The
+following CREATE TABLE definition is also used for L<"--create-log-table">.
+MAGIC_create_log_table:
+
+   CREATE TABLE kill_log (
+      kill_id     int(10) unsigned NOT NULL AUTO_INCREMENT,
+      server_id   bigint(4) NOT NULL DEFAULT '0',
+      timestamp   DATETIME,
+      reason      TEXT,
+      kill_error  TEXT,
+      Id          bigint(4) NOT NULL DEFAULT '0',
+      User        varchar(16) NOT NULL DEFAULT '',
+      Host        varchar(64) NOT NULL DEFAULT '',
+      db          varchar(64) DEFAULT NULL,
+      Command     varchar(16) NOT NULL DEFAULT '',
+      Time        int(7) NOT NULL DEFAULT '0',
+      State       varchar(64) DEFAULT NULL,
+      Info        longtext,
+      Time_ms     bigint(21) DEFAULT '0', # NOTE, TODO: currently not used
+      PRIMARY KEY (kill_id)
+   ) DEFAULT CHARSET=utf8
+
 =item --password
 
 short form: -p; type: string
@@ -5241,6 +5947,10 @@ dsn: user; copy: yes
 
 User for login if not current user.
 
+=item * t
+
+Table to log actions in, if passed through --log-dsn.
+
 =back
 
 =head1 ENVIRONMENT

lib/Processlist.pm

@@ -75,6 +75,7 @@ sub new {
       last_poll   => 0,
       active_cxn  => {},  # keyed off ID
       event_cache => [],
+      _reasons_for_matching => {},
    };
    return bless $self, $class;
 }
@@ -475,7 +476,15 @@ sub find {
             PTDEBUG && _d("Query isn't running long enough");
             next QUERY;
          }
-         PTDEBUG && _d('Exceeds busy time');
+         my $reason = 'Exceeds busy time';
+         PTDEBUG && _d($reason);
+         # Saving the reasons for each query in the objct is a bit nasty,
+         # but the alternatives are worse:
+         # - Saving internal data in the query
+         # - Instead of using the stringified hashref as a key, using
+         #   a checksum of the hashes' contents. Which could occasionally
+         #   fail miserably due to timing-related issues.
+         push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
          $matched++;
       }
 
@@ -486,7 +495,9 @@ sub find {
             PTDEBUG && _d("Query isn't idle long enough");
             next QUERY;
          }
-         PTDEBUG && _d('Exceeds idle time');
+         my $reason = 'Exceeds idle time';
+         PTDEBUG && _d($reason);
+         push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
          $matched++;
       }
  
@@ -507,7 +518,9 @@ sub find {
                PTDEBUG && _d('Query does not match', $property, 'spec');
                next QUERY;
             }
-            PTDEBUG && _d('Query matches', $property, 'spec');
+            my $reason = 'Query matches ' . $property . ' spec';
+            PTDEBUG && _d($reason);
+            push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
             $matched++;
          }
       }

t/lib/Processlist.t

@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings FATAL => 'all';
 use English qw(-no_match_vars);
-use Test::More tests => 34;
+use Test::More tests => 35;
 
 use Processlist;
 use PerconaTest;
@@ -600,6 +600,17 @@ my %find_spec = (
    },
 );
 
+my $matching_query =
+      {  'Time'    => '91',
+         'Command' => 'Query',
+         'db'      => undef,
+         'Id'      => '43',
+         'Info'    => 'select * from foo',
+         'User'    => 'msandbox',
+         'State'   => 'executing',
+         'Host'    => 'localhost'
+      };
+
 my @queries = $pl->find(
    [  {  'Time'    => '488',
          'Command' => 'Connect',
@@ -675,33 +686,24 @@ my @queries = $pl->find(
          'State'   => 'Locked',
          'Host'    => 'localhost'
       },
-      {  'Time'    => '91',
+      $matching_query,
-         'Command' => 'Query',
-         'db'      => undef,
-         'Id'      => '43',
-         'Info'    => 'select * from foo',
-         'User'    => 'msandbox',
-         'State'   => 'executing',
-         'Host'    => 'localhost'
-      },
    ],
    %find_spec,
 );
 
-my $expected = [
+my $expected = [ $matching_query ];
-      {  'Time'    => '91',
-         'Command' => 'Query',
-         'db'      => undef,
-         'Id'      => '43',
-         'Info'    => 'select * from foo',
-         'User'    => 'msandbox',
-         'State'   => 'executing',
-         'Host'    => 'localhost'
-      },
-   ];
 
 is_deeply(\@queries, $expected, 'Basic find()');
 
+{
+   # Internal, fragile test!
+   is_deeply(
+      $pl->{_reasons_for_matching}->{$matching_query},
+      [ 'Exceeds busy time', 'Query matches Command spec', 'Query matches Info spec', ],
+      "_reasons_for_matching works"
+   );
+}
+
 %find_spec = (
    busy_time    => 1,
    ignore => {

t/pt-kill/kill.t

@@ -29,7 +29,7 @@ if ( !$dbh ) {
    plan skip_all => 'Cannot connect to sandbox master';
 }
 else {
-   plan tests => 8;
+   plan tests => 21;
 }
 
 my $output;
@@ -56,8 +56,11 @@ ok(
 
 $output = output(
    sub { pt_kill::main('-F', $cnf, qw(--kill --print --run-time 1 --interval 1),
-      '--match-info', 'select sleep\(4\)') },
+            "--match-info", 'select sleep\(4\)',
+         )
+   },
 );
+
 like(
    $output,
    qr/KILL $pid /,
@@ -116,6 +119,157 @@ is(
    'Connection is still alive'
 );
 
+# #############################################################################
+# Test that --log-dsn
+# #############################################################################
+
+$dbh->do("DROP DATABASE IF EXISTS `kill_test`");
+$dbh->do("CREATE DATABASE `kill_test`");
+
+my $sql = OptionParser->read_para_after(
+   "$trunk/bin/pt-kill", qr/MAGIC_create_log_table/);
+$sql =~ s/kill_log/`kill_test`.`log_table`/;
+
+$dbh->do($sql);
+
+{
+   system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&");
+   sleep 0.5;
+   local $EVAL_ERROR;
+   eval {
+      pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1),
+         "--match-info", 'select sleep\(4\)',
+         "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!,
+      )
+   };
+   is(
+       $EVAL_ERROR,
+      '',
+      "--log-dsn works if the table exists and --create-log-table wasn't passed in."
+   ) or diag $EVAL_ERROR;
+
+   local $EVAL_ERROR;
+   my $results = eval { $dbh->selectall_arrayref("SELECT * FROM `kill_test`.`log_table`", { Slice => {} } ) };
+   is(
+       $EVAL_ERROR,
+       '',
+      "...and we can query the table"
+   ) or diag $EVAL_ERROR;
+
+   is @{$results}, 1, "...which contains one entry";
+   use Data::Dumper;
+   my $reason = $dbh->selectrow_array("SELECT reason FROM `kill_test`.`log_table` WHERE kill_id=1");
+   is $reason,
+      'Query matches Info spec',
+      'reason gets set to something sensible';
+
+   TODO: {
+      local $::TODO = "Time_ms currently isn't reported";
+      my $time_ms = $dbh->selectrow_array("SELECT Time_ms FROM `kill_test`.`log_table` WHERE kill_id=1");
+      ok $time_ms;
+   }
+
+   my $result = shift @$results;
+   my $against = {
+      user    => 'msandbox',
+      host    => 'localhost',
+      db      => undef,
+      command => 'Query',
+      state   => 'User sleep',
+      info    => 'select sleep(4)',
+   };
+   my %trimmed_result;
+   @trimmed_result{ keys %$against } = @{$result}{ keys %$against };
+   $trimmed_result{host} =~ s/localhost:[0-9]+/localhost/;
+   is_deeply(
+      \%trimmed_result,
+      $against,
+      "...and was populated as expected",
+   ) or diag(Dumper($result));
+   
+   system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&");
+   sleep 0.5;
+   local $EVAL_ERROR;
+   eval {
+      pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table),
+         "--match-info", 'select sleep\(4\)',
+         "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!,
+      )
+   };
+   is(
+       $EVAL_ERROR,
+      '',
+      "--log-dsn works if the table exists and --create-log-table was passed in."
+   );
+}
+
+{
+   $dbh->do("DROP TABLE `kill_test`.`log_table`");
+
+   system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&");
+   sleep 0.5;
+   local $EVAL_ERROR;
+   eval {
+      pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table),
+         "--match-info", 'select sleep\(4\)',
+         "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!,
+      )
+   };
+   is(
+       $EVAL_ERROR,
+       '',
+      "--log-dsn works if the table doesn't exists and --create-log-table was passed in."
+   );
+}
+
+{
+   $dbh->do("DROP TABLE `kill_test`.`log_table`");
+
+   local $EVAL_ERROR;
+   eval {
+      pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1),
+         "--match-info", 'select sleep\(4\)',
+         "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!,
+      )
+   };
+   like $EVAL_ERROR,
+      qr/\Q--log-dsn table does not exist. Please create it or specify\E/,
+      "By default, --log-dsn doesn't autogenerate a table";
+}
+
+for my $dsn (
+   q!h=127.1,P=12345,u=msandbox,p=msandbox,t=log_table!,
+   q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test!,
+   q!h=127.1,P=12345,u=msandbox,p=msandbox!,
+) {
+   local $EVAL_ERROR;
+   eval {
+      pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1),
+         "--match-info", 'select sleep\(4\)',
+         "--log-dsn", $dsn,
+      )
+   };
+   like $EVAL_ERROR,
+      qr/\Q--log-dsn does not specify a database (D) or a database-qualified table (t)\E/,
+      "--log-dsn croaks if t= or D= are absent";
+}
+
+# Run it twice
+for (1,2) {
+   system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&");
+   sleep 0.5;
+   pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table),
+      "--match-info", 'select sleep\(4\)',
+      "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!,
+   );
+}
+
+my $results = $dbh->selectall_arrayref("SELECT * FROM `kill_test`.`log_table`");
+
+is @{$results}, 2, "Different --log-dsn runs reuse the same table.";
+
+$dbh->do("DROP DATABASE kill_test");
+
 # #############################################################################
 # Done.
 # #############################################################################