view release on metacpan or  search on metacpan

t/exasol.t  view on Meta::CPAN

    'WHENEVER SQLERROR EXIT 4;',
    'DEFINE registry=meta;',
) ), '_script should use registry from config settings';

##############################################################################
# Test _run() and _capture().
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()';

# Let's make sure that IPC::Run3 actually works as expected.
$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';

# Make it die.
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';

##############################################################################
# Test unexpeted datbase error in _cid().
$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');

##############################################################################
# Test _file_for_script().
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';

# Get the temp dir used by the engine.
ok my $tmpdir = $exa->tmpdir, 'Get temp dir';
isa_ok $tmpdir, 'Path::Class::Dir', 'Temp dir';

# Make sure a file with @ is aliased.
my $file = $tmpdir->file('foo@bar.sql');
$file->touch; # File must exist, because on Windows it gets copied.
is $exa->_file_for_script($file), $tmpdir->file('foo_bar.sql'),
    'File with special char should be aliased';

# Now the alias exists, make sure _file_for_script dies if it cannot remove it.
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';
}

# Make sure double-quotes are escaped.
WIN32: {
    $file = $tmpdir->file('"foo$bar".sql');
    my $mock_file = Test::MockModule->new(ref $file);
    # Windows doesn't like the quotation marks, so prevent it from writing.
    $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';
}

##############################################################################
# Test file and handle running.
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';

# Verify should go to capture unless verbosity is > 1.
$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;

##############################################################################
# Test DateTime formatting stuff.
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';

##############################################################################
# Test SQL helpers.
is $exa->_listagg_format, q{GROUP_CONCAT(%1$s ORDER BY %1$s SEPARATOR ' ')},
    'Should have _listagg_format';