view release on metacpan or  search on metacpan

lib/DBIx/QuickDB/Driver.pm  view on Meta::CPAN

    my $self = shift;

    # Ignore errors here.
    my $err = [];
    remove_tree($self->{+DIR}, {safe => 1, error => \$err}) if -d $self->{+DIR};
    return;
}

sub connect {
    my $self = shift;
    my ($db_name, %params) = @_;

    %params = (AutoCommit => 1, RaiseError => 1) unless @_ > 1;

    my $dbh;
    $self->do_in_env(
        sub {
            my $cstring = $self->connect_string($db_name);
            require DBI;
            $dbh = DBI->connect($cstring, $self->username, $self->password, \%params);
        }
    );

    return $dbh;
}

sub started {
    my $self = shift;

    my $socket = $self->socket;
    return 1 if $self->{+WATCHER} || -S $socket;
    return 0;
}

sub start {
    my $self = shift;
    my @args = @_;

    my $dir = $self->{+DIR};
    my $socket = $self->socket;

    return if $self->{+WATCHER} || -S $socket;

    my $watcher = $self->{+WATCHER} = DBIx::QuickDB::Watcher->new(db => $self, args => \@args);

    # Defaults to 10s; tunable via QDB_START_TIMEOUT for slow hosts that need
    # longer to bring a server up (e.g. a clone doing crash recovery).
    my $timeout = env_timeout(QDB_START_TIMEOUT => 10);

    my $start = time;
    until (-S $socket) {
        my $waited = time - $start;

        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.
            my $spid       = $watcher->server_pid;
            my $alive      = ($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;
}

sub stop {
    my $self = shift;
    my %params = @_;

    my $watcher = delete $self->{+WATCHER} or return;

    # Flush a durable checkpoint while the server is still running. If shutdown
    # is slow enough to be SIGKILLed, this ensures the on-disk state is already
    # consistent so a later clone does not crash-recover and jump SERIAL
    # sequences forward (PostgreSQL SEQ_LOG_VALS=32), corrupting the clone.
    # No-op for drivers that do not need it.
    $self->checkpoint;

    DBI->visit_handles(
        sub {
            my ($driver_handle) = @_;

            $driver_handle->disconnect
               if $driver_handle->{Type} && $driver_handle->{Type} eq 'db'
               && $driver_handle->{Name} && index($driver_handle->{Name}, $self->{+DIR}) >= 0;

            return 1;
        }
    );

    $watcher->stop();

    unless ($params{no_wait}) {
        # wait() blocks until the watcher process exits, and the watcher reaps
        # the server before it exits -- so once wait() returns the server is
        # gone. Trust that instead of polling a stored server pid: after the
        # watcher exits that pid may have been recycled by the OS to an
        # unrelated process, and polling it could hang/confess on the wrong
        # process (the same pid-reuse hazard the watcher teardown guards against).
        $watcher->wait();

        # Remove a stale unix socket left behind by a hard kill so it does not
        # confuse callers or a later run that reuses the same directory.
        my $socket = $self->socket;
        unlink($socket) if $socket && -S $socket;
    }

    return;
}

# Immediate disposable teardown for clones that are about to be deleted. Unlike
# stop()/DESTROY this does NOT checkpoint or attempt a graceful shutdown: it asks
# the watcher to SIGKILL+reap the server and remove the data dir. Only safe when
# the data dir is disposable (cleanup => 1). Idempotent: after the first call