#!/usr/bin/perl

# $ARGV[0] as in
#     "/* Test Query */ SELECT SLEEP($ARGV[0]) FROM lpn LIMIT 1"
# $ARGV[1] as in
#     if ($ARGV[1] =~ /k/i) {
#         $dbh_o->clone()->do("KILL QUERY ".$dbh_o->{"mysql_thread_id"
+});
#          };
#     # Cancel the statement
#     if ($ARGV[1] =~ /c/i) {
#         $sth_o->cancel();
#          };
# $ARGV[2] as in
#     alarm($ARGV[2]);

use Benchmark;
use Data::Dumper;
use DBI;
use strict;
use warnings;
use Sys::SigAction;

    local $SIG{INT}='IGNORE';

    # The following mySQL query will require $ARGV[0] seconds to compl
+ete
    my $SQL_s="/* Test Query */ SELECT SLEEP($ARGV[0]) FROM lpn LIMIT 
+1";
    my @Argument_a=();

    my $t0=Benchmark->new();
    # So we can do a SHOW PROCESSLIST in the future
    my $dbh_o=DBI->connect("DBI:mysql:host=<host>;database=<database>"
+,"<user name>","<password>"
            ,{RaiseError=>1,PrintError=>1,AutoCommit=>1}
             );
    my $sth_o=$dbh_o->prepare("SHOW FULL PROCESSLIST");

    eval {
        # For our "Test Query" that we are hoping to timing out/interr
+upting
        my $dbh_o=DBI->connect("DBI:mysql:host=<host>;database=<databa
+se>","<useer name>","<password>"
                ,{RaiseError=>1,PrintError=>1,AutoCommit=>1,}
                 );
        print STDERR "Connecting to '$dbh_o->{Name}'!\n";
        print STDERR "Connected to '$dbh_o->{mysql_hostinfo}'!\n";
        print STDERR "Connected to '$dbh_o->{mysql_serverinfo}'!\n";
        my $t0=Benchmark->new();
        my $sth_o=$dbh_o->prepare($SQL_s);
        my @_a=();
        my $rows_s;
        eval { # Abending the execute - fatal
            my $TimeOut=Sys::SigAction::set_sig_handler('ALRM',sub {
                            # Clone a handle over which we will "do" a
+ "KILL QUERY ..."
                            if ($ARGV[1] =~ /k/i) {
                                warn "Attempting KILL QUERY.";
                                $dbh_o->clone()->do("KILL QUERY ".$dbh
+_o->{"mysql_thread_id"});
                                 };
                            # Cancel the statement
                            if ($ARGV[1] =~ /c/i) {
                                warn "Attempting cancel.";
                                $sth_o->cancel();
                                 };
                            die "Timed Out!";
                             }
                     );
            my $ControlC=Sys::SigAction::set_sig_handler('INT',sub {
                            # Clone a handle over which we will "do" a
+ "KILL QUERY ..."
                            if ($ARGV[1] =~ /k/i) {
                                warn "Attempting KILL QUERY.";
                                $dbh_o->clone()->do("KILL QUERY ".$dbh
+_o->{"mysql_thread_id"});
                                 };
                            # Cancel the statement
                            if ($ARGV[1] =~ /c/i) {
                                warn "Attempting cancel.";
                                $sth_o->cancel();
                                 };
                            die "Ctrl-C'd!";
                             }
                     );
            # Set alarm
            alarm($ARGV[2]);
            $rows_s=$sth_o->execute(@Argument_a);
            # Clear alarm
            alarm(0);
             };
        # Prevent race condition
        alarm(0);
        die
            if $@;
        my $row_s=0;
        my $Abend_f=0;
        eval { # Abending the fetch - not fatal
            $SIG{INT}=\&interrupt;
            sub interrupt {
                $SIG{INT}=\&interrupt;
                $Abend_f=1;
                 };
            # Preallocate
            $#_a=$rows_s-1;
            # Need field names to build the hash
            my $field_aref=$sth_o->{NAME};
            my ($cache_aref,$row_aref);
            while (!$Abend_f && ($row_aref=shift(@$cache_aref) || shif
+t@{$cache_aref=$sth_o->fetchall_arrayref(undef,10_000) || []})) {
                my $_href;
                @$_href{@$field_aref}=@$row_aref;
                $_a[$row_s++]=$_href;
                 };
             };
        $sth_o->finish();
        if (!$Abend_f) { # Not prematurely terminated
             }
        elsif ($row_s) { # At least one row was read - truncate
            $#_a=$row_s-1;
             }
        else { # No rows were read - truncate
            @_a=();
             };

        # display what was fetched ...
         };
    print STDERR "Elapsed ".Benchmark::timestr(Benchmark::timediff(my 
+$t1=Benchmark->new(),$t0))."\n\n";
    # See if "Test Query" is still running
    $sth_o->execute();
    # Need field names to build the hash
    my $field_aref=$sth_o->{NAME};
    my ($cache,$row);
    while ($row=shift(@$cache) || shift@{$cache=$sth_o->fetchall_array
+ref(undef,10_000) || []}) {
        my %_h;
        @_h{@$field_aref}=@$row;
        if ($_h{Info} =~ m{Test Query}) {
            warn "'Test Query' (thread $_h{Id}:time $_h{Time}) found i
+n processlist!\n";
             };
         };
    $sth_o->finish();

    die
        if $@;
    exit;
__END__
[download]