Zobrazení zdroje stránky Canclování dotazu s DBI - ukázka testu

<pre>
use DBI;
use Perl::Unsafe::Signals;

use IO::Handle;

sub execute_with_reflect_term {
    my ($dbh, $sql) = @_;

    my $sth = $dbh->prepare( $sql );
    
    local $SIG{ TERM } = sub {
	print "sending cancel signal to database\n";
	$sth->cancel;
	print "cancel emmited\n";
    };

    UNSAFE_SIGNALS { $sth->execute };
}

sub rows_exists {
    my ($dbh, $sql) = @_;

    my $sth = $dbh->prepare( $ sql );

    $sth->execute;

    return $sth->rows > 0;
}

sub test {

    close READER;
    
    my $dbh = DBI->connect("dbi:Pg:dbname=postgres host=localhost" .
			   " application_name=CANCEL_TEST",
			   "pavel","", 
			   {RaiseError=>1, PrintError=>0});

    if (!eval {
	
	execute_with_reflect_term ($dbh, "SELECT pg_sleep(1000)");

	}) {
	if ($dbh->state eq '57014') {
	    print WRITER "*** Query cancelled ***";
	} else {
	    print WRITER "unexpected error: >>$DBI::state<< >>$DBI::err<< >>$DBI::errstr<<\n$@"
	}
    }

    close WRITER;
    exit;
}


$dbh_alfa = DBI->connect("dbi:Pg:dbname=postgres host=localhost application_name=test_parent",
			 "pavel","", 
			 {RaiseError=>1, PrintError=>0});

if (rows_exists($dbh_alfa,
		"SELECT * FROM pg_stat_activity WHERE application_name='CANCEL_TEST'")) {
    die "clean PostgreSQL connections first";
}


# close this connect before new fork,
# because killing child kills it too. It is available from child.
$dbh_alfa->disconnect;

pipe(READER, WRITER);
WRITER->autoflush(1);

my $pid = fork;

if (!defined $pid) {
    die "Cannot fork: $!";
}
elsif ($pid == 0) {
    # client process

    test;
}
else {
    # parent process

    sleep 1;

    close WRITER;
    
    $dbh_alfa = DBI->connect("dbi:Pg:dbname=postgres host=localhost application_name=test_parent",
			     "pavel","", 
			     {RaiseError=>1, PrintError=>0});

    if (! rows_exists($dbh_alfa,
		"SELECT * FROM pg_stat_activity WHERE application_name='CANCEL_TEST'")) {
	die "cannot start test";
    }	      

    print "subprocess started corectly, sending SIGTERM\n";
    kill(15, $pid);
    waitpid $pid, 0;

    if (rows_exists($dbh_alfa,
		    "SELECT * FROM pg_stat_activity WHERE application_name='CANCEL_TEST'")) {
	die "subprocess didn't cancel own long query";
    }

    print "subprocess terminated long query corectly\n";

    chomp ($line = <READER>);

    if ($line eq "*** Query cancelled ***") {
	print "subprocess returned expected result\n";
    }
    else {
	die "unexpected result from subprocess: $line";
    }
	
    close READER;

    print "test is complete.\n"   
}
</pre>