view release on metacpan or  search on metacpan

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

    # Just use the file if no special character.
    if ($file !~ /[@?%\$]/) {
        $file =~ s/"/""/g;
        return $file;
    }

    # Alias or copy the file to a temporary directory that's removed on exit.
    (my $alias = $file->basename) =~ s/[@?%\$]/_/g;
    $alias = $self->tmpdir->file($alias);

    # Remove existing file.
    if (-e $alias) {
        $alias->remove or hurl exasol => __x(
            'Cannot remove {file}: {error}',
            file  => $alias,
            error => $!
        );
    }

    if (App::Sqitch::ISWIN) {
        # Copy it.
        $file->copy_to($alias) or hurl exasol => __x(
            'Cannot copy {file} to {alias}: {error}',
            file  => $file,
            alias => $alias,
            error => $!
        );
    } else {
        # Symlink it.
        $alias->remove;
        symlink $file->absolute, $alias or hurl exasol => __x(
            'Cannot symlink {file} to {alias}: {error}',
            file  => $file,
            alias => $alias,
            error => $!
        );
    }

    # Return the alias.
    $alias =~ s/"/""/g;
    return $alias;
}

sub run_file {
    my $self = shift;
    my $file = $self->_file_for_script(shift);
    $self->_capture(qq{\@"$file"});
}

sub _run_with_verbosity {
    my $self = shift;
    my $file = $self->_file_for_script(shift);
    # Suppress STDOUT unless we want extra verbosity.
    #my $meth = $self->can($self->sqitch->verbosity > 1 ? '_run' : '_capture');
    my $meth = '_capture';
    $self->$meth(qq{\@"$file"});
}

sub run_upgrade { shift->_run_with_verbosity(@_) }
sub run_verify  { shift->_run_with_verbosity(@_) }

sub run_handle {
    my ($self, $fh) = @_;
    my $conn = $self->_script;
    open my $tfh, '<:utf8_strict', \$conn;
    $self->sqitch->spool( [$tfh, $fh], $self->exaplus );
}

# Exasol treats empty string as NULL; adjust accordingly..

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

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

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

sub _no_table_error  {
    return $DBI::errstr && $DBI::errstr =~ /object \w+ not found/m;
}

sub _no_column_error  {
    return $DBI::errstr && $DBI::errstr =~ /object \w+ not found/m;
}

sub _unique_error  {
    # Unique constraints not supported by Exasol
    return 0;
}

sub _script {
    my $self = shift;
    my $uri  = $self->uri;
    my %vars = $self->variables;

    return join "\n" => (
        'SET FEEDBACK OFF;',
        'SET HEADING OFF;',
        'WHENEVER OSERROR EXIT 9;',
        'WHENEVER SQLERROR EXIT 4;',
        (map {; (my $v = $vars{$_}) =~ s/'/''/g; qq{DEFINE $_='$v';} } sort keys %vars),
        $self->_registry_variable,
        # Just 'map { s/;?$/;/r } ...' doesn't work in earlier Perl versions;
        # see: https://www.perlmonks.org/index.pl?node_id=1048579
        map { (my $foo=$_) =~ s/;?$/;/; $foo } @_
    );
}

sub _run {
    my $self = shift;
    my $script = $self->_script(@_);
    open my $fh, '<:utf8_strict', \$script;