← Back to branch summary

~percona-toolkit-dev/percona-toolkit/stabilize-test-suite

« back to all changes in this revision

Viewing changes to bin/pt-tcp-model

  • Committer: Baron Schwartz
  • Date: 2012-06-09 18:43:33 UTC
  • Revision ID: baron@xaprb.com-20120609184333-qq32wxsbu7cgyftp
Fix a bazillion tests with ANSI sql_mode, and get rid of a bunch of MySQLDump usage.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/pt-tcp-model
959
959
      $opt->{value} = ($pre || '') . $num;
960
960
   }
961
961
   else {
962
 
      $self->save_error("Invalid size for --$opt->{long}");
 
962
      $self->save_error("Invalid size for --$opt->{long}: $val");
963
963
   }
964
964
   return;
965
965
}
1051
1051
 
1052
1052
use Time::Local qw(timegm timelocal);
1053
1053
use Digest::MD5 qw(md5_hex);
 
1054
use B qw();
1054
1055
 
1055
1056
require Exporter;
1056
1057
our @ISA         = qw(Exporter);
1068
1069
   any_unix_timestamp
1069
1070
   make_checksum
1070
1071
   crc32
 
1072
   encode_json
1071
1073
);
1072
1074
 
1073
1075
our $mysql_ts  = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
1275
1277
   return $crc ^ 0xFFFFFFFF;
1276
1278
}
1277
1279
 
 
1280
my $got_json = eval { require JSON };
 
1281
sub encode_json {
 
1282
   return JSON::encode_json(@_) if $got_json;
 
1283
   my ( $data ) = @_;
 
1284
   return (object_to_json($data) || '');
 
1285
}
 
1286
 
 
1287
 
 
1288
sub object_to_json {
 
1289
   my ($obj) = @_;
 
1290
   my $type  = ref($obj);
 
1291
 
 
1292
   if($type eq 'HASH'){
 
1293
      return hash_to_json($obj);
 
1294
   }
 
1295
   elsif($type eq 'ARRAY'){
 
1296
      return array_to_json($obj);
 
1297
   }
 
1298
   else {
 
1299
      return value_to_json($obj);
 
1300
   }
 
1301
}
 
1302
 
 
1303
sub hash_to_json {
 
1304
   my ($obj) = @_;
 
1305
   my @res;
 
1306
   for my $k ( sort { $a cmp $b } keys %$obj ) {
 
1307
      push @res, string_to_json( $k )
 
1308
         .  ":"
 
1309
         . ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) );
 
1310
   }
 
1311
   return '{' . ( @res ? join( ",", @res ) : '' )  . '}';
 
1312
}
 
1313
 
 
1314
sub array_to_json {
 
1315
   my ($obj) = @_;
 
1316
   my @res;
 
1317
 
 
1318
   for my $v (@$obj) {
 
1319
      push @res, object_to_json($v) || value_to_json($v);
 
1320
   }
 
1321
 
 
1322
   return '[' . ( @res ? join( ",", @res ) : '' ) . ']';
 
1323
}
 
1324
 
 
1325
sub value_to_json {
 
1326
   my ($value) = @_;
 
1327
 
 
1328
   return 'null' if(!defined $value);
 
1329
 
 
1330
   my $b_obj = B::svref_2object(\$value);  # for round trip problem
 
1331
   my $flags = $b_obj->FLAGS;
 
1332
   return $value # as is 
 
1333
      if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
 
1334
 
 
1335
   my $type = ref($value);
 
1336
 
 
1337
   if( !$type ) {
 
1338
      return string_to_json($value);
 
1339
   }
 
1340
   else {
 
1341
      return 'null';
 
1342
   }
 
1343
 
 
1344
}
 
1345
 
 
1346
my %esc = (
 
1347
   "\n" => '\n',
 
1348
   "\r" => '\r',
 
1349
   "\t" => '\t',
 
1350
   "\f" => '\f',
 
1351
   "\b" => '\b',
 
1352
   "\"" => '\"',
 
1353
   "\\" => '\\\\',
 
1354
   "\'" => '\\\'',
 
1355
);
 
1356
 
 
1357
sub string_to_json {
 
1358
   my ($arg) = @_;
 
1359
 
 
1360
   $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
 
1361
   $arg =~ s/\//\\\//g;
 
1362
   $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
 
1363
 
 
1364
   utf8::upgrade($arg);
 
1365
   utf8::encode($arg);
 
1366
 
 
1367
   return '"' . $arg . '"';
 
1368
}
 
1369
 
1278
1370
sub _d {
1279
1371
   my ($package, undef, $line) = caller 0;
1280
1372
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1360
1452
sub start {
1361
1453
   my ( $self, $start ) = @_;
1362
1454
   $self->{start} = $self->{last_reported} = $start || time();
 
1455
   $self->{first_report} = 0;
1363
1456
}
1364
1457
 
1365
1458
sub update {
1366
 
   my ( $self, $callback, $now ) = @_;
 
1459
   my ( $self, $callback, %args ) = @_;
1367
1460
   my $jobsize   = $self->{jobsize};
1368
 
   $now        ||= time();
 
1461
   my $now    ||= $args{now} || time;
 
1462
 
1369
1463
   $self->{iterations}++; # How many updates have happened;
1370
1464
 
 
1465
   if ( !$self->{first_report} && $args{first_report} ) {
 
1466
      $args{first_report}->();
 
1467
      $self->{first_report} = 1;
 
1468
   }
 
1469
 
1371
1470
   if ( $self->{report} eq 'time'
1372
1471
         && $self->{interval} > $now - $self->{last_reported}
1373
1472
   ) {