view release on metacpan or  search on metacpan

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

package App::Sqitch::Engine::firebird;

use 5.010;
use strict;
use warnings;
use utf8;
use Try::Tiny;
use App::Sqitch::X qw(hurl);
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::Plan::Change;
use Path::Class;
use File::Basename;
use Time::Local;
use Time::HiRes qw(sleep);
use Moo;
use App::Sqitch::Types qw(DBH URIDB ArrayRef Maybe Int);
use namespace::autoclean;

extends 'App::Sqitch::Engine';

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 $reg = $self->registry;
            if ($reg =~ /[.]/) {
                $segs[-1] =~ s/^[^.]+(?:[.].+)?$/$reg/;
            } else {
                $segs[-1] =~ s{^[^.]+([.].+)?$}{$reg . ($1 // '')}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 _def_user { $ENV{ISC_USER} }
sub _def_pass { $ENV{ISC_PASSWORD} }
sub _dsn {
    my $uri = shift->registry_uri;
    return $uri->dbi_dsn . ';ib_dialect=3;ib_charset=UTF8';
}