#!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More 0.94;
use Test::MockModule;
use Test::Exception;
use Locale::TextDomain qw(App-Sqitch);
use Capture::Tiny 0.12 qw(:all);
use Try::Tiny;
use App::Sqitch;
use App::Sqitch::Plan;
use lib 't/lib';
use DBIEngineTest;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine::pg';
require_ok $CLASS or die;
$ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.conf';
$ENV{SQITCH_USER_CONFIG} = 'nonexistent.conf';
}
is_deeply [$CLASS->config_vars], [
client => 'any',
username => 'any',
password => 'any',
db_name => 'any',
host => 'any',
port => 'int',
sqitch_schema => 'any',
], 'config_vars should return three vars';
my $sqitch = App::Sqitch->new;
isa_ok my $pg = $CLASS->new(sqitch => $sqitch), $CLASS;
my $client = 'psql' . ($^O eq 'MSWin32' ? '.exe' : '');
is $pg->client, $client, 'client should default to psql';
is $pg->sqitch_schema, 'sqitch', 'sqitch_schema default should be "sqitch"';
for my $attr (qw(username password db_name host port)) {
is $pg->$attr, undef, "$attr default should be undef";
}
is $pg->destination, $ENV{PGDATABASE} || $ENV{PGUSER} || $sqitch->sysuser,
'Destination should fall back on environment variables';
is $pg->meta_destination, $pg->destination,
'Meta destination should be the same as destination';
my @std_opts = (
'--quiet',
'--no-psqlrc',
'--no-align',
'--tuples-only',
'--set' => 'ON_ERROR_ROLLBACK=1',
'--set' => 'ON_ERROR_STOP=1',
'--set' => 'sqitch_schema=sqitch',
);
is_deeply [$pg->psql], [$client, @std_opts],
'psql command should be std opts-only';
isa_ok $pg = $CLASS->new(sqitch => $sqitch), $CLASS;
ok $pg->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'),
'Set some variables';
is_deeply [$pg->psql], [
$client,
'--set' => 'foo=baz',
'--set' => 'whu=hi there',
'--set' => 'yo=stellar',
@std_opts,
], 'Variables should be passed to psql via --set';
##############################################################################
# Test other configs for the destination.
ENV: {
# Make sure we override system-set vars.
local $ENV{PGDATABASE};
local $ENV{PGUSER};
for my $env (qw(PGDATABASE PGUSER)) {
my $pg = $CLASS->new(sqitch => $sqitch);
local $ENV{$env} = "\$ENV=whatever";
is $pg->destination, "\$ENV=whatever", "Destination should read \$$env";
is $pg->meta_destination, $pg->destination,
'Meta destination should be the same as destination';
}
my $mocker = Test::MockModule->new('App::Sqitch');
$mocker->mock(sysuser => 'sysuser=whatever');
my $pg = $CLASS->new(sqitch => $sqitch);
is $pg->destination, 'sysuser=whatever',
'Destination should fall back on sysuser';
is $pg->meta_destination, $pg->destination,
'Meta destination should be the same as destination';
$pg = $CLASS->new(sqitch => $sqitch, username => 'hi');
is $pg->destination, 'hi', 'Destination should read username';
is $pg->meta_destination, $pg->destination,
'Meta destination should be the same as destination';
$ENV{PGDATABASE} = 'mydb';
$pg = $CLASS->new(sqitch => $sqitch, username => 'hi');
is $pg->destination, 'mydb', 'Destination should prefer $PGDATABASE to username';
is $pg->meta_destination, $pg->destination,
'Meta destination should be the same as destination';
}
##############################################################################
# Make sure config settings override defaults.
my %config = (
'core.pg.client' => '/path/to/psql',
'core.pg.username' => 'freddy',
'core.pg.password' => 's3cr3t',
'core.pg.db_name' => 'widgets',
'core.pg.host' => 'db.example.com',
'core.pg.port' => 1234,
'core.pg.sqitch_schema' => 'meta',
);
$std_opts[-1] = 'sqitch_schema=meta';
my $mock_config = Test::MockModule->new('App::Sqitch::Config');
$mock_config->mock(get => sub { $config{ $_[2] } });
ok $pg = $CLASS->new(sqitch => $sqitch), 'Create another pg';
is $pg->client, '/path/to/psql', 'client should be as configured';
is $pg->username, 'freddy', 'username should be as configured';
is $pg->password, 's3cr3t', 'password should be as configured';
is $pg->db_name, 'widgets', 'db_name should be as configured';
is $pg->destination, 'widgets', 'destination should default to db_name';
is $pg->meta_destination, 'widgets', 'meta_destination should default to db_name';
is $pg->host, 'db.example.com', 'host should be as configured';
is $pg->port, 1234, 'port should be as configured';
is $pg->sqitch_schema, 'meta', 'sqitch_schema should be as configured';
is_deeply [$pg->psql], [qw(
/path/to/psql
--username freddy
--dbname widgets
--host db.example.com
--port 1234
), @std_opts], 'psql command should be configured';
##############################################################################
# Now make sure that Sqitch options override configurations.
$sqitch = App::Sqitch->new(
db_client => '/some/other/psql',
db_username => 'anna',
db_name => 'widgets_dev',
db_host => 'foo.com',
db_port => 98760,
);
ok $pg = $CLASS->new(sqitch => $sqitch), 'Create a pg with sqitch with options';
is $pg->client, '/some/other/psql', 'client should be as optioned';
is $pg->username, 'anna', 'username should be as optioned';
is $pg->password, 's3cr3t', 'password should still be as configured';
is $pg->db_name, 'widgets_dev', 'db_name should be as optioned';
is $pg->destination, 'widgets_dev', 'destination should still default to db_name';
is $pg->meta_destination, 'widgets_dev', 'meta_destination should still default to db_name';
is $pg->host, 'foo.com', 'host should be as optioned';
is $pg->port, 98760, 'port should be as optioned';
is $pg->sqitch_schema, 'meta', 'sqitch_schema should still be as configured';
is_deeply [$pg->psql], [qw(
/some/other/psql
--username anna
--dbname widgets_dev
--host foo.com
--port 98760
), @std_opts], 'psql command should be as optioned';
##############################################################################
# Test _run(), _capture(), and _spool().
can_ok $pg, qw(_run _capture _spool);
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my (@run, $exp_pass);
$mock_sqitch->mock(run => sub {
shift;
@run = @_;
if (defined $exp_pass) {
is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist';
}
});
my @capture;
$mock_sqitch->mock(capture => sub {
shift;
@capture = @_;
if (defined $exp_pass) {
is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist';
}
});
my @spool;
$mock_sqitch->mock(spool => sub {
shift;
@spool = @_;
if (defined $exp_pass) {
is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist';
}
});
$exp_pass = 's3cr3t';
ok $pg->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@run, [$pg->psql, qw(foo bar baz)],
'Command should be passed to run()';
ok $pg->_spool('FH'), 'Call _spool';
is_deeply \@spool, ['FH', $pg->psql],
'Command should be passed to spool()';
ok $pg->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [$pg->psql, qw(foo bar baz)],
'Command should be passed to capture()';
# Remove the password.
delete $config{'core.pg.password'};
ok $pg = $CLASS->new(sqitch => $sqitch), 'Create a pg with sqitch with no pw';
$exp_pass = undef;
ok $pg->_run(qw(foo bar baz)), 'Call _run again';
is_deeply \@run, [$pg->psql, qw(foo bar baz)],
'Command should be passed to run() again';
ok $pg->_spool('FH'), 'Call _spool again';
is_deeply \@spool, ['FH', $pg->psql],
'Command should be passed to spool() again';
ok $pg->_capture(qw(foo bar baz)), 'Call _capture again';
is_deeply \@capture, [$pg->psql, qw(foo bar baz)],
'Command should be passed to capture() again';
##############################################################################
# Test file and handle running.
ok $pg->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, [$pg->psql, '--file', 'foo/bar.sql'],
'File should be passed to run()';
ok $pg->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, ['FH', $pg->psql],
'Handle should be passed to spool()';
# Verify should go to capture unless verosity is > 1.
ok $pg->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
is_deeply \@capture, [$pg->psql, '--file', 'foo/bar.sql'],
'Verify file should be passed to capture()';
$mock_sqitch->mock(verbosity => 2);
ok $pg->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, [$pg->psql, '--file', 'foo/bar.sql'],
'Verifile file should be passed to run() for high verbosity';
$mock_sqitch->unmock_all;
$mock_config->unmock_all;
##############################################################################
# Test DateTime formatting stuff.
ok my $ts2char = $CLASS->can('_ts2char'), "$CLASS->can('_ts2char')";
is $ts2char->('foo'),
q{to_char(foo AT TIME ZONE 'UTC', '"year":YYYY:"month":MM:"day":DD:"hour":HH24:"minute":MI:"second":SS:"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';
##############################################################################
# Can we do live tests?
my $dbh;
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->do('DROP DATABASE __sqitchtest__') if $dbh->{Active};
}
my $err = try {
$dbh = DBI->connect('dbi:Pg:dbname=template1', 'postgres', '', {
PrintError => 0,
RaiseError => 1,
AutoCommit => 1,
});
$dbh->do('CREATE DATABASE __sqitchtest__');
undef;
} catch {
eval { $_->message } || $_;
};
DBIEngineTest->run(
class => $CLASS,
sqitch_params => [
db_username => 'postgres',
db_name => '__sqitchtest__',
top_dir => Path::Class::dir(qw(t engine)),
plan_file => Path::Class::file(qw(t engine sqitch.plan)),
],
engine_params => [],
alt_engine_params => [ sqitch_schema => '__sqitchtest' ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have psql and can connect to the database.
$self->sqitch->probe( $self->client, '--version' );
$self->_capture('--command' => 'SELECT version()');
},
engine_err_regex => qr/^ERROR: /,
init_error => __x(
'Sqitch schema "{schema}" already exists',
schema => '__sqitchtest',
),
);
done_testing;