view release on metacpan or  search on metacpan

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

    catch {
        hurl firebird => __x(
            'Cannot create database {database}: {error}',
            database => $sqitch_db,
            error    => $_,
        );
    };

    # Load up our database. The database must exist!
    $self->run_upgrade( file(__FILE__)->dir->file('firebird.sql') );
    $self->_register_release;
}

sub connection_string {
    my ($self, $uri) = @_;
    my $file = $uri->dbname or hurl firebird => __x(
        'Database name missing in URI {uri}',
        uri => $uri,
    );
    # Use _port instead of port so it's empty if no port is in the URI.
    # https://github.com/sqitchers/sqitch/issues/675
    my $host = $uri->host   or return $file;
    my $port = $uri->_port  or return "$host:$file";
    return "$host/$port:$file";
}

# Override to lock the Sqitch tables. 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 all tables to disallow concurrent changes.
    # This should be equivalent to 'LOCK TABLE changes' ???
    # http://conferences.embarcadero.com/article/32280#TableReservation
    $dbh->func(
        -lock_resolution => 'no_wait',
        -reserving => {
            changes => {
                lock   => 'read',
                access => 'protected',
            },
        },
        'ib_set_tx_param'
    );
    $dbh->begin_work;
    return $self;
}

# Override to unlock the tables, otherwise future transactions on this
# connection can fail.
sub finish_work {
    my $self = shift;
    my $dbh = $self->dbh;
    $dbh->commit;
    $dbh->func( 'ib_set_tx_param' );         # reset parameters
    return $self;
}

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _no_table_error  {
    return $DBI::errstr && $DBI::errstr =~ /^-Table unknown|No such file or directory/m;
}

sub _no_column_error  {
    return $DBI::errstr && $DBI::errstr =~ /^-Column unknown/m;
}

sub _unique_error  {
    return $DBI::errstr && $DBI::errstr =~ /no 2 table rows can have duplicate column values$/m;
}

sub _regex_op { 'SIMILAR TO' }               # NOT good match for
                                             # REGEXP :(

sub _limit_default { '18446744073709551615' }

sub _listagg_format {
    return q{LIST(ALL %s, ' ')}; # Firebird v2.1.4 minimum
}

sub _run {
    my $self   = shift;
    my $sqitch = $self->sqitch;
    my $pass   = $self->password or return $sqitch->run( $self->isql, @_ );
    local $ENV{ISC_PASSWORD} = $pass;
    return $sqitch->run( $self->isql, @_ );
}

sub _capture {
    my $self   = shift;
    my $sqitch = $self->sqitch;
    my $pass   = $self->password or return $sqitch->capture( $self->isql, @_ );
    local $ENV{ISC_PASSWORD} = $pass;
    return $sqitch->capture( $self->isql, @_ );
}

sub _spool {
    my $self   = shift;
    my $fh     = shift;
    my $sqitch = $self->sqitch;
    my $pass   = $self->password or return $sqitch->spool( $fh, $self->isql, @_ );
    local $ENV{ISC_PASSWORD} = $pass;
    return $sqitch->spool( $fh, $self->isql, @_ );
}

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

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