Fix a bazillion tests with ANSI sql_mode, and get rid of a bunch of MySQLDump usage.

bin/pt-kill

@@ -1056,20 +1056,81 @@ sub new {
 
 sub parse {
    my ( $self, $str ) = @_;
-   my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);
+   my @version_parts = $str =~ m/(\d+)/g;
+   @version_parts = map { $_ || 0 } @version_parts[0..2];
+   my $result = sprintf('%03d%03d%03d', @version_parts);
    PTDEBUG && _d($str, 'parses to', $result);
    return $result;
 }
 
+sub version_cmp {
+   my ($self, $dbh, $target, $cmp) = @_;
+   my $version = $self->version($dbh);
+   my $result;
+
+   if ( $cmp eq 'ge' ) {
+      $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
+   }
+   elsif ( $cmp eq 'gt' ) {
+      $result = $self->{$dbh} gt $self->parse($target) ? 1 : 0;
+   }
+   elsif ( $cmp eq 'eq' ) {
+      $result = $self->{$dbh} eq $self->parse($target) ? 1 : 0;
+   }
+   elsif ( $cmp eq 'ne' ) {
+      $result = $self->{$dbh} ne $self->parse($target) ? 1 : 0;
+   }
+   elsif ( $cmp eq 'lt' ) {
+      $result = $self->{$dbh} lt $self->parse($target) ? 1 : 0;
+   }
+   elsif ( $cmp eq 'le' ) {
+      $result = $self->{$dbh} le $self->parse($target) ? 1 : 0;
+   }
+   else {
+      die "Asked for an unknown comparizon: $cmp"
+   }
+
+   PTDEBUG && _d($self->{$dbh}, $cmp, $target, ':', $result);
+   return $result;
+}
+
 sub version_ge {
    my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'ge');
+}
+
+sub version_gt {
+   my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'gt');
+}
+
+sub version_eq {
+   my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'eq');
+}
+
+sub version_ne {
+   my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'ne');
+}
+
+sub version_lt {
+   my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'lt');
+}
+
+sub version_le {
+   my ( $self, $dbh, $target ) = @_;
+   return $self->version_cmp($dbh, $target, 'le');
+}
+
+sub version {
+   my ( $self, $dbh ) = @_;
    if ( !$self->{$dbh} ) {
       $self->{$dbh} = $self->parse(
          $dbh->selectrow_array('SELECT VERSION()'));
    }
-   my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
-   PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
-   return $result;
+   return $self->{$dbh};
 }
 
 sub innodb_version {
@@ -1410,7 +1471,7 @@ sub get_dbh {
          '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 => {}})),
+                     "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
       '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
       '$DBI::VERSION:',        $DBI::VERSION,
    );
@@ -1685,6 +1746,7 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
 use Time::Local qw(timegm timelocal);
 use Digest::MD5 qw(md5_hex);
+use B qw();
 
 require Exporter;
 our @ISA         = qw(Exporter);
@@ -1702,6 +1764,7 @@ our @EXPORT_OK   = qw(
    any_unix_timestamp
    make_checksum
    crc32
+   encode_json
 );
 
 our $mysql_ts  = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
@@ -1909,6 +1972,96 @@ sub crc32 {
    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; }
@@ -2177,7 +2330,7 @@ sub find {
       }
 
       if ( $find_spec{busy_time} && ($query->{Command} || '') eq 'Query' ) {
-         next QUERY unless defined $query->{Time};
+         next QUERY unless defined($query->{Time});
          if ( $query->{Time} < $find_spec{busy_time} ) {
             PTDEBUG && _d("Query isn't running long enough");
             next QUERY;
@@ -2187,7 +2340,7 @@ sub find {
       }
 
       if ( $find_spec{idle_time} && ($query->{Command} || '') eq 'Sleep' ) {
-         next QUERY unless defined $query->{Time};
+         next QUERY unless defined($query->{Time});
          if ( $query->{Time} < $find_spec{idle_time} ) {
             PTDEBUG && _d("Query isn't idle long enough");
             next QUERY;
@@ -2488,6 +2641,9 @@ sub get_slaves {
          dsn_table_dsn => $dsn_table_dsn,
       );
    }
+   elsif ( $method =~ m/none/i ) {
+      PTDEBUG && _d('Not getting to slaves');
+   }
    else {
       die "Invalid --recursion-method: $method.  Valid values are: "
         . "dsn=DSN, hosts, or processlist.\n";
@@ -2502,6 +2658,11 @@ sub recurse_to_slaves {
    my $dp   = $args->{dsn_parser};
    my $dsn  = $args->{dsn};
 
+   if ( lc($args->{method} || '') eq 'none' ) {
+      PTDEBUG && _d('Not recursing to slaves');
+      return;
+   }
+
    my $dbh;
    eval {
       $dbh = $args->{dbh} || $dp->get_dbh(
@@ -2683,7 +2844,7 @@ sub is_master_of {
       or die "The server specified as a slave is not a slave";
    my @connected     = $self->get_connected_slaves($master)
       or die "The server specified as a master has no connected slaves";
-   my (undef, $port) = $master->selectrow_array('SHOW VARIABLES LIKE "port"');
+   my (undef, $port) = $master->selectrow_array("SHOW VARIABLES LIKE 'port'");
 
    if ( $port != $slave_status->{master_port} ) {
       die "The slave is connected to $slave_status->{master_port} "
@@ -3245,8 +3406,25 @@ sub fingerprint {
    $query =~ s/\\["']//g;                # quoted strings
    $query =~ s/".*?"/?/sg;               # quoted strings
    $query =~ s/'.*?'/?/sg;               # quoted strings
-   $query =~ s/[0-9+-][0-9a-f.xb+-]*/?/g;# Anything vaguely resembling numbers
-   $query =~ s/[xb.+-]\?/?/g;            # Clean up leftovers
+
+   if ( $self->{match_md5_checksums} ) { 
+      $query =~ s/([._-])[a-f0-9]{32}/$1?/g;
+   }
+
+   if ( !$self->{match_embedded_numbers} ) {
+      $query =~ s/[0-9+-][0-9a-f.xb+-]*/?/g;
+   }
+   else {
+      $query =~ s/\b[0-9+-][0-9a-f.xb+-]*/?/g;
+   }
+
+   if ( $self->{match_md5_checksums} ) {
+      $query =~ s/[xb+-]\?/?/g;                
+   }
+   else {
+      $query =~ s/[xb.+-]\?/?/g;
+   }
+
    $query =~ s/\A\s+//;                  # Chop off leading whitespace
    chomp $query;                         # Kill trailing whitespace
    $query =~ tr[ \n\t\r\f][ ]s;          # Collapse whitespace