#!/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 complete 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=;database=","","" ,{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/interrupting my $dbh_o=DBI->connect("DBI:mysql:host=;database=","","" ,{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) || shift@{$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_arrayref(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 in processlist!\n"; }; }; $sth_o->finish(); die if $@; exit; __END__