Mini-overhaul pt-deadlock-logger: change --interval default from undef to 30, add --iterations, remove --print, add --quiet, use explicit --columns default, remove --collapse, change default --clear-deadlocks table to percona_schema.clear_deadlocks, refactor the code, use Cxn and Runtime, remove some global vars.

t/pt-deadlock-logger/basics.t

@@ -11,6 +11,8 @@ use warnings FATAL => 'all';
 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 @@ if ( !$dbh1 || !$dbh2 ) {
 }
 
 my $output;
-my $cnf = "/tmp/12345/my.sandbox.cnf";
+my $dsn  = $sb->dsn_for('master');
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
+my @args = ($dsn, qw(--iterations 1));
 
 $dbh1->commit;
 $dbh2->commit;
@@ -90,20 +92,29 @@ make_deadlock();
 $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`;
+$output = output(
-like(
+   sub {
-   $output,
+      pt_deadlock_logger::main(@args, qw(--quiet));
-   qr/127\.1.+msandbox.+GEN_CLUST_INDEX/,
+   }
-   '--print is implicit'
 );
 
+is(
+   $output,
+   "",
+   "No output with --quiet"
+);
 
 # #############################################################################
 # Issue 943: mk-deadlock-logger reports the same deadlock with --interval
@@ -112,55 +123,59 @@ like(
 # 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'
+   'Deadlock saved in --dest table'
-);
+) or diag($output);
 
 # #############################################################################
-# Check that --dest suppress --print output unless --print is explicit.
+# In 2.1, --dest suppressed output (--print).  In 2.2, output is only
+# suppressed by --quiet.
 # #############################################################################
-$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'
-);
-
 $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`;
+$output = output(
-like(
+   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 @@ SKIP: {
    make_deadlock();
 
    $output = output(
-      sub { pt_deadlock_logger::main("F=/tmp/12345/my.sandbox.cnf",
+      sub { pt_deadlock_logger::main(@args) }
-         qw(--print) );
-      }
    );
 
    like(
@@ -200,4 +213,3 @@ $dbh2->commit;
 $sb->wipe_clean($dbh1);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
 done_testing;
-exit;

t/pt-deadlock-logger/clear_deadlocks.t

@@ -22,9 +22,6 @@ my $dbh1 = $sb->get_dbh_for('master');
 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 @@ $sb->create_dbs($dbh1, ['test']);
 
 # 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 @@ like(
 # #############################################################################
 $sb->wipe_clean($dbh1);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;

t/pt-deadlock-logger/create_dest_table.t

@@ -22,15 +22,10 @@ my $dbh1 = $sb->get_dbh_for('master');
 if ( !$dbh1 ) {
    plan skip_all => 'Cannot connect to sandbox master';
 }
-else {
-   plan tests => 3;
-}
 
 my $output;
-my $cnf = "/tmp/12345/my.sandbox.cnf";
+my $dsn = $sb->dsn_for('master');
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
 
-$sb->wipe_clean($dbh1);
 $sb->create_dbs($dbh1, ['test']);
 
 # #############################################################################
@@ -42,17 +37,25 @@ is_deeply(
    '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;

t/pt-deadlock-logger/option_sanity.t

@@ -21,7 +21,7 @@ my $output;
 $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'
 );
 

t/pt-deadlock-logger/standard_options.t

@@ -17,69 +17,96 @@ require "$trunk/bin/pt-deadlock-logger";
 
 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 $dsn  = $sb->dsn_for('master');
-my $cmd = "$trunk/bin/pt-deadlock-logger -F $cnf h=127.1";
+my @args = ($dsn, qw(--iterations 1));
 
-$sb->wipe_clean($dbh1);
+$sb->wipe_clean($dbh);
-$sb->create_dbs($dbh1, ['test']);
+$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');
+$dbh->do('USE test');
-$dbh1->do('USE test');
+$dbh->do('DROP TABLE IF EXISTS deadlocks');
-$dbh1->do('DROP TABLE IF EXISTS deadlocks');
+$sb->load_file('master', 't/pt-deadlock-logger/samples/deadlocks_tbl.sql', 'test');
-$dbh1->do("$deadlocks_tbl");
 
-my $pid_file = '/tmp/mk-deadlock-logger.pid';
+$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`;
-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');
 
 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 @@ ok(
    '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 '`;
+$output = `ps x | grep 'pt-deadlock-logger $dsn' | grep -v grep`;
-unlike(
+
+is(
    $output,
-   qr/$cmd/,
+   "",
    'It does not lived daemonized'
 );
 
@@ -109,6 +144,6 @@ unlink $pid_file;
 # #############################################################################
 # Done.
 # #############################################################################
-$sb->wipe_clean($dbh1);
+$sb->wipe_clean($dbh);
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;