view release on metacpan or search on metacpan
the File::Temp template verbatim.
- UPGRADE NOTE: instance directory names grow by up to 8 characters, against
the 107-byte limit on unix socket paths. An instance_dir already close to
that limit may need shortening.
- clone_dir failures now report the decoded exit code, any terminating
signal, both paths and the tool's stderr, instead of a raw wait status
such as "rsync returned 5888".
- clone_dir now retries an rsync exit 23 (partial transfer) twice before
giving up, and warns when a retry recovers.
- The watcher now reaps its server. A server that died during startup became
a zombie, and kill(0) succeeds on a zombie, so start() called it alive and
waited out the whole QDB_START_TIMEOUT; it now fails in milliseconds with
the real exit status.
- The watcher now resets SIGCHLD to its default before spawning the server.
An application that ignores SIGCHLD had the kernel reap the server first,
leaving no exit status to record.
- Watcher teardown now removes a disposable data directory even when the
server cannot be stopped. Reusable directories (cleanup => 0, used for
Pool templates) are still never removed.
- Watcher teardown failures now report their reason instead of a bare
"Warning: something's wrong".
- t/Pool wraps every server-spawning db()/fetch_db() in the resource-skip helper so a semaphore-exhausted host skips instead of failing.
0.000049 2026-06-09 17:14:55-07:00 America/Los_Angeles
- Added Driver::destroy_quietly(): fast-destroy teardown for disposable clones (cleanup => 1) that kills, reaps, and removes the data dir immediately instead of a graceful shutdown that can block 2*QDB_STOP_GRACE+2 seconds.
- Added an opt-in fast_destroy attribute: DESTROY uses destroy_quietly() when cleanup => 1, falls through to the graceful path when cleanup => 0, and is inherited by clones via clone_data().
- Added per-driver fast_stop_sig() for fast/forced teardown: default SIGKILL, PostgreSQL overrides to SIGQUIT so the postmaster releases its SysV semaphores instead of leaking them; watcher escalates to SIGKILL if it does not stop promptly.
- Added a watcher fast-eliminate request (SIGUSR1) that kills with fast_stop_sig, reaps, and deletes the data dir; blocked (not ignored) across the startup exec so a request racing startup stays pending instead of being dropped.
- The graceful teardown path (stop()/eliminate()) now escalates a stuck shutdown through fast_stop_sig before SIGKILL, so it releases SysV semaphores instead of leaking them.
- get_db() and the pool tests skip_all instead of failing when a host is out of System V semaphores/shared memory; added skipall_on_resource_error(), also covering the DBIx::QuickDB->import path (t/QuickDB) and mid-run pool clone builds (t/Pool).
- On a start timeout, start() now reports the server's launch log and whether its process is still alive, instead of only the often-empty error log.
- Added t/fast_destroy.t, t/watcher_fast_kill.t, and t/resource_skip.t.
0.000048 2026-06-06 10:53:27-07:00 America/Los_Angeles
- Fixed a pid-reuse race that could shut down the wrong database server. After a server was stopped, its watcher exited and the OS could recycle the watcher's pid; a later teardown signal (e.g. eliminate() from the watcher object's DESTROY, which...
- Removed two redundant pid-signalling paths that carried the same pid-reuse hazard: the post-wait() server-pid poll in Driver::stop() (the watcher already reaps the server before it exits, so stop() now just trusts wait()) and the direct server-...
- Added t/clone_sequence.t, an explicit PostgreSQL regression asserting a clone of a stopped source continues its SERIAL sequence with the exact next id (no SEQ_LOG_VALS +32 jump); the broad Pool test only checks id ordering
0.000047 2026-06-05 22:35:47-07:00 America/Los_Angeles
lib/DBIx/QuickDB/Driver.pm view on Meta::CPAN
confess $msg;
}
if ($waited > $timeout) {
# Capture diagnostics BEFORE eliminate() removes the data dir (which
# holds both the error log and the watcher's launch log). The server
# process's own stdout/stderr go to the watcher's log_file, not the
# driver's error_log, so a server that died (or never launched)
# before writing error_log leaves error_log showing only inherited
# template history -- the real failure is in the launch log. Also
# report whether the server pid is still alive: "not running" points
# at a launch/early-exit failure, "alive" at a slow or hung startup.
# Recorded status before kill(0), which succeeds on a zombie and so
# mislabelled a crashed server as a slow start.
my $spid = $watcher->server_pid;
my $status = $self->_server_exit_status;
my $alive
= $status ? "not running ($status)"
: ($spid && kill(0, $spid)) ? "alive (pid $spid)"
: "not running";
my $error_log = $self->read_error_log;
my $launch_log = $self->_read_file($watcher->log_file);
$watcher->eliminate();
my $msg = "Timed out waiting for server to start after ${timeout}s; server process is $alive.";
$msg .= "\n=== server launch log ===\n$launch_log" if length $launch_log;
$msg .= "\n=== error log ===\n$error_log" if length $error_log;
confess $msg;
}
sleep 0.01;
}
return;
}
lib/DBIx/QuickDB/Watcher.pm view on Meta::CPAN
open(STDOUT, '>', \$blah) or warn "$!";
close(STDERR);
open(STDERR, '>', \$blah) or warn "$!";
$hupped = 1;
}
sleep 0.1;
# Nothing else reaps the server, so a crashed one would linger as a
# zombie -- and kill(0) succeeds on a zombie, which made start() report
# it alive and wait out the whole timeout. Keep watching after the reap:
# exiting here would run teardown and delete the logs start() needs.
$reaped ||= $class->_reap_server($server_pid, $data_dir);
next if kill(0, $master_pid);
$kill = $owner_kill;
}
unless (eval { $class->_watcher_terminate(send_sig => $signal, fast_sig => $fast_signal, got_sig => $kill, pid => $server_pid, dir => $data_dir, delete_data => $delete_data, already_reaped => $reaped); 1 }) {
# warn $err, not $@: entering an eval BLOCK clears $@, which stripped
# the message off every teardown failure.
lib/DBIx/QuickDB/Watcher.pm view on Meta::CPAN
# Give the watcher long enough to finish a graceful shutdown. The watcher
# escalates to SIGKILL on the server after QDB_STOP_GRACE and then BLOCKS
# until the server is reaped, so this must outlast the watcher's own
# escalation schedule (grace + grace/2, plus slack).
my $timeout = _stop_grace() * 2 + 2;
# A watcher that outlives $timeout is almost never hung -- the usual
# cause is a server the kernel has not been able to kill yet (e.g. stuck
# in disk-sleep under heavy I/O), with the watcher dutifully blocking on
# the post-SIGKILL reap. Killing the watcher at that point orphans a
# still-alive server, so stop() would return "success" while the data dir
# is locked by a live postmaster/mysqld and the next start on that dir
# fails on the stale lock file. So past $timeout we only warn, keep
# waiting on a much longer leash, and SIGKILL the watcher purely as a
# last resort. Tunable via QDB_STOP_LEASH (extra seconds past $timeout).
my $extra = $ENV{QDB_STOP_LEASH};
$extra = 60 unless defined($extra) && $extra =~ /^\d+$/ && $extra > 0;
my $leash = $timeout + $extra;
my ($warned, $nuked);
my $start = time;
lib/DBIx/QuickDB/Watcher.pm view on Meta::CPAN
sleep 0.02;
}
# The watcher has exited; forget its pid so no later teardown signal (e.g.
# from DESTROY) can land on a recycled pid now owned by another process.
delete $self->{+WATCHER_PID};
# The server may have outlived the watcher, so verify with a read-only
# kill(0). Never send a real signal here -- the pid may have been recycled,
# and a false "alive" should cost a warning, not a wrong kill.
#
# Skipped only when the watch loop recorded an exit status, which proves it
# reaped the server; the pid may since have been recycled, and probing it
# would report a false "alive" and stall for the whole timeout. A missing
# data dir proves nothing here -- teardown removes a disposable dir whether
# or not it managed to stop the server.
$self->_latch_server_reaped;
if (!$self->{+SERVER_REAPED} and my $spid = $self->{+SERVER_PID}) {
my $sstart = time;
while (kill(0, $spid)) {
if (time - $sstart > $timeout) {
warn "Server (pid $spid) still appears to be alive after its watcher exited; its data dir may still be locked";
last;
}
sleep 0.02;
}
}
}
sub DESTROY {
my $self = shift;
t/Pool/Pool.pm view on Meta::CPAN
push @out, " socket: " . (defined $sock ? $sock : '?')
. " exists=" . (defined $sock && -e $sock ? 1 : 0)
. " is_socket=" . (defined $sock && -S $sock ? 1 : 0);
push @out, " started(): " . (eval { $db->started } ? 1 : 0);
my $w = $db->{ +DBIx::QuickDB::Driver::WATCHER() };
if ($w) {
my $spid = eval { $w->server_pid };
push @out, " server_pid: " . (defined $spid ? $spid : '?')
. " alive=" . (defined $spid && kill(0, $spid) ? 1 : 0);
}
else {
push @out, " watcher: none (object thinks it is stopped)";
}
my $log = eval { $db->error_log };
if ($log && -f $log) {
open(my $fh, '<', $log) or push(@out, " error.log: open failed: $!");
if ($fh) {
my @l = <$fh>;
t/Pool/Pool.pm view on Meta::CPAN
# sources it was cloned from, then rethrow so the test still fails.
sub diag_connect {
my ($db, $label, @others) = @_;
my $dbh;
return $dbh if eval { $dbh = $db->connect(); 1 };
my $err = $@;
print STDERR "==== QDB-DIAG connect FAILED for [$label]: $err\n";
qdb_diag($db, $label);
qdb_diag($_->[1], $_->[0]) for @others;
# Global snapshot: which postgres processes are alive (orphans?), and the
# System V IPC objects in play -- the prime suspect for this 9.3 race.
my $ps = eval { `ps -axww 2>/dev/null | grep '[p]ostgres'` };
print STDERR "==== QDB-DIAG postgres processes ====\n", (length($ps // '') ? $ps : " (none)\n");
my $ipcs = eval { `ipcs -a 2>/dev/null` };
print STDERR "==== QDB-DIAG ipcs -a ====\n", (length($ipcs // '') ? $ipcs : " (none)\n");
die $err;
}
ok($driver, "Got a driver ($driver)") or die "Cannot continue without a driver";
t/clone_cleanup.t view on Meta::CPAN
# The watcher that owns teardown is Unix-only (fork + setsid + POSIX signals).
skip_all "clone teardown relies on the Unix-only watcher (no POSIX signals on $^O)"
if $^O eq 'MSWin32';
my $db = get_db_or_skipall({driver => 'PostgreSQL'});
# clone() requires a stopped source.
$db->stop if $db->started;
sub pid_alive { my $pid = shift; return 0 unless $pid; return kill(0, $pid) ? 1 : 0 }
my ($dir, $spid, $wpid);
{
my $clone = $db->clone(autostart => 1);
# An open handle used to stall the graceful shutdown -- keep one open so this
# exercises the disconnect-then-stop path a real caller hits.
my $dbh = $clone->connect('quickdb');
ok($dbh->{Active}, "connected to the clone");
$dir = $clone->dir;
$spid = $clone->watcher->server_pid;
$wpid = $clone->watcher->watcher_pid;
ok(-d $dir, "clone data dir exists while clone is in scope");
ok(pid_alive($spid), "clone server is alive while clone is in scope");
like($dir, qr/DB-QUICK-CLONE-/, "clone lives in a DB-QUICK-CLONE-* dir");
# Drop the last reference -> graceful DESTROY.
}
# DESTROY -> eliminate + wait: the watcher stops the server, reaps it, removes
# the data dir, then exits. Give it a generous window for a loaded host.
my $start = time;
while (pid_alive($spid) || pid_alive($wpid) || -d $dir) {
last if time - $start > 30;
select(undef, undef, undef, 0.05);
}
ok(!pid_alive($spid), "clone server daemon gone after the clone dropped (GH #10)");
ok(!pid_alive($wpid), "clone watcher gone after the clone dropped");
ok(!-d $dir, "clone data dir removed after the clone dropped (GH #10)");
done_testing;
t/fast_destroy.t view on Meta::CPAN
# SQLite driver is viable, so there is nothing to exercise here. The PostgreSQL
# requirement below would skip anyway; this is an explicit, faster guard.
skip_all "fast destroy relies on the Unix-only watcher (no POSIX signals on $^O)"
if $^O eq 'MSWin32';
my $db = get_db_or_skipall({driver => 'PostgreSQL'});
# clone() requires a stopped source.
$db->stop if $db->started;
sub pid_alive { my $pid = shift; return 0 unless $pid; return kill(0, $pid) ? 1 : 0 }
subtest destroy_quietly_basic => sub {
my $clone = $db->clone(autostart => 1, cleanup => 1);
my $dir = $clone->dir;
my $watcher = $clone->watcher;
my $spid = $watcher->server_pid;
my $wpid = $watcher->watcher_pid;
ok(pid_alive($spid), "server is alive before destroy_quietly");
ok(-d $dir, "data dir exists before destroy_quietly");
# Big grace: if destroy_quietly used the graceful path this would block for
# tens of seconds. It must not.
local $ENV{QDB_STOP_GRACE} = 30;
my $start = time;
$clone->destroy_quietly;
my $elapsed = time - $start;
# Threshold is generous (grace=30 means the graceful path would block up to
# 2*30+2=62s) so a loaded host running this suite under prove -j8 does not
# flake; it still proves the grace wait was skipped entirely.
ok($elapsed < 15, "destroy_quietly did not wait for QDB_STOP_GRACE (${elapsed}s)");
# Watcher reaps the server before exiting; once the watcher is gone the
# server is gone too.
my $gone_start = time;
while (pid_alive($wpid) || pid_alive($spid)) {
last if time - $gone_start > 15;
select(undef, undef, undef, 0.02);
}
ok(!pid_alive($spid), "server process is gone after destroy_quietly");
ok(!pid_alive($wpid), "watcher process is gone after destroy_quietly");
ok(!-d $dir, "data dir removed after destroy_quietly");
};
subtest no_checkpoint_no_stop => sub {
my $clone = $db->clone(autostart => 1, cleanup => 1);
our ($checkpoint_called, $stop_called) = (0, 0);
{
no warnings 'once';
package Spy::FastDestroy;
t/fast_destroy.t view on Meta::CPAN
my $start = time;
undef $clone;
my $elapsed = time - $start;
# Generous threshold (vs grace=30 -> up to 62s graceful) to stay robust
# under prove -j8 load while still proving the fast path was taken.
ok($elapsed < 15, "DESTROY used fast path, no QDB_STOP_GRACE wait (${elapsed}s)");
my $gone = time;
while (pid_alive($wpid) || pid_alive($spid)) {
last if time - $gone > 15;
select(undef, undef, undef, 0.02);
}
ok(!pid_alive($spid), "server gone after fast DESTROY");
ok(!pid_alive($wpid), "watcher gone after fast DESTROY");
ok(!-d $dir, "data dir removed after fast DESTROY");
};
subtest fast_destroy_attr_inherited_by_clone => sub {
# The attribute must propagate through clone_data() so a clone of a
# fast_destroy source is itself fast_destroy.
my $clone = $db->clone(cleanup => 1, fast_destroy => 1);
ok($clone->fast_destroy, "clone carries fast_destroy");
my %data = $clone->clone_data;
t/lib/QDB/DriverBody.pm view on Meta::CPAN
"Original DB not changed"
);
};
subtest cleanup => sub {
my $db = get_db {driver => $driver, load_sql => [quickdb => $params->{schema}]};
my $dir = $db->dir;
my $pid = $params->{server} ? $db->watcher->server_pid : undef;
ok(-d $dir, "Can see the db dir");
ok(kill(0, $pid), "Can signal the db process (it's alive!)") if $pid;
$db = undef;
my $start = time;
my $pid_gone = $pid ? 0 : 1;
my $dir_gone = 0;
while (1) {
$pid_gone ||= !kill(0, $pid) if $pid;
$dir_gone ||= !-d $dir;
last if $pid_gone && $dir_gone;
t/server_exit_status.t view on Meta::CPAN
if $^O eq 'MSWin32';
use FindBin qw/$Bin/;
use lib "$Bin/lib";
use DBIx::QuickDB::Watcher;
use QDB::FakeDriver;
# The watcher's server is its own child and nothing else reaped it, so a crashed
# server lingered as a zombie -- and kill(0) succeeds on a zombie, so start()
# called it alive and waited out the whole timeout. The watcher now reaps it and
# records the wait status where the owner, which cannot waitpid, can read it.
my $dir = tempdir("QDB-TEST-$$-XXXXXX", TMPDIR => 1, CLEANUP => 1);
# Returns -1 rather than dying, so an exhausted poll budget fails one assertion
# instead of aborting the file.
sub read_status {
my ($file) = @_;
open(my $fh, '<', $file) or do {
t/server_exit_status.t view on Meta::CPAN
subtest zombie_defeats_kill_0 => sub {
my $pid = fork();
die "Could not fork: $!" unless defined $pid;
if (!$pid) { POSIX::_exit(0) }
# Give it a moment to exit without reaping it.
sleep 1;
ok(kill(0, $pid), "kill(0) still succeeds on the unreaped (zombie) child")
or diag("This premise is what made the old 'alive' probe wrong");
waitpid($pid, 0);
};
subtest reap_records_status => sub {
my $sdir = tempdir("QDB-TEST-$$-XXXXXX", TMPDIR => 1, CLEANUP => 1);
my $file = DBIx::QuickDB::Watcher->server_exit_status_file($sdir);
my $pid = fork();
die "Could not fork: $!" unless defined $pid;
t/server_exit_status.t view on Meta::CPAN
# exits without running destructors the watcher is the only cleanup.
my $method = $case->{method};
$watcher->$method;
# Captured rather than left to leak into the harness, and asserted: a
# server this pathological is exactly what the probe exists to report,
# so losing the warning is a regression.
my $warnings = warnings { $watcher->wait };
like(
join("\n", @$warnings),
qr/still appears to be alive/,
"wait() reported the server that outlived its watcher",
);
my $watcher_stderr = do {
open(my $fh, '<', $errfile) or die "Could not read '$errfile': $!";
local $/;
<$fh> // '';
};
like(
$watcher_stderr,
t/server_exit_status.t view on Meta::CPAN
local $ENV{QDB_STOP_GRACE} = 1;
my $sdir = tempdir("QDB-TEST-$$-XXXXXX", TMPDIR => 1, CLEANUP => 1);
open(my $sfh, '>', DBIx::QuickDB::Watcher->server_exit_status_file($sdir))
or die "Could not write status: $!";
print $sfh "0\n";
close($sfh);
# Stands in for a watcher that has not exited yet, and for a server pid
# since recycled to something unrelated and alive.
my $fake_watcher = fork();
die "Could not fork: $!" unless defined $fake_watcher;
if (!$fake_watcher) { $SIG{TERM} = 'IGNORE'; $SIG{USR1} = 'IGNORE'; sleep 60; POSIX::_exit(0) }
my $decoy_server = fork();
die "Could not fork: $!" unless defined $decoy_server;
if (!$decoy_server) { sleep 60; POSIX::_exit(0) }
my $watcher = bless {
DBIx::QuickDB::Watcher::DATA_DIR() => $sdir,
t/watcher_fast_kill.t view on Meta::CPAN
# _watcher_kill_fast() backs the fast/disposable teardown. It must:
# - send the requested signal (not always SIGKILL) so a driver can pick a
# clean immediate-shutdown signal that releases OS resources, and
# - escalate to SIGKILL if that signal does not stop the server promptly,
# so teardown always completes.
# These need fork() and real signals; skip where that does not apply.
skip_all "fork/POSIX signals not supported on $^O" if $^O eq 'MSWin32';
my $tmp = tempdir("QDB-TEST-$$-XXXXXX", TMPDIR => 1, CLEANUP => 1);
sub pid_alive { my $p = shift; return kill(0, $p) ? 1 : 0 }
# Fork a child that installs the given %SIG dispositions, announces readiness
# down a pipe, and otherwise sleeps forever (it exists to be killed). The pipe
# is exact synchronization: the parent's sysread blocks until the handlers are
# installed, with no polling and no arbitrary deadline for a loaded host to
# blow. If the child dies before becoming ready the parent sees EOF and dies.
sub spawn_child {
my (%sigs) = @_;
pipe(my $r, my $w) or die "pipe failed: $!";
t/watcher_fast_kill.t view on Meta::CPAN
subtest custom_signal_used => sub {
# A child that exits cleanly on SIGQUIT must be stopped by SIGQUIT itself
# (not a SIGKILL), proving the requested signal is what gets sent.
my $pid = spawn_child(
QUIT => sub { open(my $f, '>', "$tmp/got-quit"); close($f); POSIX::_exit(0) },
);
DBIx::QuickDB::Watcher->_watcher_kill_fast($pid, 'QUIT');
ok(-e "$tmp/got-quit", "child handled SIGQUIT (requested signal was sent, not SIGKILL)");
ok(!pid_alive($pid), "child was reaped");
};
subtest escalates_to_sigkill => sub {
# A child that ignores SIGQUIT must still be reaped: _watcher_kill_fast
# escalates to SIGKILL after its grace window.
my $pid = spawn_child(QUIT => 'IGNORE');
my $start = time;
ok(lives { DBIx::QuickDB::Watcher->_watcher_kill_fast($pid, 'QUIT') },
"_watcher_kill_fast reaped a process that ignores the requested signal")
or diag($@);
my $elapsed = time - $start;
ok(!pid_alive($pid), "child gone after escalation to SIGKILL");
# _watcher_kill_fast escalates after 2s, so anything near that bound is a
# real regression while anything under it is scheduler noise. Kept far above
# the 2s window: a loaded CPAN smoker reported 8s for a run that escalated
# and reaped correctly, purely because its poll loop was not scheduled.
ok($elapsed < 60, "escalation happened rather than waiting forever (${elapsed}s)");
};
subtest default_is_sigkill => sub {
# No signal argument: defaults to SIGKILL, which cannot be caught.
my $pid = spawn_child(QUIT => 'IGNORE');
DBIx::QuickDB::Watcher->_watcher_kill_fast($pid);
ok(!pid_alive($pid), "default SIGKILL reaped the child");
};
subtest driver_fast_stop_sig => sub {
is(DBIx::QuickDB::Driver->fast_stop_sig, 'KILL',
"base driver fast_stop_sig defaults to SIGKILL");
is(DBIx::QuickDB::Driver::PostgreSQL->fast_stop_sig, 'QUIT',
"PostgreSQL fast_stop_sig is SIGQUIT (immediate shutdown releases SysV semaphores)");
};
# The GRACEFUL teardown path (_watcher_kill, used by stop()/eliminate()) must
t/watcher_fast_kill.t view on Meta::CPAN
TERM => 'IGNORE',
QUIT => sub { open(my $f, '>', "$tmp/grace-quit"); close($f); POSIX::_exit(0) },
);
my $start = time;
ok(lives { DBIx::QuickDB::Watcher->_watcher_kill('TERM', $pid, 'QUIT') },
"_watcher_kill reaped a server that ignores the polite stop signal") or diag($@);
my $elapsed = time - $start;
ok(-e "$tmp/grace-quit", "graceful escalation sent the fast_stop_sig (SIGQUIT), not a bare SIGKILL");
ok(!pid_alive($pid), "child reaped");
ok($elapsed < 30, "escalation happened rather than waiting forever (${elapsed}s)");
like(join('', @warnings),
qr/Server taking too long to shut down, sending SIGQUIT/,
'captured the expected fast-signal escalation warning');
unlike(join('', @warnings), qr/Server still running, sending SIGKILL/,
'server exited on the fast signal without final escalation');
};
# If even the fast_stop_sig is ignored, _watcher_kill must still escalate to
# SIGKILL so teardown always completes.
subtest graceful_kill_escalates_to_sigkill => sub {
local $ENV{QDB_STOP_GRACE} = 1;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings => @_ };
my $pid = spawn_child(TERM => 'IGNORE', QUIT => 'IGNORE');
ok(lives { DBIx::QuickDB::Watcher->_watcher_kill('TERM', $pid, 'QUIT') },
"_watcher_kill reaped a server that ignores both stop and fast_stop signals") or diag($@);
ok(!pid_alive($pid), "child gone after escalation to SIGKILL");
like(join('', @warnings),
qr/Server taking too long to shut down, sending SIGQUIT/,
'captured the expected fast-signal escalation warning');
like(join('', @warnings),
qr/Server still running, sending SIGKILL/,
'captured the expected final SIGKILL escalation warning');
};
done_testing;
t/watcher_owner_death.t view on Meta::CPAN
use POSIX ();
use Time::HiRes qw/sleep time/;
# Owner-death recovery depends on the Unix watcher and POSIX signals.
skip_all "watcher owner-death handling is not supported on $^O"
if $^O eq 'MSWin32';
my $db = get_db_or_skipall({driver => 'PostgreSQL'});
$db->stop if $db->started; # clone() requires a stopped source
sub pid_alive {
my ($pid) = @_;
return $pid && kill(0, $pid) ? 1 : 0;
}
# Start a live disposable/reusable clone in a child owner, stop its server so
# graceful-vs-fast teardown is observable, then make the owner disappear via
# _exit(). The independent watcher inherits $err_w, allowing the supervising
# test process to collect its diagnostics through EOF.
sub owner_death_case {
my (%params) = @_;
t/watcher_owner_death.t view on Meta::CPAN
$stderr_closed = 1;
last;
}
}
last if $stderr_closed;
}
close($err_r);
my $elapsed = time - $started;
my $settle = time;
while ((pid_alive($server_pid) || pid_alive($watcher_pid))
&& time - $settle < 5) {
sleep 0.02;
}
# Failure-path containment: do not let a stopped database escape this
# test. These are exact pids announced by the just-exited owner.
if (!$stderr_closed && pid_alive($server_pid)) {
kill('CONT', $server_pid);
kill('KILL', $server_pid);
}
if (!$stderr_closed && pid_alive($watcher_pid)) {
my $reap_start = time;
while (pid_alive($watcher_pid) && time - $reap_start < 5) {
sleep 0.02;
}
kill('KILL', $watcher_pid) if pid_alive($watcher_pid);
}
return {
dir => $dir,
elapsed => $elapsed,
owner_status => $owner_status,
server_pid => $server_pid,
stderr => $stderr,
stderr_closed => $stderr_closed,
watcher_pid => $watcher_pid,
t/watcher_owner_death.t view on Meta::CPAN
fail('owner created the disposable clone');
diag($case->{error});
return;
}
is($case->{owner_status}, 0, 'owner exited via _exit without an error');
ok($case->{stderr_closed}, 'watcher exited and closed stderr');
ok($case->{elapsed} < 6,
"owner-death teardown skipped the 8s graceful wait ($case->{elapsed}s)");
is($case->{stderr}, '', 'fast owner-death teardown emitted no diagnostics');
ok(!pid_alive($case->{server_pid}), 'server is gone');
ok(!pid_alive($case->{watcher_pid}), 'watcher is gone');
ok(!-d $case->{dir}, 'disposable data directory was removed');
remove_tree($case->{dir}, {safe => 1})
if !pid_alive($case->{server_pid})
&& !pid_alive($case->{watcher_pid})
&& -d $case->{dir};
};
subtest reusable_owner_death_stays_graceful => sub {
local $ENV{QDB_STOP_GRACE} = 3;
my $case = owner_death_case(cleanup => 0, timeout => 12);
if ($case->{error}) {
fail('owner created the reusable clone');
diag($case->{error});
t/watcher_owner_death.t view on Meta::CPAN
}
is($case->{owner_status}, 0, 'owner exited via _exit without an error');
ok($case->{stderr_closed}, 'watcher exited and closed stderr');
ok($case->{elapsed} >= 2.5,
"reusable database retained graceful owner-death policy ($case->{elapsed}s)");
like($case->{stderr}, qr/Server taking too long to shut down, sending SIGQUIT/,
'captured the expected graceful-path fast-signal escalation');
like($case->{stderr}, qr/Server still running, sending SIGKILL/,
'captured the expected final escalation for the stopped server');
ok(!pid_alive($case->{server_pid}), 'server is gone');
ok(!pid_alive($case->{watcher_pid}), 'watcher is gone');
ok(-d $case->{dir}, 'reusable data directory was preserved');
remove_tree($case->{dir}, {safe => 1})
if !pid_alive($case->{server_pid})
&& !pid_alive($case->{watcher_pid})
&& -d $case->{dir};
};
done_testing;