view release on metacpan or  search on metacpan

lib/App/Sqitch/Engine/pg.pm  view on Meta::CPAN

# Returns the name of the provider.
sub _provider {
    shift->dbh->{private_sqitch_info}{provider}
}

# Override to lock the changes table. This ensures that only one instance of
# Sqitch runs at one time.
sub begin_work {
    my $self = shift;
    my $dbh = $self->dbh;

    # Start transaction and lock changes to allow only one change at a time.
    $dbh->begin_work;
    $dbh->do('LOCK TABLE changes IN EXCLUSIVE MODE')
        if $self->_provider eq 'postgres';
        # Yugabyte does not yet support EXCLUSIVE MODE.
        # https://docs.yugabyte.com/preview/api/ysql/the-sql-language/statements/txn_lock/#lockmode-1
    return $self;
}

# Override to try to acquire a lock on a constant number without waiting.
sub try_lock {
    my $self = shift;
    return 1 if $self->_provider ne 'postgres';
    $self->dbh->selectcol_arrayref(
        'SELECT pg_try_advisory_lock(75474063)'
    )->[0]
}

# Override to try to acquire a lock on a constant number, waiting for the lock
# until timeout.
sub wait_lock {
    my $self = shift;

    # Yugabyte does not support advisory locks.
    # https://github.com/yugabyte/yugabyte-db/issues/3642
    # Use pessimistic locking when it becomes available.
    # https://github.com/yugabyte/yugabyte-db/issues/5680
    return 1 if $self->_provider ne 'postgres';

    # Asynchronously request a lock with an indefinite wait.
    my $dbh = $self->dbh;
    $dbh->do(
        'SELECT pg_advisory_lock(75474063)',
        { pg_async => DBD::Pg::PG_ASYNC() },
    );

    # Use _timeout to periodically check for the result.
    return 1 if $self->_timeout(sub { $dbh->pg_ready && $dbh->pg_result });

    # Timed out, cancel the query and return false.
    $dbh->pg_cancel;
    return 0;
}

sub run_file {
    my ($self, $file) = @_;
    $self->_run('--file' => $file);
}

sub run_verify {
    my $self = shift;
    # Suppress STDOUT unless we want extra verbosity.
    my $meth = $self->can($self->sqitch->verbosity > 1 ? '_run' : '_capture');
    return $self->$meth('--file' => @_);
}

sub run_handle {
    my ($self, $fh) = @_;
    $self->_spool($fh);
}

sub run_upgrade {
    shift->_run_registry_file(@_);
}

# Override to avoid cast errors, and to use VALUES instead of a UNION query.
sub log_new_tags {
    my ( $self, $change ) = @_;
    my @tags   = $change->tags or return $self;
    my $sqitch = $self->sqitch;

    my ($id, $name, $proj, $user, $email) = (
        $change->id,
        $change->format_name,
        $change->project,
        $sqitch->user_name,
        $sqitch->user_email
    );

    $self->dbh->do(
        q{
            INSERT INTO tags (
                   tag_id
                 , tag
                 , project
                 , change_id
                 , note
                 , committer_name
                 , committer_email
                 , planned_at
                 , planner_name
                 , planner_email
            )
            SELECT tid, tg, proj, chid, n, name, email, at, pname, pemail FROM ( VALUES
        } . join( ",\n                ", ( q{(?::text, ?::text, ?::text, ?::text, ?::text, ?::text, ?::text, ?::timestamptz, ?::text, ?::text)} ) x @tags )
        . q{
            ) i(tid, tg, proj, chid, n, name, email, at, pname, pemail)
              LEFT JOIN tags ON i.tid = tags.tag_id
             WHERE tags.tag_id IS NULL
         },
        undef,
        map { (
            $_->id,
            $_->format_name,
            $proj,
            $id,
            $_->note,
            $user,
            $email,
            $_->timestamp->as_string(format => 'iso'),