#!/usr/bin/perl -w
use
5.010;
my
$CLASS
;
delete
$ENV
{
"VSQL_$_"
}
for
qw(USER PASSWORD DATABASE HOST PORT)
;
BEGIN {
$CLASS
=
'App::Sqitch::Engine::exasol'
;
require_ok
$CLASS
or
die
;
}
is_deeply [
$CLASS
->config_vars], [
target
=>
'any'
,
registry
=>
'any'
,
client
=>
'any'
,
],
'config_vars should return three vars'
;
my
$uri
= URI::db->new(
'db:exasol:'
);
my
$config
= TestConfig->new(
'core.engine'
=>
'exasol'
);
my
$sqitch
= App::Sqitch->new(
config
=>
$config
);
my
$target
= App::Sqitch::Target->new(
sqitch
=>
$sqitch
,
uri
=>
$uri
,
);
isa_ok
my
$exa
=
$CLASS
->new(
sqitch
=>
$sqitch
,
target
=>
$target
,
),
$CLASS
;
is
$exa
->key,
'exasol'
,
'Key should be "exasol"'
;
is
$exa
->name,
'Exasol'
,
'Name should be "Exasol"'
;
my
$client
=
'exaplus'
. (App::Sqitch::ISWIN ?
'.exe'
:
''
);
is
$exa
->client,
$client
,
'client should default to exaplus'
;
is
$exa
->registry,
'sqitch'
,
'registry default should be "sqitch"'
;
is
$exa
->uri,
$uri
,
'DB URI should be "db:exasol:"'
;
my
$dest_uri
=
$uri
->clone;
is
$exa
->destination,
$dest_uri
->as_string,
'Destination should default to "db:exasol:"'
;
is
$exa
->registry_destination,
$exa
->destination,
'Registry destination should be the same as destination'
;
my
@std_opts
= (
'-q'
,
'-L'
,
'-pipe'
,
'-x'
,
'-autoCompletion'
=>
'OFF'
,
'-encoding'
=>
'UTF8'
,
'-autocommit'
=>
'OFF'
,
);
is_deeply [
$exa
->exaplus], [
$client
,
@std_opts
],
'exaplus command should be std opts-only'
;
is
$exa
->_script,
join
(
"\n"
=> (
'SET FEEDBACK OFF;'
,
'SET HEADING OFF;'
,
'WHENEVER OSERROR EXIT 9;'
,
'WHENEVER SQLERROR EXIT 4;'
,
$exa
->_registry_variable,
) ),
'_script should work'
;
ok
$exa
->set_variables(
foo
=>
'baz'
,
whu
=>
'hi there'
,
yo
=>
q{'stellar'}
),
'Set some variables'
;
is
$exa
->_script,
join
(
"\n"
=> (
'SET FEEDBACK OFF;'
,
'SET HEADING OFF;'
,
'WHENEVER OSERROR EXIT 9;'
,
'WHENEVER SQLERROR EXIT 4;'
,
"DEFINE foo='baz';"
,
"DEFINE whu='hi there';"
,
"DEFINE yo='''stellar''';"
,
$exa
->_registry_variable,
) ),
'_script should assemble variables'
;
for
my
$spec
(
{
qry
=>
'SSLCERTIFICATE=SSL_VERIFY_NONE'
,
opt
=> [
qw(-jdbcparam validateservercertificate=0)
],
},
{
qry
=>
'SSLCERTIFICATE=SSL_VERIFY_NONE'
,
opt
=> [
qw(-jdbcparam validateservercertificate=0)
],
},
{
qry
=>
'SSLCERTIFICATE=xxx'
,
opt
=> [],
},
{
qry
=>
'SSLCERTIFICATE=SSL_VERIFY_NONE&SSLCERTIFICATE=xyz'
,
opt
=> [],
},
{
qry
=>
'AuthMethod=refreshtoken'
,
opt
=> [
qw(-jdbcparam authmethod=refreshtoken)
],
},
{
qry
=>
'AUTHMETHOD=xyz'
,
opt
=> [
qw(-jdbcparam authmethod=xyz)
],
},
{
qry
=>
'SSLCERTIFICATE=SSL_VERIFY_NONE&AUTHMETHOD=xyz'
,
opt
=> [
qw(-jdbcparam validateservercertificate=0 -jdbcparam authmethod=xyz)
],
},
) {
$uri
->query(
$spec
->{qry});
my
$target
= App::Sqitch::Target->new(
sqitch
=>
$sqitch
,
uri
=>
$uri
,
);
my
$exa
=
$CLASS
->new(
sqitch
=>
$sqitch
,
target
=>
$target
,
);
is_deeply [
$exa
->exaplus], [
$client
, @{
$spec
->{opt} },
@std_opts
],
"Should handle query $spec->{qry}"
;
}
$uri
->query(
''
);
ENV: {
my
$mocker
= Test::MockModule->new(
'App::Sqitch'
);
$mocker
->mock(
sysuser
=>
'sysuser=whatever'
);
my
$exa
=
$CLASS
->new(
sqitch
=>
$sqitch
,
target
=>
$target
);
is
$exa
->target->name,
'db:exasol:'
,
'Target name should NOT fall back on sysuser'
;
is
$exa
->registry_destination,
$exa
->destination,
'Registry target should be the same as destination'
;
}
$config
->update(
'engine.exasol.client'
=>
'/path/to/exaplus'
,
'engine.exasol.registry'
=>
'meta'
,
);
$target
= App::Sqitch::Target->new(
sqitch
=>
$sqitch
);
ok
$exa
=
$CLASS
->new(
sqitch
=>
$sqitch
,
target
=>
$target
),
'Create another exasol'
;
is
$exa
->client,
'/path/to/exaplus'
,
'client should be as configured'
;
'uri should be as configured'
;
is
$exa
->registry,
'meta'
,
'registry should be as configured'
;
is_deeply [
$exa
->exaplus], [
qw(
/path/to/exaplus
-u me
-p myself
-c localhost:4444
)
,
@std_opts
],
'exaplus command should be configured from URI config'
;
is
$exa
->_script,
join
(
"\n"
=> (
'SET FEEDBACK OFF;'
,
'SET HEADING OFF;'
,
'WHENEVER OSERROR EXIT 9;'
,
'WHENEVER SQLERROR EXIT 4;'
,
'DEFINE registry=meta;'
,
) ),
'_script should use registry from config settings'
;
can_ok
$exa
,
qw(_run _capture)
;
my
$mock_sqitch
= Test::MockModule->new(
'App::Sqitch'
);
my
(
@capture
,
@spool
);
$mock_sqitch
->mock(
spool
=>
sub
{
shift
;
@spool
=
@_
});
my
$mock_run3
= Test::MockModule->new(
'IPC::Run3'
);
$mock_run3
->mock(
run3
=>
sub
{
@capture
=
@_
});
ok
$exa
->_run(
qw(foo bar baz)
),
'Call _run'
;
my
$fh
=
shift
@spool
;
is_deeply \
@spool
, [
$exa
->exaplus],
'EXAplus command should be passed to spool()'
;
is
join
(
''
, <
$fh
> ),
$exa
->_script(
qw(foo bar baz)
),
'The script should be spooled'
;
ok
$exa
->_capture(
qw(foo bar baz)
),
'Call _capture'
;
is_deeply \
@capture
, [
[
$exa
->exaplus], \
$exa
->_script(
qw(foo bar baz)
), [], [],
{
return_if_system_error
=> 1 },
],
'Command and script should be passed to run3()'
;
$mock_run3
->unmock_all;
my
$echo
= Path::Class::file(
qw(t echo.pl)
);
my
$mock_exa
= Test::MockModule->new(
$CLASS
);
$mock_exa
->mock(
exaplus
=>
sub
{ $^X,
$echo
,
qw(hi there)
});
is
join
(
', '
=>
$exa
->_capture(
qw(foo bar baz)
)),
"hi there\n"
,
'_capture should actually capture'
;
my
$die
= Path::Class::file(
qw(t die.pl)
);
$mock_exa
->mock(
exaplus
=>
sub
{ $^X,
$die
,
qw(hi there)
});
like capture_stderr {
throws_ok {
$exa
->_capture(
'whatever'
),
}
'App::Sqitch::X'
,
'_capture should die when exaplus dies'
;
},
qr/^OMGWTF/
m,
'STDERR should be emitted by _capture'
;
$mock_exa
->mock(
dbh
=>
sub
{
die
'OW'
});
throws_ok {
$exa
->initialized }
qr/OW/
,
'initialized() should rethrow unexpected DB error'
;
throws_ok {
$exa
->_cid }
qr/OW/
,
'_cid should rethrow unexpected DB error'
;
$mock_exa
->unmock(
'dbh'
);
can_ok
$exa
,
'_file_for_script'
;
is
$exa
->_file_for_script(Path::Class::file
'foo'
),
'foo'
,
'File without special characters should be used directly'
;
is
$exa
->_file_for_script(Path::Class::file
'"foo"'
),
'""foo""'
,
'Double quotes should be SQL-escaped'
;
ok
my
$tmpdir
=
$exa
->tmpdir,
'Get temp dir'
;
isa_ok
$tmpdir
,
'Path::Class::Dir'
,
'Temp dir'
;
my
$file
=
$tmpdir
->file(
'foo@bar.sql'
);
$file
->touch;
is
$exa
->_file_for_script(
$file
),
$tmpdir
->file(
'foo_bar.sql'
),
'File with special char should be aliased'
;
FILE: {
my
$mock_pcf
= Test::MockModule->new(
'Path::Class::File'
);
$mock_pcf
->mock(
remove
=> 0);
throws_ok {
$exa
->_file_for_script(
$file
) }
'App::Sqitch::X'
,
'Should get an error on failure to delete the alias'
;
is $@->ident,
'exasol'
,
'File deletion error ident should be "exasol"'
;
is $@->message, __x(
'Cannot remove {file}: {error}'
,
file
=>
$tmpdir
->file(
'foo_bar.sql'
),
error
=> $!,
),
'File deletion error message should be correct'
;
}
WIN32: {
$file
=
$tmpdir
->file(
'"foo$bar".sql'
);
my
$mock_file
= Test::MockModule->new(
ref
$file
);
$mock_file
->mock(
copy_to
=> 1)
if
App::Sqitch::ISWIN;
is
$exa
->_file_for_script(
$file
),
$tmpdir
->file(
'""foo_bar"".sql'
),
'File with special char and quotes should be aliased'
;
}
my
@run
;
$mock_exa
->mock(
_capture
=>
sub
{
shift
;
@run
=
@_
});
ok
$exa
->run_file(
'foo/bar.sql'
),
'Run foo/bar.sql'
;
is_deeply \
@run
, [
'@"foo/bar.sql"'
],
'File should be passed to capture()'
;
ok
$exa
->run_file(
'foo/"bar".sql'
),
'Run foo/"bar".sql'
;
is_deeply \
@run
, [
'@"foo/""bar"".sql"'
],
'Double quotes in file passed to capture() should be escaped'
;
ok
$exa
->run_handle(
'FH'
),
'Spool a "file handle"'
;
my
$handles
=
shift
@spool
;
is_deeply \
@spool
, [
$exa
->exaplus],
'exaplus command should be passed to spool()'
;
isa_ok
$handles
,
'ARRAY'
,
'Array ove handles should be passed to spool'
;
$fh
=
$handles
->[0];
is
join
(
''
, <
$fh
>),
$exa
->_script,
'First file handle should be script'
;
is
$handles
->[1],
'FH'
,
'Second should be the passed handle'
;
$mock_exa
->mock(
_capture
=>
sub
{
shift
;
@capture
=
@_
});
ok
$exa
->run_verify(
'foo/bar.sql'
),
'Verify foo/bar.sql'
;
is_deeply \
@capture
, [
'@"foo/bar.sql"'
],
'Verify file should be passed to capture()'
;
$mock_sqitch
->mock(
verbosity
=> 2);
ok
$exa
->run_verify(
'foo/bar.sql'
),
'Verify foo/bar.sql again'
;
is_deeply \
@capture
, [
'@"foo/bar.sql"'
],
'Verify file should be passed to run() for high verbosity'
;
$mock_sqitch
->unmock_all;
$mock_exa
->unmock_all;
ok
my
$ts2char
=
$CLASS
->can(
'_ts2char_format'
),
"$CLASS->can('_ts2char_format')"
;
is
sprintf
(
$ts2char
->(),
'foo'
),
qq{'year:' || CAST(EXTRACT(YEAR FROM foo) AS SMALLINT)
|| ':month:' || CAST(EXTRACT(MONTH FROM foo) AS SMALLINT)
|| ':day:' || CAST(EXTRACT(DAY FROM foo) AS SMALLINT)
|| ':hour:' || CAST(EXTRACT(HOUR FROM foo) AS SMALLINT)
|| ':minute:' || CAST(EXTRACT(MINUTE FROM foo) AS SMALLINT)
|| ':second:' || FLOOR(CAST(EXTRACT(SECOND FROM foo) AS NUMERIC(9,4)))
|| ':time_zone:UTC'}
,
'_ts2char should work'
;
ok
my
$dtfunc
=
$CLASS
->can(
'_dt'
),
"$CLASS->can('_dt')"
;
isa_ok
my
$dt
=
$dtfunc
->(
'year:2012:month:07:day:05:hour:15:minute:07:second:01:time_zone:UTC'
),
'App::Sqitch::DateTime'
,
'Return value of _dt()'
;
is
$dt
->year, 2012,
'DateTime year should be set'
;
is
$dt
->month, 7,
'DateTime month should be set'
;
is
$dt
->day, 5,
'DateTime day should be set'
;
is
$dt
->hour, 15,
'DateTime hour should be set'
;
is
$dt
->minute, 7,
'DateTime minute should be set'
;
is
$dt
->second, 1,
'DateTime second should be set'
;
is
$dt
->time_zone->name,
'UTC'
,
'DateTime TZ should be set'
;
$dt
= App::Sqitch::DateTime->new(
year
=> 2017,
month
=> 11,
day
=> 06,
hour
=> 11,
minute
=> 47,
second
=> 35,
time_zone
=>
'Europe/Stockholm'
);
is
$exa
->_char2ts(
$dt
),
'2017-11-06 10:47:35'
,
'_char2ts should present timestamp at UTC w/o tz identifier'
;
is
$exa
->_listagg_format,
q{GROUP_CONCAT(%1$s ORDER BY %1$s SEPARATOR ' ')}
,
'Should have _listagg_format'
;
is
$exa
->_ts_default,
'current_timestamp'
,
'Should have _ts_default'
;
is
$exa
->_regex_op,
'REGEXP_LIKE'
,
'Should have _regex_op'
;
is
$exa
->_simple_from,
' FROM dual'
,
'Should have _simple_from'
;
is
$exa
->_limit_default,
'18446744073709551611'
,
'Should have _limit_default'
;
DBI: {
local
*DBI::errstr
;
ok !
$exa
->_no_table_error,
'Should have no table error'
;
ok !
$exa
->_no_column_error,
'Should have no column error'
;
$DBI::errstr
=
'object foo not found'
;
ok
$exa
->_no_table_error,
'Should now have table error'
;
ok
$exa
->_no_column_error,
'Should now have no column error'
;
ok !
$exa
->_unique_error,
'Unique constraints not supported by Exasol'
;
}
is_deeply [
$exa
->_limit_offset(8, 4)],
[[
'LIMIT 8'
,
'OFFSET 4'
], []],
'Should get limit and offset'
;
is_deeply [
$exa
->_limit_offset(0, 2)],
[[
'LIMIT 18446744073709551611'
,
'OFFSET 2'
], []],
'Should get limit and offset when offset only'
;
is_deeply [
$exa
->_limit_offset(12, 0)], [[
'LIMIT 12'
], []],
'Should get only limit with 0 offset'
;
is_deeply [
$exa
->_limit_offset(12)], [[
'LIMIT 12'
], []],
'Should get only limit with noa offset'
;
is_deeply [
$exa
->_limit_offset(0, 0)], [[], []],
'Should get no limit or offset for 0s'
;
is_deeply [
$exa
->_limit_offset()], [[], []],
'Should get no limit or offset for no args'
;
is_deeply [
$exa
->_regex_expr(
'corn'
,
'Obama$'
)],
[
'corn REGEXP_LIKE ?'
,
'.*Obama$'
],
'Should use regexp_like and prepend wildcard to regex'
;
is_deeply [
$exa
->_regex_expr(
'corn'
,
'^Obama'
)],
[
'corn REGEXP_LIKE ?'
,
'^Obama.*'
],
'Should use regexp_like and append wildcard to regex'
;
is_deeply [
$exa
->_regex_expr(
'corn'
,
'^Obama$'
)],
[
'corn REGEXP_LIKE ?'
,
'^Obama$'
],
'Should not chande regex with both anchors'
;
is_deeply [
$exa
->_regex_expr(
'corn'
,
'Obama'
)],
[
'corn REGEXP_LIKE ?'
,
'.*Obama.*'
],
'Should append wildcards to both ends without anchors'
;
my
$dbh
;
my
$id
= DBIEngineTest->randstr;
my
(
$reg1
,
$reg2
) =
map
{
$_
.
$id
}
qw(sqitch sqitchtest)
;
END {
return
unless
$dbh
;
$dbh
->{Driver}->visit_child_handles(
sub
{
my
$h
=
shift
;
$h
->disconnect
if
$h
->{Type} eq
'db'
&&
$h
->{Active} &&
$h
ne
$dbh
;
});
$dbh
->{RaiseError} = 0;
$dbh
->{PrintError} = 1;
$dbh
->
do
(
"DROP SCHEMA $_ CASCADE"
)
for
(
$reg1
,
$reg2
);
}
$uri
= URI->new(
$ENV
{SQITCH_TEST_EXASOL_URI} ||
$ENV
{EXA_URI} ||
'db:dbadmin:password@localhost/dbadmin'
);
my
$err
;
for
my
$i
(1..30) {
$err
=
try
{
$exa
->use_driver;
$dbh
= DBI->
connect
(
$uri
->dbi_dsn,
$uri
->user,
$uri
->password, {
PrintError
=> 0,
RaiseError
=> 0,
AutoCommit
=> 1,
HandleError
=>
$exa
->error_handler,
});
undef
;
}
catch
{
$_
;
};
last
unless
$err
&& (
$DBI::state
||
''
) eq
'HY000'
;
sleep
1
if
$i
< 30;
}
DBIEngineTest->run(
class
=>
$CLASS
,
target_params
=> [
uri
=>
$uri
,
registry
=>
$reg1
],
alt_target_params
=> [
uri
=>
$uri
,
registry
=>
$reg2
],
skip_unless
=>
sub
{
my
$self
=
shift
;
die
$err
if
$err
;
$self
->sqitch->probe(
$self
->client,
'-version'
);
$self
->_capture(
'SELECT 1 FROM dual;'
);
},
engine_err_regex
=>
qr/\[Exasol\]\[Exasol(?:ution)? Driver\]syntax error/
i,
init_error
=> __x(
'Sqitch already initialized'
,
schema
=>
$reg2
,
),
add_second_format
=>
q{%s + interval '1' second}
,
test_dbh
=>
sub
{
my
$dbh
=
shift
;
is
$dbh
->selectcol_arrayref(
'SELECT current_schema'
)->[0],
uc
(
$reg2
),
'The Sqitch schema should be the current schema'
;
},
no_unique
=> 1,
);
done_testing;