view release on metacpan or  search on metacpan

t/oracle.t  view on Meta::CPAN

$config->update(
    'engine.oracle.client'   => '/path/to/sqlplus',
    'engine.oracle.registry' => 'meta',
);

$target = App::Sqitch::Target->new(sqitch => $sqitch);
ok $ora = $CLASS->new(sqitch => $sqitch, target => $target),
    'Create yet another ora';
is $ora->client, '/path/to/sqlplus', 'client should be as configured';
is $ora->registry, 'meta', 'registry should be as configured';
is_deeply [$ora->sqlplus], ['/path/to/sqlplus', @std_opts],
    'sqlplus command should be configured';

##############################################################################
# Test _run() and _capture().
can_ok $ora, 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 $ora->_run(qw(foo bar baz)), 'Call _run';
my $fh = shift @spool;
is_deeply \@spool, [$ora->sqlplus],
    'SQLPlus command should be passed to spool()';

is join('', <$fh> ), $ora->_script(qw(foo bar baz)),
    'The script should be spooled';

ok $ora->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [
    [$ora->sqlplus], \$ora->_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_ora = Test::MockModule->new($CLASS);
$mock_ora->mock(sqlplus => sub { $^X, $echo, qw(hi there) });

is join (', ' => $ora->_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_ora->mock(sqlplus => sub { $^X, $die, qw(hi there) });
like capture_stderr {
    throws_ok {
        $ora->_capture('whatever'),
    } 'App::Sqitch::X', '_capture should die when sqlplus dies';
}, qr/^OMGWTF/, 'STDERR should be emitted by _capture';

##############################################################################
# Test _file_for_script().
can_ok $ora, '_file_for_script';
is $ora->_file_for_script(Path::Class::file 'foo'), 'foo',
    'File without special characters should be used directly';
is $ora->_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 = $ora->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 $ora->_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 { $ora->_file_for_script($file) } 'App::Sqitch::X',
        'Should get an error on failure to delete the alias';
    is $@->ident, 'oracle', 'File deletion error ident should be "oracle"';
    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 $ora->_file_for_script($file), $tmpdir->file('""foo_bar"".sql'),
        'File with special char and quotes should be aliased';
}

##############################################################################
# Test unexpeted datbase error in _cid().
$mock_ora->mock(dbh => sub { die 'OW' });
throws_ok { $ora->initialized } qr/OW/,
    'initialized() should rethrow unexpected DB error';
throws_ok { $ora->_cid } qr/OW/,
    '_cid should rethrow unexpected DB error';
$mock_ora->unmock('dbh');

##############################################################################
# Test file and handle running.
my @run;
$mock_ora->mock(_run => sub {shift; @run = @_ });
ok $ora->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, ['@"foo/bar.sql"'],
    'File should be passed to run()';

ok $ora->run_file('foo/"bar".sql'), 'Run foo/"bar".sql';
is_deeply \@run, ['@"foo/""bar"".sql"'],
    'Double quotes in file passed to run() should be escaped';

ok $ora->run_handle('FH'), 'Spool a "file handle"';
my $handles = shift @spool;
is_deeply \@spool, [$ora->sqlplus],
    'sqlplus command should be passed to spool()';
isa_ok $handles, 'ARRAY', 'Array ove handles should be passed to spool';
$fh = $handles->[0];
is join('', <$fh>), $ora->_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_ora->mock(_capture => sub {shift; @capture = @_ });
ok $ora->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 $ora->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, ['@"foo/bar.sql"'],
    'Verify file should be passed to run() for high verbosity';

$mock_sqitch->unmock_all;
$mock_ora->unmock_all;

##############################################################################
# Test DateTime formatting stuff.
ok my $ts2char = $CLASS->can('_ts2char_format'), "$CLASS->can('_ts2char_format')";
is sprintf($ts2char->(), 'foo'), join( ' || ',
    q{to_char(foo AT TIME ZONE 'UTC', '"year":YYYY')},
    q{to_char(foo AT TIME ZONE 'UTC', ':"month":MM')},
    q{to_char(foo AT TIME ZONE 'UTC', ':"day":DD')},
    q{to_char(foo AT TIME ZONE 'UTC', ':"hour":HH24')},
    q{to_char(foo AT TIME ZONE 'UTC', ':"minute":MI')},
    q{to_char(foo AT TIME ZONE 'UTC', ':"second":SS')},
    q{':time_zone:UTC'},
), '_ts2char_format 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';
is $CLASS->_char2ts($dt),
    join(' ', $dt->ymd('-'), $dt->hms(':'), $dt->time_zone->name),
    'Should have _char2ts';

##############################################################################
# Test SQL helpers.
is $ora->_listagg_format, q{CAST(COLLECT(CAST(%s AS VARCHAR2(512))) AS sqitch_array)},
    'Should have _listagg_format';
is $ora->_regex_op, 'REGEXP_LIKE(%s, ?)', 'Should have _regex_op';
is $ora->_simple_from, ' FROM dual', 'Should have _simple_from';
is $ora->_limit_default, undef, 'Should have _limit_default';
is $ora->_ts_default, 'current_timestamp', 'Should have _ts_default';