1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
|
#!/usr/local/bin/perl -w
#
#
use strict;
use warnings;
use DBI;
use Config;
use POSIX qw(:signal_h);
use Test::More;
use lib 't','.';
plan skip_all => 'DBD_FIREBIRD_TEST_SKIP_EVENTS found in the environment'
if $ENV{DBD_FIREBIRD_TEST_SKIP_EVENTS};
use TestFirebird;
my $T = TestFirebird->new;
my ($dbh, $error_str) = $T->connect_to_database();
if ($error_str) {
BAIL_OUT("Unknown: $error_str!");
}
unless ( $dbh->isa('DBI::db') ) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
else {
plan tests => 17;
}
ok($dbh, 'Connected to the database');
my $table = find_new_table($dbh);
ok($table, qq{Table is '$table'});
# create required test table and triggers
{
my @ddl = (<<"DDL", <<"DDL", <<"DDL");
CREATE TABLE $table (
id INTEGER NOT NULL,
title VARCHAR(255) NOT NULL
);
DDL
CREATE TRIGGER ins_${table}_trig FOR $table
AFTER INSERT POSITION 0
AS BEGIN
POST_EVENT 'foo_inserted';
END
DDL
CREATE TRIGGER del_${table}_trig FOR $table
AFTER DELETE POSITION 0
AS BEGIN
POST_EVENT 'foo_deleted';
END
DDL
ok($dbh->do($_)) foreach @ddl; # 3 times
}
# detect SIGNAL availability
my $sig_ok = grep { /HUP$/ } split(/ /, $Config{sig_name});
$dbh->disconnect if $dbh->{ib_embedded};
# try fork
{
my $how_many = 8;
SKIP: {
skip "known problems under MSWin32 ActivePerl's emulated fork()", $how_many if $Config{osname} eq 'MSWin32';
skip "SIGHUP is not avalailable", $how_many unless $sig_ok;
my $pid = fork;
skip "failed to fork", $how_many unless defined $pid;
if ($pid) {
%::CNT = ();
my ($dbh, $error_str) = $T->connect_to_database();
ok($dbh, "Connected: $pid");
my $evh = $dbh->func('foo_inserted', 'foo_deleted', 'ib_init_event');
ok($evh);
ok($dbh->func($evh,
sub {
my $posted_events = shift;
while (my ($k, $v) = each %$posted_events) {
#diag "Got event $k";
$::CNT{$k} += $v;
}
1;
},
'ib_register_callback'
), "Event callback registered");
kill SIGHUP => $pid;
is(wait, $pid, "Kid finished");
BAIL_OUT("Kid exit status: $?") unless $? == 0;
# then wait until foo_deleted gets posted
while (not exists $::CNT{'foo_deleted'}) {}
ok($dbh->func($evh, 'ib_cancel_callback'));
ok($dbh->disconnect);
is($::CNT{'foo_inserted'}, 5, "compare number of inserts");
is($::CNT{'foo_deleted'}, 5, "compare number of deleted rows");
} else {
$dbh->{InactiveDestroy} = 1;
$|++;
$SIG{HUP} = sub {
#diag("kid $$ gets sighup\n");
$::SLEEP = 0;
};
$::SLEEP = 1;
while ($::SLEEP) {}
#diag "Kid about to connect";
my ($dbh, $error_str) = $T->connect_to_database({AutoCommit => 1 });
if ($error_str) {
#diag "Kid connection error: $error_str";
die;
}
#diag "Kid connected";
for (1..5) {
#diag "Kid about to insert";
$dbh->do(qq{INSERT INTO $table VALUES($_, 'bar')});
#diag "Inserted a row";
}
$dbh->do(qq{DELETE FROM $table});
#diag "Deleted all rows";
$dbh->disconnect;
#diag "Kid exiting";
exit;
}
}}
($dbh, $error_str) = $T->connect_to_database() if $dbh->{ib_embedded};
ok($dbh->do(qq(DROP TRIGGER ins_${table}_trig)));
ok($dbh->do(qq(DROP TRIGGER del_${table}_trig)));
ok($dbh->do(qq(DROP TABLE $table)), "DROP TABLE $table");
ok($dbh->disconnect);
|