view release on metacpan or  search on metacpan

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

    my $self = shift;

    # Just use the target name if it doesn't look like a URI or if the URI
    # includes the database name.
    return $self->target->name if $self->target->name !~ /:/
        || $self->target->uri->dbname;

    # Use the URI sans password.
    my $uri = $self->target->uri->clone;
    $uri->password(undef) if $uri->password;
    return $uri->as_string;
}

# No username or password defaults.
sub _def_user { }
sub _def_pass { }

has _exaplus => (
    is         => 'ro',
    isa        => ArrayRef,
    lazy       => 1,
    default    => sub {
        my $self = shift;
        my $uri  = $self->uri;
        my @ret  = ( $self->client );

        # Collect the cquery params and convert keys to uppercase.
        require URI::QueryParam;
        my $qry  = $uri->query_form_hash;
        for my $key (keys %{ $qry }) {
            my $ukey = uc $key;
            next if $key eq $ukey;

            # Move value to uppercase key.
            my $val = delete $qry->{$key};
            if (!exists $qry->{$ukey}) {
                # Store under uppercase key.
                $qry->{$ukey} = $val;
            } else {
                # Push the value(s) onto upercase key array value.
                $qry->{$ukey} = [$qry->{$ukey}] if ref $qry->{$ukey} ne 'ARRAY';
                push @{ $qry->{$ukey} } => ref $val eq 'ARRAY' ? @{ $val } : $val;
            }
        }

        # Use _port instead of port so it's empty if no port is in the URI.
        # https://github.com/sqitchers/sqitch/issues/675
        for my $spec (
            [ u => $self->username ],
            [ p => $self->password ],
            [ c => $uri->host && $uri->_port ? $uri->host . ':' . $uri->_port : undef ],
            [ profile => $uri->host ? undef : $uri->dbname ],
            [ jdbcparam => ($qry->{SSLCERTIFICATE} || '') eq 'SSL_VERIFY_NONE' ? 'validateservercertificate=0' : undef ],
            [ jdbcparam => $qry->{AUTHMETHOD}  ? "authmethod=$qry->{AUTHMETHOD}" : undef ],
        ) {
            push @ret, "-$spec->[0]" => $spec->[1] if $spec->[1];
        }

        push @ret => (
            '-q',                       # Quiet mode
            '-L',                       # Don't prompt if login fails, just exit
            '-pipe',                    # Enable piping of scripts to 'exaplus'
            '-x',                       # Stop in case of errors
            '-autoCompletion' => 'OFF',
            '-encoding' => 'UTF8',
            '-autocommit' => 'OFF',
        );
        return \@ret;
    },
);

sub exaplus { @{ shift->_exaplus } }

has tmpdir => (
    is       => 'ro',
    isa      => Dir,
    lazy     => 1,
    default  => sub {
        require File::Temp;
        dir File::Temp::tempdir( CLEANUP => 1 );
    },
);

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

        DBI->connect($self->_dsn, $self->username, $self->password, {
            PrintError        => 0,
            RaiseError        => 0,
            AutoCommit        => 1,
            odbc_utf8_on      => 1,
            FetchHashKeyName  => 'NAME_lc',
            HandleError       => $self->error_handler,
            Callbacks         => {
                connected => sub {
                    my $dbh = shift;
                    $dbh->do("ALTER SESSION SET $_='YYYY-MM-DD HH24:MI:SS'") for qw(
                        nls_date_format
                        nls_timestamp_format
                    );
                    $dbh->do("ALTER SESSION SET TIME_ZONE='UTC'");
                    if (my $schema = $self->registry) {
                        $dbh->do("OPEN SCHEMA $schema")
                            or $self->_handle_no_registry($dbh);
                    }
                    return;
                },
            },
        });
    }
);

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

# Timestamp formats