view release on metacpan or  search on metacpan

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

    $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 );
}

sub run_upgrade {
    my ($self, $file) = @_;
    my $uri    = $self->registry_uri;
    my @cmd    = $self->isql;
    $cmd[-1]   = $self->connection_string($uri);
    my $sqitch = $self->sqitch;
    unless ($uri->host) {
        # Only one connection allowed when using an embedded database (Engine 12
        # provider). So disconnect so that the upgrade can connect and succeed,
        # and clear the disconnected handle so that the next call to ->dbh will
        # reconnect.
        $self->dbh->disconnect; $self->_clear_dbh;
    }
    $sqitch->run( @cmd, '-input' => $sqitch->quote_shell($file) );
}

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

sub _cid {
    my ( $self, $ord, $offset, $project ) = @_;

    my $offexpr = $offset ? " SKIP $offset" : '';
    return try {
        return $self->dbh->selectcol_arrayref(qq{
            SELECT FIRST 1$offexpr change_id
              FROM changes
             WHERE project = ?
             ORDER BY committed_at $ord;
        }, undef, $project || $self->plan->project)->[0];
    } catch {
        # Firebird generic error code -902, one possible message:
        # -I/O error during "open" operation for file...
        # -Error while trying to open file
        # -No such file or directory
        # print "===DBI ERROR: $DBI::err\n";
        return if $DBI::err == -902;       # can't connect to database
        die $_;
    };
}

sub current_state {
    my ( $self, $project ) = @_;
    my $cdtcol = sprintf $self->_ts2char_format, 'c.committed_at';
    my $pdtcol = sprintf $self->_ts2char_format, 'c.planned_at';
    my $tagcol = sprintf $self->_listagg_format, 't.tag';
    my $state  = try {
        $self->dbh->selectrow_hashref(qq{
            SELECT FIRST 1 c.change_id
                 , c.script_hash
                 , c.change
                 , c.project