view release on metacpan or  search on metacpan

lib/App/Sqitch/Role/DBIEngine.pm  view on Meta::CPAN

package App::Sqitch::Role::DBIEngine;

use 5.010;
use strict;
use warnings;
use utf8;
use DBI 1.631;
use Moo::Role;
use Try::Tiny;
use App::Sqitch::X qw(hurl);
use Locale::TextDomain qw(App-Sqitch);
use namespace::autoclean;

our $VERSION = 'v1.6.1'; # VERSION

requires 'dbh';
requires 'sqitch';
requires 'plan';
requires '_regex_op';
requires '_ts2char_format';
requires '_char2ts';
requires '_listagg_format';
requires '_no_table_error';
requires '_unique_error';
requires '_handle_lookup_index';
requires '_no_registry';
requires 'initialized';

# Called on connect if the registry schema does not exist.
sub _handle_no_registry {
    my ($self, $dbh) = @_;
    # https://www.nntp.perl.org/group/perl.dbi.dev/2013/11/msg7622.html
    $dbh->set_err(undef, undef);
    $self->_no_registry(1);
    return;
}

after use_driver => sub {
    DBI->trace(1) if $_[0]->sqitch->verbosity > 2;
};

sub _dsn { shift->target->uri->dbi_dsn }

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

sub _log_tags_param {
    join ' ' => map { $_->format_name } $_[1]->tags;
}

sub _log_requires_param {
    join ',' => map { $_->as_string } $_[1]->requires;
}

sub _log_conflicts_param {
    join ',' => map { $_->as_string } $_[1]->conflicts;
}

sub _parse_array { return $_[1] ? [ split / / => $_[1] ] : [] }

sub _ts_default { 'DEFAULT' }

sub _can_limit { 1 }
sub _limit_default { undef }

sub _simple_from { '' }

sub _quote_idents { shift; @_ }

sub _in_expr {
    my ($self, $vals) = @_;
    my $in = sprintf 'IN (%s)', join ', ', ('?') x @{ $vals };
    return $in, @{ $vals };
}

sub _register_release {
    my $self    = shift;
    my $version = shift || $self->registry_release;
    my $sqitch  = $self->sqitch;
    my $ts      = $self->_ts_default;

    $self->begin_work;
    $self->dbh->do(qq{
        INSERT INTO releases (version, installed_at, installer_name, installer_email)
        VALUES (?, $ts, ?, ?)
    }, undef, $version, $sqitch->user_name, $sqitch->user_email);
    $self->finish_work;
    return $self;
}

sub _version_query { 'SELECT MAX(version) FROM releases' }

sub registry_version {
    my $self = shift;
    try {
        $self->dbh->selectcol_arrayref($self->_version_query)->[0];
    } catch {
        return 0 if $self->_no_table_error;
        die $_;
    };
}

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