view release on metacpan or  search on metacpan

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

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

has registry_uri => (
    is       => 'ro',
    isa      => URIDB,
    lazy     => 1,
    default  => sub {
        my $self = shift;
        my $uri  = $self->uri->clone;
        my $reg  = $self->registry;

        if ( file($reg)->is_absolute ) {
            # Just use an absolute path.
            $uri->dbname($reg);
        } elsif (my @segs = $uri->path_segments) {
            # Use the same name, but replace $name.$ext with $reg.$ext.
            my $bn = file( $segs[-1] )->basename;
            if ($reg =~ /[.]/ || $bn !~ /[.]/) {
                $segs[-1] =~ s/\Q$bn\E$/$reg/;
            } else {
                my ($b, $e) = split /[.]/, $bn, 2;
                $segs[-1] =~ s/\Q$b\E[.]$e$/$reg.$e/;
            }
            $uri->path_segments(@segs);
        } else {
            # No known path, so no name.
            $uri->dbname(undef);
        }

        return $uri;
    },
);

sub registry_destination {
    my $uri = shift->registry_uri;
    if ($uri->password) {
        $uri = $uri->clone;
        $uri->password(undef);
    }
    return $uri->as_string;
}

sub key    { 'sqlite' }
sub name   { 'SQLite' }
sub driver { 'DBD::SQLite 1.37' }
sub default_client { 'sqlite3' }
sub _dsn { shift->registry_uri->dbi_dsn }

has dbh => (
    is      => 'rw',
    isa     => DBH,
    lazy    => 1,
    default => sub {
        my $self = shift;
        $self->use_driver;

        my $dbh = DBI->connect($self->_dsn, '', '', {
            PrintError        => 0,
            RaiseError        => 0,
            AutoCommit        => 1,
            sqlite_unicode    => 1,
            sqlite_use_immediate_transaction => 1,
            HandleError       => $self->error_handler,
            Callbacks         => {
                connected => sub {
                    my $dbh = shift;
                    $dbh->do('PRAGMA foreign_keys = ON');
                    return;
                },
            },
        });

        # Make sure we support this version.
        my @v = split /[.]/ => $dbh->{sqlite_version};
        hurl sqlite => __x(
            'Sqitch requires SQLite 3.8.6 or later; DBD::SQLite was built with {version}',
            version => $dbh->{sqlite_version}
        ) unless $v[0] > 3 || ($v[0] == 3 && ($v[1] > 8 || ($v[1] == 8 && $v[2] >= 6)));

        return $dbh;
    }
);

# Need to wait until dbh is defined.
with 'App::Sqitch::Role::DBIEngine';

has _sqlite3 => (
    is         => 'ro',
    isa        => ArrayRef,
    lazy       => 1,
    default    => sub {
        my $self = shift;

        # Make sure we can use this version of SQLite.
        my @v = split /[.]/ => (
            split / / => scalar $self->sqitch->capture( $self->client, '-version' )
        )[0];
        hurl sqlite => __x(
            'Sqitch requires SQLite 3.3.9 or later; {client} is {version}',
            client  => $self->client,
            version => join( '.', @v)
        ) unless $v[0] > 3 || ($v[0] == 3 && ($v[1] > 3 || ($v[1] == 3 && $v[2] >= 9)));

        my $dbname = $self->uri->dbname or hurl sqlite => __x(
            'Database name missing in URI {uri}',
            uri => $self->uri,
        );

        return [
            $self->client,
            '-noheader',
            '-bail',
            '-batch',
            '-csv', # or -column or -line?
            $dbname,
        ];
    },
);

sub sqlite3 { @{ shift->_sqlite3 } }