imported>Pavel: Založena nová stránka s textem „

 use DBI; use Perl::Unsafe::Signals;  use IO::Handle;  sub execute_with_reflect_term {     my ($dbh, $sql) = @_;      my $sth = $dbh->prepare( $sql );…“

2014-12-14T06:57:36Z

Založena nová stránka s textem „<pre> use DBI; use Perl::Unsafe::Signals; use IO::Handle; sub execute_with_reflect_term { my ($dbh, $sql) = @_; my $sth = $dbh->prepare( $sql );…“

Nová stránka

<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>

Canclování dotazu s DBI - ukázka testu - Historie editací

imported>Pavel: Založena nová stránka s textem „
use DBI; use Perl::Unsafe::Signals; use IO::Handle; sub execute_with_reflect_term { my ($dbh, $sql) = @_; my $sth = $dbh->prepare( $sql );…“