t 000755 001751 000166 0 15004170404 14001 5 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 x.t 100644 001751 000166 5153 15004170404 14601 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use Test::More;
use Test::Exception;
use Try::Tiny;
use Path::Class;
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::X';
require_ok $CLASS or die;
$CLASS->import(':all');
}
isa_ok my $x = $CLASS->new(ident => 'test', message => 'Die'), $CLASS, 'X object';
for my $role(qw(
Throwable
StackTrace::Auto
)) {
ok $x->does($role), "X object does $role";
}
# Make sure default ident works.
ok $x = $CLASS->new(message => 'whatever'), 'Create X without ident';
is $x->ident, 'DEV', 'Default ident should be "DEV"';
throws_ok { hurl basic => 'OMFG!' } $CLASS;
isa_ok $x = $@, $CLASS, 'Thrown object';
is $x->ident, 'basic', 'Ident should be "basic"';
is $x->message, 'OMFG!', 'The message should have been passed';
ok $x->stack_trace->frames, 'It should have a stack trace';
is $x->exitval, 2, 'Exit val should be 2';
is +($x->stack_trace->frames)[0]->filename, file(qw(t x.t)),
'The trace should start in this file';
# NB: Don't use `local $@`, as it does not work on Perls < 5.14.
throws_ok { $@ = 'Yo dawg'; hurl 'OMFG!' } $CLASS;
isa_ok $x = $@, $CLASS, 'Thrown object';
is $x->ident, 'DEV', 'Ident should be "DEV"';
is $x->message, 'OMFG!', 'The message should have been passed';
is $x->exitval, 2, 'Exit val should again be 2';
is $x->previous_exception, 'Yo dawg',
'Previous exception should have been passed';
is $x->as_string, join("\n",
$x->message,
$x->previous_exception,
$x->stack_trace
), 'Stringification should work';
is $x->as_string, "$x", 'Stringification should work';
is $x->details_string, join("\n",
$x->previous_exception,
$x->stack_trace
), 'Details string should work';
throws_ok { hurl {ident => 'blah', message => 'OMFG!', exitval => 1} } $CLASS;
isa_ok $x = $@, $CLASS, 'Thrown object';
is $x->message, 'OMFG!', 'The params should have been passed';
is $x->exitval, 1, 'Exit val should be 1';
is $x->as_string, join("\n",
$x->message,
$x->stack_trace
), 'Stringification should work';
is $x->as_string, "$x", 'Stringification should work';
is $x->details_string, join("\n",
$x->stack_trace
), 'Details string should work';
# Do some actual exception handling.
try {
hurl io => 'Cannot open file';
} catch {
return fail "Not a Sqitch::X: $_" unless eval { $_->isa('App::Sqitch::X') };
is $_->ident, 'io', 'Should be an "io" exception';
};
# Make sure we can goto hurl.
try {
@_ = (io => 'Cannot open file');
goto &hurl;
} catch {
return fail "Not a Sqitch::X: $_" unless eval { $_->isa('App::Sqitch::X') };
is $_->ident, 'io', 'Should catch error called via &goto';
};
done_testing;
pg.t 100644 001751 000166 50300 15004170404 14752 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# There are two ways to test against a live Postgres database. If there is an
# instance on the local host trusting all local socket connections and the
# default postgres user, the test will connect, create the database it needs,
# run the tests, and then drop the database.
#
# Alternatively, provide the URL to connect to a Postgres database in the
# SQITCH_TEST_PG_URI environment variable. this is a standard URI::db URI, and
# should look something like this:
#
# export SQITCH_TEST_PG_URI=db:pg://postgres:password@localhost:5432/sqitchtest
#
# It should use the C locale (`ALTER DATABASE $db SET lc_messages = 'C'`) to
# ensure proper sorting while testing. Sqitch will connect to this database and
# create two schemas to run the tests in, `sqitch` and `__sqitchtest`, and will
# drop them when the tests complete.
#
use strict;
use warnings;
use 5.010;
use Test::More 0.94;
use Test::MockModule;
use Test::Exception;
use Test::File::Contents;
use Locale::TextDomain qw(App-Sqitch);
use Capture::Tiny 0.12 qw(:all);
use Try::Tiny;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use Path::Class;
use DBD::Mem;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine::pg';
require_ok $CLASS or die;
delete $ENV{PGPASSWORD};
}
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $uri = URI::db->new('db:pg:');
my $config = TestConfig->new('core.engine' => 'pg');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => $uri,
);
isa_ok my $pg = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $pg->key, 'pg', 'Key should be "pg"';
is $pg->name, 'PostgreSQL', 'Name should be "PostgreSQL"';
my $client = 'psql' . (App::Sqitch::ISWIN ? '.exe' : '');
is $pg->client, $client, 'client should default to psqle';
is $pg->registry, 'sqitch', 'registry default should be "sqitch"';
is $pg->uri, $uri, 'DB URI should be "db:pg:"';
my $dest_uri = $uri->clone;
$dest_uri->dbname($ENV{PGDATABASE} || $ENV{PGUSER} || $sqitch->sysuser);
is $pg->destination, $dest_uri->as_string,
'Destination should fall back on environment variables';
is $pg->registry_destination, $pg->destination,
'Registry destination should be the same as destination';
my @std_opts = (
'--quiet',
'--no-psqlrc',
'--no-align',
'--tuples-only',
'--set' => 'ON_ERROR_STOP=1',
'--set' => 'registry=sqitch',
);
my $sysuser = $sqitch->sysuser;
is_deeply [$pg->psql], [$client, @std_opts],
'psql command should be conninfo, and std opts-only';
isa_ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), $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 target.
ENV: {
# Make sure we override system-set vars.
local $ENV{PGDATABASE};
for my $env (qw(PGDATABASE PGUSER PGPASSWORD)) {
my $pg = $CLASS->new(sqitch => $sqitch, target => $target);
local $ENV{$env} = "\$ENV=whatever";
is $pg->target->uri, "db:pg:", "Target should not read \$$env";
is $pg->registry_destination, $pg->destination,
'Registry target should be the same as destination';
}
my $mocker = Test::MockModule->new('App::Sqitch');
$mocker->mock(sysuser => 'sysuser=whatever');
my $pg = $CLASS->new(sqitch => $sqitch, target => $target);
is $pg->target->uri, 'db:pg:', 'Target should not fall back on sysuser';
is $pg->registry_destination, $pg->destination,
'Registry target should be the same as destination';
$ENV{PGDATABASE} = 'mydb';
$pg = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target);
is $pg->target->uri, 'db:pg:', 'Target should be the default';
is $pg->registry_destination, $pg->destination,
'Registry target should be the same as destination';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.pg.client' => '/path/to/psql',
'engine.pg.target' => 'db:pg://localhost/try?sslmode=disable&connect_timeout=5',
'engine.pg.registry' => 'meta',
);
$std_opts[-1] = 'registry=meta';
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $pg = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another pg';
is $pg->client, '/path/to/psql', 'client should be as configured';
is $pg->uri->as_string, 'db:pg://localhost/try?sslmode=disable&connect_timeout=5',
'uri should be as configured';
is $pg->registry, 'meta', 'registry should be as configured';
is_deeply [$pg->psql], [
'/path/to/psql',
'--dbname',
"dbname=try host=localhost connect_timeout=5 sslmode=disable",
@std_opts], 'psql command should be configured from URI config';
##############################################################################
# Test _run(), _capture(), _spool(), and _probe().
can_ok $pg, qw(_run _capture _spool _probe);
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my (@run, $exp_pass);
$mock_sqitch->mock(run => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
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 {
local $Test::Builder::Level = $Test::Builder::Level + 2;
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 {
local $Test::Builder::Level = $Test::Builder::Level + 2;
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';
}
});
my @probe;
$mock_sqitch->mock(probe => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@probe = @_;
if (defined $exp_pass) {
is $ENV{PGPASSWORD}, $exp_pass, qq{PGPASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{PGPASSWORD}, 'PGPASSWORD should not exist';
}
});
$target->uri->password('s3cr3t');
$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()';
ok $pg->_probe(qw(hi there)), 'Call _probe';
is_deeply \@probe, [$pg->psql, qw(hi there)];
# Without password.
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $pg = $CLASS->new(sqitch => $sqitch, target => $target),
'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';
ok $pg->_probe(qw(go there)), 'Call _probe again';
is_deeply \@probe, [$pg->psql, qw(go there)];
##############################################################################
# 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;
##############################################################################
# Test DateTime formatting stuff.
ok my $ts2char = $CLASS->can('_ts2char_format'), "$CLASS->can('_ts2char_format')";
is sprintf($ts2char->($pg), '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_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';
##############################################################################
# Test _psql_major_version.
for my $spec (
['11beta3', 11],
['11.3', 11],
['10', 10],
['9.6.3', 9],
['8.4.2', 8],
['9.0.19', 9],
) {
$mock_sqitch->mock(probe => "psql (PostgreSQL) $spec->[0]");
is $pg->_psql_major_version, $spec->[1],
"Should find major version $spec->[1] in $spec->[0]";
}
$mock_sqitch->unmock('probe');
##############################################################################
# Test table error and listagg methods.
DBI: {
local *DBI::state;
ok !$pg->_no_table_error, 'Should have no table error';
ok !$pg->_no_column_error, 'Should have no column error';
$DBI::state = '42703';
ok !$pg->_no_table_error, 'Should again have no table error';
ok $pg->_no_column_error, 'Should now have no column error';
# Need to mock DBH for table errors.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
my $mock_engine = Test::MockModule->new($CLASS);
$mock_engine->mock(dbh => $dbh);
my $mock_dbd = Test::MockModule->new(ref $dbh, no_auto => 1);
$mock_dbd->mock(quote => sub { qq{'$_[1]'} });
my @done;
$mock_dbd->mock(do => sub { shift; @done = @_ });
# Should just work when on 8.4.
$DBI::state = '42P01';
$dbh->{pg_server_version} = 80400;
ok $pg->_no_table_error, 'Should now have table error';
ok !$pg->_no_column_error, 'Still should have no column error';
is_deeply \@done, [], 'No SQL should have been run';
# On 9.0 and later, we should send warnings to the log.
$dbh->{pg_server_version} = 90000;
ok $pg->_no_table_error, 'Should again have table error';
ok !$pg->_no_column_error, 'Still should have no column error';
is_deeply \@done, [sprintf q{DO $$
BEGIN
SET LOCAL client_min_messages = 'ERROR';
RAISE WARNING USING ERRCODE = 'undefined_table', MESSAGE = %s, DETAIL = %s;
END;
$$}, map { "'$_'" }
__ 'Sqitch registry not initialized',
__ 'Because the "changes" table does not exist, Sqitch will now initialize the database to create its registry tables.',
], 'Should have sent an error to the log';
# Test _listagg_format.
$dbh->{pg_server_version} = 110000;
is $pg->_listagg_format, q{array_remove(array_agg(%1$s ORDER BY %1$s), NULL)},
'Should use array_remove and ORDER BY in listagg_format on v11';
$dbh->{pg_server_version} = 90300;
is $pg->_listagg_format, q{array_remove(array_agg(%1$s ORDER BY %1$s), NULL)},
'Should use array_remove and ORDER BY in listagg_format on v9.3';
$dbh->{pg_server_version} = 90200;
is $pg->_listagg_format,
q{ARRAY(SELECT * FROM UNNEST( array_agg(%1$s ORDER BY %1$s) ) a WHERE a IS NOT NULL)},
'Should use ORDER BY in listagg_format on v9.2';
$dbh->{pg_server_version} = 90000;
is $pg->_listagg_format,
q{ARRAY(SELECT * FROM UNNEST( array_agg(%1$s ORDER BY %1$s) ) a WHERE a IS NOT NULL)},
'Should use ORDER BY in listagg_format on v9.0';
$dbh->{pg_server_version} = 80400;
is $pg->_listagg_format,
q{ARRAY(SELECT * FROM UNNEST( array_agg(%s) ) a WHERE a IS NOT NULL)},
'Should not use ORDER BY in listagg_format on v8.4';
}
##############################################################################
# Test _run_registry_file.
RUNREG: {
# Mock I/O used by _run_registry_file.
my $mock_engine = Test::MockModule->new($CLASS);
my (@probed, @prob_ret);
$mock_engine->mock(_probe => sub {
shift;
push @probed, \@_;
shift @prob_ret;
});
my $psql_maj;
$mock_engine->mock(_psql_major_version => sub { $psql_maj });
my @ran;
$mock_engine->mock(_run => sub { shift; push @ran, \@_ });
# Mock up the database handle.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
$mock_engine->mock(dbh => $dbh );
my $mock_dbd = Test::MockModule->new(ref $dbh, no_auto => 1);
my @done;
$mock_dbd->mock(do => sub { shift; push @done, \@_; 1 });
my @sra_args;
$mock_dbd->mock(selectrow_array => sub {
shift;
push @sra_args, [@_];
return (qq{"$_[-1]"});
});
# Mock File::Temp so we hang on to the file.
my $mock_ft = Test::MockModule->new('File::Temp');
my $tmp_fh;
my $ft_new;
$mock_ft->mock(new => sub { $tmp_fh = 'File::Temp'->$ft_new() });
$ft_new = $mock_ft->original('new');
# Find the SQL file.
my $ddl = file($INC{'App/Sqitch/Engine/pg.pm'})->dir->file('pg.sql');
# The XC query.
my $xc_query = q{
SELECT count(*)
FROM pg_catalog.pg_proc p
JOIN pg_catalog.pg_namespace n ON p.pronamespace = n.oid
WHERE nspname = 'pg_catalog'
AND proname = 'pgxc_version';
};
# Start with a recent version and no XC.
$psql_maj = 11;
@prob_ret = (110000, 0);
my $registry = $pg->registry;
ok $pg->_run_registry_file($ddl), 'Run the registry file';
is_deeply \@probed, [
['-c', 'SHOW server_version_num'],
['-c', $xc_query],
], 'Should have fetched the server version and checked for XC';
is_deeply \@ran, [[
'--file' => $ddl,
'--set' => "registry=$registry",
'--set' => "tableopts=",
]], 'Shoud have deployed the original SQL file';
is_deeply \@done, [['SET search_path = ?', undef, $registry]],
'The registry should have been added to the search path';
is_deeply \@sra_args, [], 'Should not have have called selectrow_array';
is $tmp_fh, undef, 'Should have no temp file handle';
# Reset and try Postgres 9.2 server
@probed = @ran = @done = ();
$psql_maj = 11;
@prob_ret = (90200, 1);
ok $pg->_run_registry_file($ddl), 'Run the registry file again';
is_deeply \@probed, [
['-c', 'SHOW server_version_num'],
['-c', $xc_query],
], 'Should have again fetched the server version and checked for XC';
isnt $tmp_fh, undef, 'Should now have a temp file handle';
is_deeply \@ran, [[
'--file' => $tmp_fh,
'--set' => "tableopts= DISTRIBUTE BY REPLICATION",
]], 'Shoud have deployed the temp SQL file';
is_deeply \@sra_args, [], 'Still should not have have called selectrow_array';
is_deeply \@done, [['SET search_path = ?', undef, $registry]],
'The registry should have been added to the search path again';
# Make sure the file was changed to remove SCHEMA IF NOT EXISTS.
file_contents_like $tmp_fh, qr/\QCREATE SCHEMA :"registry";/,
'Should have removed IF NOT EXISTS from CREATE SCHEMA';
# Reset and try with Server 11 and psql 8.x.
@probed = @ran = @done = ();
$psql_maj = 8;
$tmp_fh = undef;
@prob_ret = (110000, 0);
ok $pg->_run_registry_file($ddl), 'Run the registry file again';
is_deeply \@probed, [
['-c', 'SHOW server_version_num'],
['-c', $xc_query],
], 'Should have again fetched the server version and checked for XC';
isnt $tmp_fh, undef, 'Should now have a temp file handle';
is_deeply \@ran, [[
'--file' => $tmp_fh,
'--set' => "tableopts=",
]], 'Shoud have deployed the temp SQL file';
is_deeply \@sra_args, [['SELECT quote_ident(?)', undef, $registry]],
'Should have have called quote_ident via selectrow_array';
is_deeply \@done, [['SET search_path = ?', undef, qq{"$registry"}]],
'The registry should have been added to the search path again';
file_contents_like $tmp_fh, qr/\QCREATE SCHEMA IF NOT EXISTS "$registry";/,
'Should not have removed IF NOT EXISTS from CREATE SCHEMA';
file_contents_unlike $tmp_fh, qr/:"registry"/,
'Should have removed the :"registry" variable';
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($pg->key);
##############################################################################
# Can we do live tests?
$config->replace('core.engine' => 'pg');
$sqitch = App::Sqitch->new(config => $config);
$target = App::Sqitch::Target->new( sqitch => $sqitch );
$pg = $CLASS->new(sqitch => $sqitch, target => $target);
$uri = URI->new(
$ENV{SQITCH_TEST_PG_URI}
|| 'db:pg://' . ($ENV{PGUSER} || 'postgres') . "\@/template1"
);
my $dbh;
my $id = DBIEngineTest->randstr;
my ($db, $reg1, $reg2) = map { $_ . $id } qw(__sqitchtest__ 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;
});
# Drop the database or schema.
if ($dbh->{Active}) {
if ($ENV{SQITCH_TEST_PG_URI}) {
$dbh->do('SET client_min_messages = warning');
$dbh->do("DROP SCHEMA $_ CASCADE") for $reg1, $reg2;
} else {
$dbh->do("DROP DATABASE $db");
}
}
}
my $err = try {
$pg->_capture('--version');
$pg->use_driver;
$dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $pg->error_handler,
pg_lc_messages => 'C',
});
unless ($ENV{SQITCH_TEST_PG_URI}) {
$dbh->do("CREATE DATABASE $db");
$uri->dbname($db);
}
undef;
} catch {
$_
};
DBIEngineTest->run(
class => $CLASS,
version_query => 'SELECT version()',
target_params => [ uri => $uri, registry => $reg1 ],
alt_target_params => [ uri => $uri, registry => $reg2 ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have psql and can connect to the database.
my $version = $self->sqitch->capture( $self->client, '--version' );
say "# Detected $version";
$self->_capture('--command' => 'SELECT version()');
},
engine_err_regex => qr/^ERROR: /,
init_error => __x(
'Sqitch schema "{schema}" already exists',
schema => $reg2,
),
test_dbh => sub {
my $dbh = shift;
# Make sure the sqitch schema is the first in the search path.
is $dbh->selectcol_arrayref('SELECT current_schema')->[0],
$reg2, 'The Sqitch schema should be the current schema';
},
lock_sql => sub {
my $engine = shift;
return {
is_locked => q{SELECT 1 FROM pg_locks WHERE locktype = 'advisory' AND objid = 75474063 AND objsubid = 1},
try_lock => 'SELECT pg_try_advisory_lock(75474063)',
free_lock => 'SELECT pg_advisory_unlock_all()',
} if $engine->_provider ne 'yugabyte';
return undef;
},
);
done_testing;
App-Sqitch-v1.5.2 000755 001751 000166 0 15004170404 13615 5 ustar 00runner docker 000000 000000 README 100644 001751 000166 503 15004170404 14534 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 This archive contains the distribution App-Sqitch,
version v1.5.2:
Sensible database change management
This software is Copyright (c) 2012-2025 by "iovation Inc., David E. Wheeler".
This is free software, licensed under:
The MIT (X11) License
This README file was generated by Dist::Zilla::Plugin::Readme v6.032.
Changes 100644 001751 000166 411142 15004170404 15234 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 Revision history for Perl extension App::Sqitch
1.5.2 2025-04-29T15:13:35Z
- Added missing German translations, thanks to @0xflotus for the PR
(#873)!
- Fixed bug where the location of reworked script files did not respect
the `deploy_dir`, `revert_dir`, or `verify_dir` options. Thanks to Neil
Freeman for the report (#875)!
- Updated the MySQL engine's installation of the `checkit()` function so
that it no longer depends on permission-checking, since the current
user may not have such permission. It instead attempts to create the
function and ignores a failure due to a lack of permission. Thanks to
Alastair Douglas for the report and solution (#874)!
- Added missing CockroachDB templates. Thanks to @Peterbyte for the
report (#878)!
- Removed support for the `SNOWSQL_PORT` environment variable, which has
long been deprecated by Snowflake and likely never did anything.
- Fixed the quoting of the role and schema names on connecting to
Snowflake, which was silently failing and thus not properly using the
registry schema, which lead to a failure to find the registry. Broken
in v1.5.1.
- Added redaction of passwords from Snowflake URL query parameters in the
display URL. Any query parameter matching `pwd` will now appear as
"REDACTED".
- Expanded the documentation of Snowflake key pair authentication in
`sqitch-authentication.pod` to recommend setting sensitive ODBC
parameters in an `odbc.ini` file rather than connection URL query
parameters.
- Switched to key pair authentication in the Snowflake CI workflows.
- Fixed another test failure with some Firebird configurations and
improved diagnostic output when an engine cannot be integration-tested.
1.5.1 2025-03-16T26:55:17Z
- Fixed a bug introduced in v1.5.0 where the MySQL engine connected to
the target database instead of the registry database. Thanks to
@tiberiusferreira for the report (#862)!
- Fixed test failures with some Exasol and Firebird configurations.
Thanks to Slaven Rezić for the report (#858)!
- Added some missing German translations, thanks to @0xflotus (#873).
1.5.0 2025-01-08T03:22:40
- Fix improperly nested Pod headers that were incrementing two levels
relative to their parent headers, which messed with the HTML output on
sqitch.org.
- Banned "[" and "]" in names (changes, tags, projects) because they
muck with dependency parsing of the plan file. Thanks to Žiga Leber for
the bug report (#829).
- Updated the IPC methods that interact with engine clients to raise
exception objects rather than strings, for more consistent error
handling throughout.
- Removed duplicate DBI error handling code from engines and tests.
- Fixed an order of operation issue that prevented Sqitch from detecting
Yugabyte before attempting to create an advisory lock, which resulted
in an error for more recent Yugabyte releases. Thanks to Stefano
Ricciardi for the report (#841).
- Removed a wayward mention of the long-deprecated `SQITCH_URI`
environment variable from the Oracle tutorial. Thanks to Austin Hanson
for the report (#845).
- Improved unexpected error output by including any previous exception.
- Changed the "unknown engine" error to a runtime error, rather than
development time, with a localized error message. The error loading
the engine package and the stack trace remain available by using
triple verbosity (`-vvv`). Thanks to Martin Fischer for the report
(#838).
- Changed the default error code from Oracle `sqlplus` from `SQL.SQLCODE`
to `4`, because otherwise the exit code is returned `modulo 256`,
meaning it can end up `0` for success for an SQL error code like
`ORA-01792`. Selected `4` as the replacement to match the behavior of
Exasol and because `FAILURE` maps to exit code `1`, which has in the
past been more akin to a warning. Thanks to @vectro for the report
(#831).
- Added checks for the existence of deploy and revert files when
deploying and reverting. Previously Sqitch deferred such errors to the
CLIs, but they're never called when using `--log-only`. Thanks to
@vectro and Erik Wienhold for the suggestion (#828).
- Fixed a bug where the MySQL engine failed to properly handle target
URIs with no database name. Thanks to Felix Zedén Yverås for the report
(#821).
- Updated the MySQL engine to omit the `checkit()` function when using
binary logging and Sqitch lacks super user permissions. Thanks to Scott
Edwards for the report and to Janosch Peters for the solution (#824).
- Taught the Snowflake engine to detect when the Sqitch user lacks
permission to create a schema and to skip the creation of the registry
schema. Useful for cases when the registry schema was created in
advance. Thanks to Peter Wimsey for the suggestion (#826).
- Switched the MySQL engine from DBD::mysql to DBD::MariaDB for better
compatibility with older versions of the MySQL client library and for
its Unicode improvements. Thanks to Mark Tyrrell for the report and
@tiberiusferreira and Perl Monks `1nickt` and`InfiniteSilence` for the
feedback (#825).
1.4.1 2024-02-04T16:35:32Z
- Removed the quoting of the role and warehouse identifiers that was
added to the Snowflake engine in v1.4.0. Turns out Snowflake allows a
warehouse to be specified in a different database, in which case dots
are valid in the name and should not be quoted! So users must properly
quote when necessary, but added notes to `sqitchtutorial-snowflake.pod`
on the need to use URI escapes for special characters. Thanks to
Patrick Sabo for the find, and to @marc-marketparts for validating
that URI encoding works.
- Added notes on URL encoding database URLs to `sqitch-target.pod`, the
main reference for database URLs in the Sqitch documentation.
- Fixed the output of the list of changes to be deployed or reverted to
actually require `--verbose` twice, as described in the v1.4.0 changes,
and not just once. Thanks to Erik Wienhold for the PR (#785)!
- Removed the duplicate change name from the output of the list of
changes to be deployed or reverted with `-VV`. Thanks to Erik Wienhold
for the PR (#787)!
- Fixed invalid template resolution when adding a singe change to
multiple engines at once. Thanks to Christian Riedel for the detailed
bug report (#795)!
- Fixed Oracle and Firebird test failures due to incorrect use of `chmod`.
Thanks to Slaven Rezić for the report and the fix (#807)!
- Tests now require Test::Warn 0.31 or later, as newline handling issues
cause test failures in earlier versions. Thanks to Slaven Rezić for the
test reports and for identifying the issue.
- Updated the locale configuration to fix issues in more recent versions
of Perl, and added tests to ensure that the sqitch CLI executes and
properly emits localized messages (except on Windows, where the language
codes are incompatible).
- Fixed an issue where the MySQL engine failed to recognize the MariaDB
`mysql` client installed by Homebrew on macOS. Thanks to Carlos Ramos
for the bug report and PR (#791)!
1.4.0 2023-08-01T23:37:30Z
- Fixed Snowflake warehouse and role setup to properly quote identifiers
unless they're valid unquoted identifiers or already quoted. Thanks to
@marc-marketparts for the report (#685).
- Fixed a bug reworking a change when a rework directory is configured
but not created. Thanks to @jfeaver for the report (#686).
- Output the list of changes to be deployed or reverted when `--verbose`
is specified at least twice. Thanks to @vectro for the PR (#702).
- Fixed the formatting of the log and plan commands to allow empty or `0`
separators in lists of things (such as `%{0}t` for a list of tags).
Thanks to @web-vertalo for the pull request (#703).
- Updated the MySQL Tutorial to use 5.7 features. Thanks to Vlad
Safronov for the PR (#705).
- Deprecated the `no_prompt` and `no_prompt` attributes of
App::Sqitch::Engine in favor of passing booleans to the `revert` and
`verify` methods. The attributes still exist for reverse compatibility,
but now emit warnings and will be removed in the future. Thanks to
Thanks to @vectro for the PR (#704).
- Added a warning for a double extension on the file names created
by the `add` command. Thanks to @blairjordan for the PR (#724)!
- Added the `revert.strict` boolean configuration variable which, when
set to true, requires the specification of a change to revert to. It
also disables the `rebase` and `checkout` commands, though the
`rebase.strict` and `checkout.strict` variables, respectively, may
override it. Use `revert.strict` to prevent accidental reverts in
sensitive environments. Thanks to @vectro for the PR (#719; revised in
#735)!
- Fixed test failures due to a bug fix in the Perl URI module
(libwww-perl/URI#13). Thanks to @bobfang for the report (#744)!
- Fixed test failures due to a change in the generation of DBI DSN by
URI::Oracle introduced by libwww-perl/URI-db#23.
- Added a format option `%F` to `sqitch plan` that prints the path for
the deploy file for each migration in the plan.
- Changed the default location for the Oracle `sqlplus` client when the
`ORACLE_HOME` environment variable is set. It now returns either
`$ORACLE_HOME/bin/sqlplus` or `$ORACLE_HOME/sqlplus` if it exists
and is executable (and ends in `.exe` on Windows). Otherwise it simply
returns `sqlplus` as before, assuming it will be found in the path.
Thanks to @vectro for the suggestion (#747).
- Increased the required version of DBI to 1.631 or higher and removed
a MySQL engine workaround for older versions.
- Added detection of a missing registry schema on connect and conditions
to avoid querying it when it does not exist. Fixes an issue where
Sqitch might find a project record in the current schema instead of the
expected registry schema. Thanks to @vectro for the report and
investigation (#668)!
- Fixed Snowflake and MySQL to properly raise errors on session query
failures immediately after connection.
- Fixed the handling of unique violations for deploy script hash
uniqueness so that it no longer returns a database error but properly
reports the issue in a more human-friendly error message. Thanks to
Stefan Badenhorst for the reminder (#630).
- Updated the registry SQL scripts for Vertica to always enable primary
key and unique constraints. Unique constraints are now enabled for
all database engines except Exasol and Snowflake.
- Dropped support for Vertica 7.1, as unique constraint enforcement was
not added until Vertica 7.2.
- Increased minimum SQLite versions to 3.8.6, when unique constraint
enforcement was added.
- Removed remaining uses of the smartmatch operator, thus eliminating
the Perl 5.38 warnings about its deprecation. (#769)
- Added Cockroach to the list of valid engines recognized in command-line
arguments (and a test to ensure new engines won't be omitted in the
future). Thanks to @NOBLES5E for the spot (#772)!
1.3.1 2022-10-01T18:49:30Z
- Fixed a bug introduced in v1.3.0 where the Postgres engine would
always pass the port to `psql`, thus ignoring the `PGPORT` environment
variable. Thanks to Cam Feenstra for the spot (#675)!
- Fixed test failures on OSes where the local time zone cannot be
determined. Thanks to Slaven Rezić for the test reports, and to
Dave Rolsky for the solution (#672).
- Updated the MySQL deploy/revert lock to be specific to the target
database. This allows multiple instances of Sqitch to run at the
same time on the same server as long as they're connecting to different
databases. Thanks to Dmytro Kh for the report and discussion of the
options (#670).
- Fixed test failures where DBD::Mem was not installed. Likely only
occurred on some CPAN Testers nodes. Thanks to Slaven Rezić for those
(#673).
- Banned the backslash character (`\`) in change and tag names. It would
be ignored on Unix-style systems, but create unexpected subdirectories
on Windows systems.
- Banned the slash character (`/`) in tag names. They're still allowed
in change names to enable script organization, but can wreak havoc
when used in tag names. Thanks to @ewie for the report (#680)!
1.3.0 2022-08-12T22:09:13Z
- Fixed an issue when testing Firebird on a host with Firebird installed
but no `isql`, and when using a local Firebird (e.g., the Engine12
provider), which allows only one connection at a time. Thanks to Slaven
Rezić for the the reproducible configuration (#597).
- Tweaked the Postgres engine to support Yugabyte. The only unsupported
features are explicit locks, so users need to manually ensure that only
one instance of Sqitch is updating the cluster at a time.
- Added support for CockroachDB. Almost exactly the same as for Postgres,
so the new App::Sqitch::Engine::cockroach class extends
App::Sqitch::Engine::pg to make a few changes. The SQL files with
the registry DDL varies in a few ways, so they're separate.
- Now require URI::db v0.20 for Cockroach and Yugabyte URI support.
- Dropped support for MySQL 5.0.
- Added explicit sorting for aggregated lists (such as the tags associated
with a commit) to the MySQL, Exasol, Snowflake, and Postgres (9.0 and
higher) engines.
- Fixed slow deploys on MariaDB thanks to fractional timestamp support
added in 5.03.05. Thanks to @rbrigot for the PR (#658)!
- Fixed a bug where destination locking failed on the first deploy to
MySQL. Bug introduced along with destination locking in v1.2.0.
Thanks Tom Bloor the report and to Alberto Simões for the help
replicating the issue (#601).
- Removed the `sqitch engine update-config` action, originally added for
compatibility reasons in 2014, and the prompt to use it was removed as
of 0.9999 in 2019.
- Fixed a warning when searching for the Firebird client on Windows.
1.2.1 2021-12-05T19:59:45Z
- Updated all the live engine tests, aside from Oracle, to test with
unique registry names, so as to avoid conflicts when multiple
instances are being tested at once. Thanks to Slaven Rezić for the
report (#597).
- Removed `local` directory from the distribution, accidentally included
in v1.2.0. Thanks to gregor herrmann for the report (#600).
1.2.0 2021-11-20T22:45:00Z
- Fixed partitioned search for deployed changes on Oracle and Exasol to
correctly support plans with more than 250 changes. Thanks to @Nicqu
for the report (#521).
- DBI connections to the registry will now be set to trace level one
when a verbosity level of three or higher is passed to Sqitch
(i.e., `sqitch -vvv`). Thanks to @wkoszek for the suggestion (#155).
- Renamed the "master" branch to "main" and updated all relevant
references.
- Fixed the parsing of the Snowflake account name from the target URL
to that it no longer strips out the region and cloud platform parts.
Also deprecated the use of the region, host, and port config and
environment variables. This is to comply with the new account name
format. Thanks to @ldsingh00 for the report (#544).
- The checkout command will now show a usage statement when no branch
name is passed to it, rather than a series of warnings and a Git error.
Thanks to François Beausoleil for the report (#561).
- The checkout command now works when operating on a Sqitch project in
a subdirectory of a Git project. Thanks to François Beausoleil for the
report and suggested fix (#560).
- Fixed a failing bundle test when a top directory was configured in the
user or system configuration. Thanks to @CodingMinds for the spot
(#587).
- Added support to the Exasol engine for the `AUTHMETHOD` query parameter
(to allow Open ID authentication) and the `SSLCERTIFICATE=SSL_VERIFY_NONE`
query parameter to disable SSL verification. Thanks to Torsten Glunde
for the report (#588).
- Fixed "Use of uninitialized value $engine in concatenation" error when
Sqitch is unable to determine the engine when writing a plan file. Only
happens in the rare case that the core.engine value is not set.
- Improved the error message when attempting to update a plan file and no
project pragma is present. Thanks to Laurentiu Diaconu for the report
(#577).
- Fixed the error message when attempting to deploy a change that has
already been deployed to display the name of the change, rather than a
memory address. Thanks to Neil Mayhew for the report (#579).
- Added destination locking, currently implemented for PostgresQL and
MySQL. On starting a deploy or revert, Sqitch attempts to "lock the
destination" using advisory locks, to ensure that only one instance of
Sqitch makes changes to the database at any one time. This complements
the existing locking, which applies as each change is deployed or
reverted, as that pattern led to failures when multiple instances of
Sqitch were working at once. Thanks to Neil Mayhew for the report
(#579).
- Added the --lock-timeout option to the deploy, revert, rebase, and
checkout commands, to allow for shorter or longer times to wait for an
exclusive target database advisory lock for engines that support it.
Defaults to 60 seconds.
- Fixed the behavior of the plan command's `--max-count` option when used
with `--reverse` to show the proper items. Thanks to Adrian Klaver for
the report (#517).
- Fixed an issue that could cause bugs with the `check` command on
Firebird, Exasol, Oracle, and Vertica. Broken since the `check` command
was added in v1.1.0.
1.1.0 2020-05-17T16:20:07Z
- Fixed Perl Pod errors, thanks to a pull request from Mohammad S Anwar
(#470).
- Fixed test failures when running with the localization set to German
or Italian. Thanks to Slaven Rezić for the report (#472).
- Fixed an issue when the full name of the current user is not set, so
that it properly falls back on the username. Thanks to Slaven Rezić and
Matthieu Foucault for the report and testing various fixes (#473).
- Eliminated an error when using the `-t` option to specify a target, due
to a missing dependency declaration in the Target class. Thanks to
Clinton Adams for the fix (#509)!
- Updated the IPC::System::Simple Win32 workaround added in 0.9999 to
properly support released versions of IPC::System::Simple. This fixes
errors running the database command-line clients on Windows (#503).
- Sqitch now only passes the `--password` option to the MySQL client if
it was not read from the `.my.cnf` file, as it's more secure to let
the client use `.my.cnf`, and it eliminates a warning from recent
versions of the client. Thanks to Kiel R Stirling for the fix (#485)!
- Added a note to the tutorials to skip setting the `engine.$engine.client`
config when using the Docker image.
- Added the new `check` command, which compares the SHA1 hashes of the
deploy scripts to the database, and reports if any have been modified
since they were deployed. Thanks to Matthieu Foucault for the pull
request and diligent work on this feature (#477)!
- Added the `--modified` option to the `rebase` and `revert` commands, to
revert to the earliest change with a modified deploy script. Handy for
rapid rebasing during iterative development cycles. Thanks to Matthieu
Foucault for this feature (#477)!
- Fixed an issue where the Snowflake engine would complain about not
finding the account name even for commands that don't need them, such
as `init`. Thanks to Stack Overflow user vbp13 for the report (#502).
1.0.0 2019-06-04T12:56:22Z
- Fixed test failure due to a hard-coded system error that may be
localized on non-en-US hosts. Thanks to Slaven Rezić for the catch
(#427).
- Now require Test::MockModule 0.17 to silence a warning during testing.
Thanks to Slaven Rezić for the suggestion.
- Fixed an error when Sqitch is run with no arguments. Thanks to Henrik
Tudborg for the report (#428).
- Fixed missing dependency on IO::Pager in the distribution metadata.
- Removed use of File::HomeDir, thanks to a PR from Karen Etheridge
(#433).
- Updated the tagline from "Sane database change management" to "Sensible
database change management" out of sensitivity to those subject to
mental illness (#435).
- Removed double-quoting of SQLite commands on Windows, inadvertently
added by the workaround for Windows quoting in v0.9999.
- Fixed a Snowflake issue where Sqitch failed to recognize the proper
error code for a missing table and therefore an uninitialized registry.
Thanks to @lerouxt and @kulmam92 for the report and fix (#439).
- Added check for project initialization when no engine config can be
found. When run from a directory with no configuration, Sqitch now
reports that the project is not initialized instead of complaining
about a lack of engine config (#437).
- Documented Snowflake key pair authentication in
`sqitch-authentication`, as well as `$SNOWSQL_PRIVATE_KEY_PASSPHRASE`
in `sqitch-environment`. Thanks to Casey Largent for figuring it out
(#441).
- Added the German localization. Thanks to Thomas Iguchi for the pull
request (#451).
- Renamed the French localization from "fr" to "fr_FR", so that systems
will actually find it.
- Added the `ask_yes_no()` method as a replacement for `ask_y_n()`, which
is now deprecated. The new method expects localized responses from the
user when translations are provided. Defaults to the English "yes" and
"no" when no translation is available. Suggested by German translator
Thomas Iguchi (#449).
- Fixed a bug where only project without a URI was allowed in the
registry. Thanks to Conding-Brunna for the report (#450).
- Clarified the role of project URIs for uniqueness: They don't allow
multiple projects with the same name, but do prevent the deployment of
a project with the same name but different URI.
- Fixed an issue where target variables could not be found when a target
name was not lowercase. Thanks to @maximejanssens for the report
(#454).
- Now require Config::GitLike 1.15 or higher.
- Fixed the indentation of variables emitted by the `show` actions of the
`target` and `engine` commands, fixing a "Negative repeat count does
nothing" warning in the process. Thanks to @maximejanssens for the
report (#454).
- Fixed a Snowflake test failure when the current system username has a
space or other character requiring URI escaping. Thanks to Ralph
Andrade for the report (#463).
- Fixed an issue where a wayward newline in some versions of SQLite
prevented Sqitch from parsing the version. Thanks to Kivanc Yazan
for the report (#465) and the fix (#465)!
- Fixed an error when Sqitch was run on a system without a valid
username, such as some Docker environments. Thanks to Ferdinand Salis
for the report (#459)!
- When Sqitch finds the registry does not exist on PostgreSQL, it now
sends a warning to the PostgreSQL log reporting that it will initialize
the database. This is to reduce confusion for folks watching the
PostgreSQL error log while Sqitch runs (#314).
0.9999 2019-02-01T15:29:40Z
[Bug Fixes]
- Fixed a test failure with the MySQL max limit value, mostly exhibited
on BSD platforms.
- Removed fallback in the PostgreSQL engine on the `$PGUSER` and
`$PGPASSWORD` environnement variables, as well as the system username,
since libpq does all that automatically, and collects data from other
sources that we did not (e.g., the password and connection service
files). Thanks to Tom Bloor for the report (issue #410).
- Changed dependency validation to prevent an error when a change required
from a different project has been reworked. Previously, when requiring a
change such as `foo:greeble`, Sqitch would raise an error if
`foo:greeble` was reworked, suggesting that the dependency be
tag-qualified to eliminate ambiguity. Now reworked dependencies may be
required without tag-qualification, though tag-qualification should still
be specified if functionality as of a particular tag is required.
- Added a workaround for the shell quoting issue on Windows. Applies to
IPC::System::Simple 1.29 and lower. See
[pjf/ipc-system-simple#29](https://github.com/pjf/ipc-system-simple/pull/29)
for details (#413).
- Fixed an issue with the MariaDB client where a deploy, revert, or
verify failure was not properly propagated to Sqitch. Sqitch now passes
`--abort-source-on-error` to the Maria `mysql` client to ensure that
SQL errors cause the client to abort with an error so that Sqitch can
properly handle it. Thanks to @mvgrimes for the original report and,
years later, the fix (#209).
- Fixed an issue with command argument parsing so that it truly never
returns a target without an engine specified, as documented.
- Removed documentation for methods that don't exist.
- Fixed test failures due to a change in Encode v2.99 that's stricter
about `undef` arguments that should be defined.
[Improvements]
- The Snowflake engine now consults the `connections.warehousename`,
`connections.dbname`, and `connections.rolename` variables in the
SnowSQL configuration file (`~/.snowsql/config`) before falling back on
the hard-coded warehouse name "sqitch" and using the system username as
the database name and no default for the role.
- Switched to using a constant internally to optimize windows-specific
code paths at compile time.
- When `deploy` detects undeployed dependencies, it now eliminates
duplicates before listing them in the error message.
- Now requiring IO::Pager v0.34 or later for its more consistent
interface.
- Added notes about creating databases to the tutorials. Thanks to Dave
Rolsky for the prompt (#315).
- Added a status message to tell the user when the registry is being
updated, rather than just show each individual update. Thanks to Ben
Hutton for the suggestion (#276).
- Added support for a `$SQITCH_TARGET` environment variable, which takes
precedence over all other target specifications except for command-line
options and arguments. Thanks to @mvgrimes for the suggestion (#203).
- Fixed target/engine/change argument parsing so it won't automatically
fail when `core.engine` isn't set unless no targets are found. This
lets engines be determined strictly from command-line arguments --
derived from targets, or just listed on their own -- whether or not
`core.engine` is set. This change eliminates the need for the
`no_default` parameter to the `parse_args()` method of App::Sqitch
Command. It also greatly reduces the need for the core `--engine`
option, which was previously required to work around this issue (see
below for its removal).
- Refactored config handling in tests to use a custom subclass of
App::Sqitch::Config instead of various mocks, temporary files, and the
like.
- Added advice to use the PL/pgSQL `ASSERT()` function for verify scripts
to the Postgres tutorial. Thanks to Sergii Tkachenko for the PR (#425).
[Target Variables]
- The `verify` command now reads `deploy.variables`, and individual
`verify.variables override `deploy.variables`, on the assumption that
the verify variables in general ought to be the same as the deploy
variables. This makes `verify` variable configuration consistent with
`revert` variable configuration.
- Variables set via the `--set-deploy` option on the `rebase` and
`checkout` commands no longer apply to both reverts and deploys, but
only deploys. Use the `--set` option to apply a variable to both
reverts and deploys.
- Added support for core, engine, and target variable configuration. The
simplest way to use them is via the `--set` option on the `init`,
`engine`, and `target` commands. These commands allow the configuration
of database client variables for specific engines and targets, as well
as defaults that apply to all change execution commands (`deploy`,
`revert`, `verify`, `rebase`, and `checkout`). The commands merge the
variables from each level in this priority order:
* `--set-deploy` and `--set-revert` options on `rebase` and `checkout`
* `--set` option
* `target.$target.variables`
* `engine.$engine.variables`
* `deploy.variables`, `revert.variables`, and `verify.variables`
* `core.variables`
See `sqitch-configuration` for general documentation of of the
hierarchy for merging variables and the documentation for each command
for specifics.
[Options Unification]
- Added the `--chdir`/`--cd`/`-C` option to specify a directory to change
to before executing any Sqitch commands. Thanks to Thomas Sibley for
the suggestion (#411).
- Added the `--no-pager` option to disable the pager (#414).
- Changed command-line parsing to allow core and command options to
appear anywhere on the line. Previously, core options had to come
before the command name, and command options after. No more. The caveat
is that command options that take arguments should either appear after
the command or use the `--opt=val` syntax instead of `--opt val`, so
that Sqitch doesn't think `val` is the command. Even in that case, it
will search the rest of the arguments to find a valid command.
However, to minimize this challenge, the documentation now suggests
and demonstrates putting all options after the command, like so:
`sqitch [command] [options]`.
- Simplified and clarified the distinction between core and command
options by removing all options from the core except those that affect
output and runtime context. The core options are:
* -C --chdir --cd
Change to directory before performing any actions
* --etc-path Print the path to the etc directory and exit
* --no-pager Do not pipe output into a pager
* --quiet Quiet mode with non-error output suppressed
* -V --verbose Increment verbosity
* --version Print the version number and exit
* --help Show a list of commands and exit
* --man Print the introductory documentation and exit
- Relatedly, single-letter core options will now always be uppercase,
while single-letter command options will be lowercase. As such, `-V`
has been added as an alias for `--version`, although `-v` remains for
now, undocumented. It may be removed in the future should a compelling
use for `-v` in a command be discovered.
- All other options have been moved to the commands they affect. Their
use should remain mostly unchanged now that command options are parsed
from anywhere on the command-line, although we recommend that all
options come after commands. The options were moved as follows:
* `--registry`, `--client`, `--db-name`, `--db-user`, `--db-host`, and
`--db-port` (and their aliases) have been moved to the `checkout`,
`deploy`, `log`, `rebase`, `revert`, `status`, `upgrade`, and
`verify` commands.
* `--plan-file` and `--top-dir` (deprecated; see below) have been moved
to the `add`, `bundle`, `checkout`, `deploy`, `rebase`, `revert`,
`rework`, `show`, `status`, `tag`, and `verify` commands. They were
already supported by the `init`, `engine`, and `target` commands
(where `--top-dir` is not deprecated).
- Because some command options conflicted with core options, a few
options have been removed altogether, including:
* The `--verbose` option on the `--engine` and `--target` commands has
been removed, but no visible change should be apparent, since those
commands now read the core `--verbose` option.
* The undocumented `--dir` alias for `--top-dir` has been removed, as
it conflicted with the option of the same name but different meaning
in the `init`, `engine`, and `target` commands.
* The `-d` alias for `--set-deploy` in the `rebase` and `checkout`
commands has been changed to `-e` so as not to conflict with the `-d`
alias for `--db-name`.
* Added tests for all commands to ensure none of their options conflict
with core options. Will help prevent conflicts in the future.
[Deprecations & Removals]
- Deprecated the `--top-dir` option in favor of `--chdir` with a warning
except when used for configuration in the `init`, `engine`, and
`target` commands.
- Removed the core `--deploy-dir`, `--revert-dir`, and `--verify-dir`
options, which have been deprecated and triggering warnings since
v0.9993 (August 2015). The `--dir` option to the `init`, `engine`, and
`target` commands remains the favored interface for specifying script
directories.
- Removed the deprecated core `--engine` option. The `init` command still
supports it, while other commands are able to parse the engine name as
an argument --- e.g., `sqitch deploy mysql` --- or implicitly as part
of a target, as in `sqitch revert db:pg:tryme`. When Sqitch is unable
to determine the engine for a command, the error message no longer
mentions `--engine` and instead suggests specifying the engine via the
target. This option never triggered an error, but demonstration of its
use has been limited to `init` examples.
- Removed support for reading the `core.$engine` configuration, which has
been deprecated with warnings in favor of `engine.$engine` since 0.997
(November 2014). The `sqitch engine update-config` action remains
available to update old configurations, but may be removed in the
future.
- Removed the `--deploy`, `--revert`, and `--verify` options on the `add`
command, as well as their `--no-*` variants. They have been deprecated
with warnings in favor of the `--with` and `--without` options since
v0.990 (January 2014).
- Removed the `--deploy-template`, `--revert-template`, and
`--verify-template` options to the `add` command. They have been
deprecated with warnings in favor of the `--use` option since v0.990
(January 2014).
- Removed the `add.deploy_template`, `add.revert_template`, and
`add.verify_template` configuration settings. They have been deprecated
with warnings in favor of the `add.templates` configuration section
since v0.990 (January 2014).
- Removed the `@FIRST` and `@LAST` symbolic tags, which have been
deprecated with warnings in favor of `@ROOT` and `@HEAD`, respectively,
since 0.997 (November 2014).
- Removed the command-specific options with the string "target" in them,
such as `--to-target`, `--upto-target`, which have been deprecated with
warnings in in favor of options containing the string "change", such as
`--to-change` and `--upto-change`, since v0.997 (November 2014).
- Remove the `engine` and `target` command `set-*` actions and their
corresponding methods, which have been deprecated in favor of the
`alter` action since v0.9993 (August 2015).
- Removed the automatic updating of change and tag IDs in the Postgres
engine. This functionality was added in v0.940 (December 2012), when
Postgres was the only engine, and the SHA-1 hash for change and tag IDs
was changed. There were very few deployments at the time, and all
should long since have been updated.
[API Changes]
- Added the URI-overriding parameters `user`, `host`, `port`, and
`dbname` to App::Sqitch::Target so that command options can be used to
easily set them.
- Added support for passing attribute parameters to the `all_targets`
group constructor on App::Sqitch::Target, so that command-line options
can be used to assign attributes to all targets read from the
configuration.
- Aded the `target_params` method to App::Sqitch::Command and updated all
commands to use it when constructing targets. This allows commands to
define options for Target parameters, as required for moving options to
commands as described above.
- Added the `class_for` method to App::Sqitch::Command so that the new
options parser described above can load a command class without
instantiating an instance. Useful for searching command-line arguments
for a command name.
- Added the `create` constructor to App::Sqitch::Command to let Sqitch
instantiate an instance of a command once it finds one via `class_for`.
Previously, Sqitch used the `load` method, which handled the
functionality of both `class_for` and `create`. That method still
exists but is used only in tests.
- Added the ConnectingCommand role to define database connection options
for the commands that need them.
- Added the ContextCommand role to define command options for the
location of the plan file and top directory. This is also where use of
the deprecated form of `--top-dir` triggers a warning.
- Removed the `verbosity` attribute from App::Sqitch::Command::engine and
App::Sqitch::Command::target, since the `--verbose` option is no longer
needed. These commands now rely on the core `--verbose` option.
- Removed the copying of core options from the target class and
TargetConfigCommand role, since the attributes fetched from there are
no longer core options, but provided as attribute parameters to the
constructors by commands.
- Removed documentation for the optional `config` parameter to the
`all_targets` constructor of App::Sqitch::Target, since it was never
used by Sqitch. It always fetched the config from the required `sqitch`
parameter. Support for the `config` parameter has not been removed,
since third-parties might use it.
- Removed the `set_*` methods in the `engine` and `target` commands,
which have been deprecated in favor of the new `alter` method since
v0.9993 (August 2015).
- Removed the `old_id` and `old_info` methods from Change and Tag, which
date from v0.940 (December 2012), and were provided only to allow
existing Postgres databases to be updated from the old to new ID
format, now removed. There should be no other use case for these
methods.
0.9998 2018-10-03T20:53:58Z
- Fixed an issue where Sqitch would sometimes truncate the registry
version number fetched from MySQL, most likely because the Perl runtime
was using 32-bit integers. Fixed by casting the version to CHAR in the
query, before Perl ever see it. Thanks to Allen Godfrey David for the
report.
- Added the Snowflake engine.
- Now require URI::db v0.19 for Snowflake URI support.
- The Vertica and Exasol engines now require DBD::ODBC 1.59, which fixes
a Unicode issue. Thanks to Martin J. Evans for the quick fix
(perl5-dbi/DBD-ODBC#8)!
- Added the `bundle` command to `./Build`. This command installs only the
runtime dependencies into the `--install_base` directory. This should
simplify building distribution packages, binary installs, Docker images,
and the like.
- Added the `--with` option to `./Build`, to require that Sqitch be build
with the specified engine. Pass once for each engine. See the README
for the list of supported engines.
- Added a check for Hash::Merge 0.298 during installation, since that
release has a fatal bug that breaks Sqitch. If it's installed, the
installer will issue a warning and added v0.299 to its list of
dependencies. Thanks to Slaven Rezić for the suggestion (#377).
- Fixed the PostgreSQL engine so it properly checks the `psql` client
version to determine whether or not the `:registry` variable is
supported. Previously it relied on the server version, which would fail
if the server version was greater than 8.4 but the `psql` client was
not. Thanks to multiple folks reporting issues with registry names and
search paths (#314).
- The plan parser will now complain if a change specifies a duplicate
dependency. This should be less confusing than a database unique
violation. Thanks to Eric Bréchemier for the suggestion (#344).
- Moved the project to its own GitHub organization,
[Sqitchers](https://github.com/sqitchers).
- Fixed likely cause of Oracle buffer allocation bug when selecting
timestamp strings. Thanks to @johannwilfling for the bug report and to
@nmaqsudov for the analysis and solution (#316).
- Changed the way the conninfo string is passed to `psql` to eliminate
argument ordering problems on Windows. Thanks to @highlowhighlow for
the report (#384).
- Added `$SQITCH_USERNAME` environment variable to complement
`$SQITCH_PASSWORD`. It can be used to override the username set in
for a target.
- Added the `$SQITCH_FULLNAME` and `$SQITCH_EMAIL` environment
variables, which take precedence over the values of the `user.name` and
`user.email` config variables.
- Added the `$SQITCH_ORIG_SYSUSER`, `$SQITCH_ORIG_FULLNAME` and
`$SQITCH_ORIG_EMAIL` environment variables. For those situations when
Sqitch attempts to read OS data for user information, These new
environment variables override these system-derived values. The
intention is to allow an originating host to set these values on
another host where Sqitch will actually execute.
- Fixed an error triggered by whitespace trailing an engine name in the
configuration. Thanks to Jeremy Simkins for the report (#400).
- Refactored the engine-specific username and password attributes to
support a consistent search for values. Sqitch searches first for one
of its own environment variables (`$SQITCH_USERNAME` and
`$SQITCH_PASSSWORD`), then the target URI, and finally any engine-
specific values, which might include additional environment variables,
configuration files, the system user, or none at all.
- Database engines that implicitly relied on username and/or password
environment variables or on the system username now explicitly rely on
them. These include the Firebird, MySQL, Postgres, and Vertical
engines. This change should exhibit no change in the behavior of these
engines.
- Added support for the `$MYSQL_HOST` and `$MYSQL_TCP_PORT` environment
variables to the MySQL engine.
- Documented all supported engine-specific environment variables in the
sqitch-environment guide.
- Renamed the sqitch-passwords guide to sqitch-authentication and added a
section on username specification.
- Updated all URLs to use the https scheme. Only exceptions are tt2.org,
which doesn't support TLS, and conferences.embarcadero.com, which
appears to be down.
0.9997 2018-03-15T21:13:52Z
- Fixed the Firebird engine to properly detect multiple instances of a
change specified to `revert` and `verify`, matching the behavior of
displaying tag-qualified alternates added to the other engines in
v0.9996.
- Fixed test failure on Windows.
- Updated the MySQL and PostgreSQL tests to use process-specific database
names, to try to avoid conflicts when tests are being run by multiple
processes on the same box, as happens with CPAN smoke testing boxes.
- Fixed an issue where Sqitch would sometimes truncate the registry
version number fetched from Postgres, most likely because the Perl
runtime was using 32-bit integers. Fixed by casting the version to text
in the query, before Perl ever see it. Thanks to Malte Legenhausen for
the report (#343).
- The MySQL engine will now read the username from MySQL configuration
files. Thanks to Eliot Alter for the bug report (#353).
- Added Italian translation, with thanks to Luca Ferrari and @BeaData!
- Improved multi-value config examples in the `sqitch-config`
documentation to be a bit less confusing. Thanks to Emil for reporting
where he got confused!
- Added the Exasol engine. Thanks to Johan Wärlander for the PR (#362)!
- Fixed an issue where URI::db needed to be explicitly loaded. Thanks to
Hugh Esco for the report (#370)!
- Changed the exit value for `rebase` and `revert` from 1 to 0 when there
is no work to do. This is to match the expectation of non-zero exit
statuses only when a command is unsuccessful, as well as the behavior
of `deploy` as of v0.995. Nothing to do is considered successful.
Thanks to Paul Williams for the PR (#374)!
- Update `psql` options to use a conninfo string to honor connection
parameter key words for PostgreSQL targets. It can now take advantage
of the connection service file using `db:pg:///?service=$PGSERVICE` as
well as other connection parameters. Thanks to Paul Williams for the PR
(#375)!
0.9996 2017-07-17T18:33:12Z
- Fixed an error where Oracle sometimes truncated timestamp formats so
that date parsing failed. Thanks to Johann Wilfling for the report and
@nmaqsudov for the solution (#316).
- Added pager configuration, prioritizing the new `core.pager`
configuration variable over the `$PAGER` environment variable. The new
`$SQITCH_PAGER` environment variable trumps all. Thanks to Yati Sagade
for the pull request (#329).
- Documented the `core.editor` configuration variable.
- Updated PostgreSQL registry detection to avoid errors when not running
Sqitch as a superuser and the registry schema already exists. Done by
looking for the `changes` table in the `pg_tables` view instead of
looking for the registry schema in the `pg_namespace` catalog table,
and by using `CREATE SCHEMA IF NOT EXISTS` on PostgreSQL 9.3 and
higher. Thanks to @djk447 for the pull request (#307).
- Updated PostgreSQL registry detection to avoid errors when the `psql`
client is newer than the server version. Sqitch now fetches the version
from the server instead of parsing it from the client.
- Removed `no Moo::sification`, to allow modules to be used by Moose
applications. Replaced with tests to make sure Sqitch itself never uses
Moose. Thanks to @perigrin for the PR (#332).
- Specifying a change before a target name on the command-line no longer
ignores the target (#281).
- The `--db-*` options are now more consistently applied to a target,
including when the target is specified as a URI (#293).
- `HEAD` and `ROOT` are now properly recognized as aliases for `@HEAD`
and `@ROOT`, when querying the database. This was supposedly done in
v0.991, but due to a bug, it wasn't really. Sorry about that.
- The `revert` and `verify` commands will now fail if a change is
specified and matches multiple changes. This happens when referencing a
reworked change only by its name. In this case, Sqitch will emit an
error listing properly tag-qualified changes to use. Suggested by Jay
Hannah (#312).
- Sqitch no longer returns an error when a target name is passed to a
command and the default target's plan file does not exist (#324).
- Added missing options to the `rework` usage statement. Thanks to Jay
Hannah for the PR (#342).
- Passing an engine name or plan file as the `` parameter to
the `log`, `status`, and `upgrade` commands now works correctly,
matching what the documentation has said for some time (#324).
- Added the `--target` option to the `plan` and `show` commands.
- Added the `` parameter to the `plan` command.
- Sqitch now loads targets from all config files, not just the local
file, when trying to determine if a `` parameter is a plan
file name.
- Improved the error message when a change is found more than once in a
plan, typically a reworked changed referenced only by name. The error
will no longer be "Key at multiple indexes", but "Change is ambiguous.
Please specify a tag-qualified change:", followed by a list of
tag-qualified variants of the change.
- Fixed a bug where the verify command would return a database error when
it finds no registry. Now it reports that the registry wasn't found in
the database.
0.9995 2016-07-27T09:23:55Z
- Taught the `add` command not to ignore the `--change` option.
- The `add` command now emits a usage statement when no change name is
passed to it.
- The `add` command now helpfully suggests using the --change option when
attempting to add a change with the same name as a target. Thanks to
Ivan Nunes for the report!
- The `tag` command now helpfully suggests using the --tag option when
attempting to add a tag with the same name as a target.
- Added `--global` as an alias for `--user` to the `config` command. This
alias benefits the muscle memory of Git users.
- Added a note for Git users to the `sqitch-revert` documentation, to
head off potential confusion with `git revert`. Thanks to Eric
Bréchemier for the "time travel" analogy and wording.
- Fixed an "uninitialized value" error when creating a registry database
on Windows. Thanks to Steven C. Buttgereit for the report (Issue #289).
- Fixed editor selection to prioritize the `core.editor` configuration
variable over the `$EDITOR` environment variable. The `$SQITCH_EDITOR`
environment variable still trumps all. Thanks to Jim Nasby for the pull
request (#296).
- Added detection of the `$VISUAL` environment variable to Editor
selection, prioritized after the `core.editor` configuration variable
and before the `$EDITOR` environment variable. Thanks to Jim Nasby for
the pull request (#296).
- Updated the DateTime code to set the locale via `set_locale()` instead
of `set()`, as the latter may actually change the local time
unintentionally, and has been deprecated since DateTime v1.04. Thanks
to Dave Rolsky for the pull request (#304).
0.9994 2016-01-08T19:46:43Z
- Reduced minimum required MySQL engine from 5.1.0 to 5.0.0. Thanks to
@dgc-wh for testing it (Issue #251).
- Fixed floating-point rounding issue with SQLite registry versions on
Perls with 16-byte doubles. Thanks to H. Merijn Brand for the report
and testing.
- Fixed an error when adding an engine with the `engine` command. Thanks
to Victor Mours for the report and fix!
- Updated the Oracle engine to support Oracle Wallet connection strings,
where no username or host is in the connection URI. Thanks to Timothy
Procter for the patch!
- Improved the installer's selection of the prefix in which to install
`etc` files to better match the `--installdirs` option, which defaults
to the "site" directories. Thanks to @carragom for the pull request
(#265).
- Added missing dash to `-engine` in sample calls to `sqitch init` in the
tutorials. Thanks to Andrew Dunstan for the spot (Issue #268).
- Fixed broken Vertica documentation links.
- Attempting to revert a database with no associated registry no longer
reports the registry as version 0, but correctly reports that no
registry can be found. Thanks to Arnaldo Piccinelli for the spot (Issue
#271).
- Fixed the search for change IDs in engines to match the search for
changes. Specifically, change ID search now properly handles the
offset characters `~` and `^`. This bug mainly affected the `verify`
command, but it's good to address the inconsistency, done mainly by
adding the `find_change_id` and `change_id_offset_from_id` methods to
complement the `find_change` and `change_offset_from_id` methods.
Thanks to Andrew Dunstan for the spot (Issue #272).
- Fixed the `flips` table example in the MySQL tutorial. It was
inappropriately copied from the PostgreSQL tutorial at some point.
Thanks to Jeff Carpenter for the spot (Issue #254)!
0.9993 2015-08-17T17:55:26Z
[Bug Fixes]
- Eliminated test failures due to warnings from DateTime::Locale when
`LC_TIME` is set to C.UTF-8. Thanks to Shantanu Bhadoria for the report
and Dave Rolsky for the workaround.
- Fixed an error checking the registry version when the local uses a
comma for decimal values. Thanks to Steffen Müller for the report
(Issue #234).
- Worked around an error setting the MySQL storage engine using versions
of DBI prior to 1.631. Thanks to melon-babak for the report!
- Fixed an error from the Oracle engine when deploying more than 1000
changes. Thanks to Timothy Procter and Minh Hoang for the report and
testing the fix.
- Fixed a bunch of typos in error messages, comments, and documentation.
Thanks to Dmitriy for the pull request!
- Fixed test failures due to new warnings from File::Path on Perl
5.23.1.
- On Firebird, Looking up a change and tag in the database (via the
`--onto` option to `rebase` or the `--to` option to `revert`, among
others) would sometimes return the incorrect change if the change has
been reworked two or more times. Was fixed for the other engines in
v0.9991.
- Fixed the `--all` option used to apply a command to all known targets
so that it loads only targets specified by the local configuration.
Otherwise, user and system configuration can get in the way when they
specify engines and targets not used by the current project.
[Improvements]
- Added support for the `--set` option when deploying to MySQL. Thanks to
Chris Bandy for figuring out how to do it!
- Added support for a "reworked directory". By default, reworked change
scripts live in the deploy, revert, and verify directories along with
all the other change scripts. But if that starts to get too messy, or
you simply don't want to see them, add a `reworked_dir` setting to the
core, engine, or target config and reworked scripts will be stored
there, instead. Also supported are `reworked_deploy_dir`,
`reworked_revert_dir`, and `reworked_verify_dir`.
- Added the `--dir` option to the `init`, `engine`, and `target`
commands.
- Copied the core configuration options (`--engine`, `--target`,
`--plan-file`, `--registry`, etc.) to the `init`, `engine`, and
`target` commands. This means that they can be specified after the
command, which is a bit more natural. It also means that the
`--registry` and `--client` options of the `target` are no longer
deprecated.
- The `init` command no longer writes out commented values for the
`deploy_dir`, `revert_dir`, or `verify_dir` settings. I think these
settings are not commonly used, and it would start to get crowded if we
also added their "reworked" variants, which will be used still less.
- Added the `alter` action to the `engine` and `target` commands to set
engine and target properties.
- Added support for setting reworked directories to the `engine` and
`target` commands.
- Reformatted the output of the `engine` and `target` command `show`
actions to include reworked directories, and to bit a bit less flat.
- Attempting to add or alter an engine with a target URI that connects to
a different engine now triggers an error. For example, you can't set
the target for engine `pg` to `db:sqlite:`.
- The `add` and `alter` actions of the `engine` and `target` commands
now create script directories if they don't already exist.
- The `add` action of the `engine` and `target` commands now creates a
plan file if one does not exist in the specified location for the
engine or target.
- Added the `deploy_dir`, `revert_dir`, and `verify_dir` methods to
App::Sqitch::Plan::Change. Each points to the proper directory for the
target depending on whether or not the change has been reworked.
- In the MySQL engine, the following URI query params will be converted
to options passed to the command-line client, if they're present:
* mysql_compression=1 => --compress
* mysql_ssl=1 => --ssl
* mysql_connect_timeout => --connect_timeout
* mysql_init_command => --init-command
* mysql_socket => --socket
* mysql_ssl_client_key => --ssl-key
* mysql_ssl_client_cert => --ssl-cert
* mysql_ssl_ca_file => --ssl-ca
* mysql_ssl_ca_path => --ssl-capath
* mysql_ssl_cipher => --ssl-cipher
[Documentation]
- Added the "Overworked" section to sqitch-configuration guide with an
example of how to move reworked change scripts into a `reworked_dir`.
[Deprecations]
- Deprecated the `set-*` actions in the `engine` and `target` commands in
favor of the new `alter` action.
- The core `--deployed-dir`, `--revert-dir`, and `--verify-dir` options
are deprecated in favor of the `--dir` option on the `init`, `engine`,
and `target` command.
0.9992 2015-05-20T23:51:41Z
- On PostgreSQL, Sqitch now sets the `client_encoding` parameter to
`UTF8` for its own connection to the database. This ensures that data
sent to and from the database should always be properly encoded and
decoded. Users should still set the proper encodings for change scripts
as appropriate.
- Fixed test failures due to path differences on Windows.
- DateTime::TimeZone is now explicitly required in an attempt to head off
"Cannot determine local time zone" errors.
- Corrected some typos and thinkos in `sqitchtutorial-oracle`, thanks to
George Hartzell.
- Improved the script to upgrade an Oracle registry to v1.0 to support
versions prior to Oracle 12, thanks to Timothy Procter.
- Added missing closing parenthesis to the "Nothing to deploy" message.
Thanks to George Hartzell for the pull request (Issue #226).
- Replaced the unique constraint on the `script_hash` column in the
`changes` registry table with a unique constraint on `project` and
`script_hash`. This is to allow a deploy script to be used in more than
one project in a single database. This change increments the registry
version to v1.1. Thanks to Timothy Procter for the report.
- Updated the registry check constraints to have consistent names on the
engines that support them. This will make it easier to modify the
constraints in the future.
- Fixed precision issues with the registry version on MySQL and Firebird.
- Added comment to sqitch-passwords guide that MySQL::Config is required
to read passwords from the MySQL configuration files. Thanks to
Sterling Hanenkamp for the patch!
0.9991 2015-04-03T23:14:39Z
[Improvements]
- Reduced minimum required MySQL engine from 5.6.4 to 5.1.0. Versions
prior to 5.6.4 lose the following features:
* Versions earlier than 5.6.4 is fractional second precision on
registry `DATETIME` columns. Since the ordering of those timestamps
is so important to the functioning of Sqitch, it will sleep in 100 ms
increments between logging changes to the registry until the time has
ticked over to the next second. Naturally, reverts and deploys will
be a little slower on versions of MySQL before 5.6.4, but accurate.
* Versions earlier than 5.5.0 lose the `checkit()` functions, which
would otherwise be used to emulate CHECK constraints in the registry,
as well as in user-created verify scripts, as recommended in the
MySQL tutorial, `sqitchtutorial-mysql`.
- Added a script to update the `DATETIME` columns in a MySQL Sqitch
registry that was upgraded to MySQL 5.6.4 or higher. It will be
installed as `tools/upgrade-registry-to-mysql-5.6.4.sql` in the
directory returned by `sqitch --etc`.
- Added a script to add the `checkit()` function and registry triggers to
emulate CHECK constraints to a MySQL Sqitch registry that was upgraded
to MySQL 5.5.0 or higher. It will be installed as
`tools/upgrade-registry-to-mysql-5.5.0.sql` in the directory returned
by `sqitch --etc`.
- The `init` command now throws an error when the plan file already
exists and is invalid or defined for a different project. Thanks to
Gabriel Potkány for the suggestion (Issue #214).
- All commands that take target arguments can now specify them as engine
names or plan file paths as well as target names and URIs.
- Added the `--all` option and the `$command.all` configuration variable
to the `add`, `rework`, `tag`, and `bundle` commands. This option tells
the commands to do their thing for all plans known from the
configuration, not just the default plan.
- Pass engine, target, or plan file names to the `add`, `rework`, `tag`,
and `bundle` commands` commands to specify specify one or more targets,
engines, and plans to act on.
- Added the `--change` option to the `add`, `rework`, and `tag` commands
to distinguish the change to be added, reworked, or tagged from
plan-specifying arguments, if necessary.
- Added the `--tag` option to the `tag` command to distinguish the tag to
be added from plan-specifying arguments, if necessary.
- Changed the short variant of the `--conflicts` option to the `add` and
`rework` commands from `-c` to `-x`. The `-c` option is now used as the
short variant for `--change` (and `--conflicts` has almost certainly
never been used, anyway).
- Added the `engine` and `project` variables to the execution of script
templates by the `add` command. The default templates now use it to
make their first lines one of:
* -- Deploy [% project %]:[% change %] to [% engine]
* -- Revert [% project %]:[% change %] from [% engine]
* -- Verify [% project %]:[% change %] on [% engine]
[Bug Fixes]
- DateTime::TimeZone::Local::Win32 is now required on Windows.
- The MySQL engine no longer passes `--skip-pager` on Windows, since
it is not supported there. Thanks to Gabriel Potkány for the report
(Issue #213).
- Fixed "no such table: changes" error when upgrading the SQLite
registry.
- Fixed upgrade failure on PostgreSQL 8.4. Thanks to Phillip Smith for
the report!
- Fixed an error when the `status` command `show_changes` and `show_tags`
configuration variables were set. Thanks to Adrian Klaver for the
report (Issue #219).
- Fixed `log` and `plan` usage statements to properly spell `--abbrev`.
Thanks to Adrian Klaver for the report (Issue #220).
- Fixed the formatting of change notes so that a space precedes the `#`
character whether the note was added by the `--note` option or via an
editor.
- Fixed a bug when parsing plan files with DOS/Windows line endings.
Thanks to Timothy Procter for the report (Issue #212).
- Looking up a change and tag in the database (via the `--onto` option to
`rebase` or the `--to` option to `revert`, among others) would
sometimes return the incorrect change if the change has been reworked
two or more times. Thanks to BryLo for the report!
[Documentation]
- Updated docs to be consistent in referring to the location of the system
configuration and template location as `$(prefix)/etc/sqitch`. Also
added notes pointing to the `--etc-dir` to find out exactly what that
resolves to. Suggested by Joseph Anthony Pasquale Holsten (Issue #167).
[Deprecations]
- Reverted deprecation of the database connection options. Target URIs
are still generally preferred, but sometimes you want to use a target
but just change the user name or database name. Retaining the options
is the easiest way to do this. Plus, a fair number of people have
scripts that use these options, and it seems petty to break them. Sorry
for the double-take here! The list of un-deprecated options is:
* `--db-client`
* `--db-host`
* `--db-port`
* `--db-username`
* `--db-password`
* `--db-name`
0.999 2015-02-12T19:43:45Z
- Improved MySQL missing table error detection by relying on error codes
instead of matching a (possibly localized) error string.
- Made the registry upgrade more transparent when deploying. Sqitch is
now is a little more vigilant in checking for things being out-of-date
and updating them.
- Fixed an issue where the `status` command would return an error when
run against a an older version of the registry.
- Fixed a Postgres test failure when DBD::Pg is installed but psql is not
in the path.
- Now require Config::GitLike 1.15 to build on Windows in order to avoid
test failures when Cwd::abs_path dies on non-existent paths.
- Clarified the behavior of each `deploy` reversion mode with regard to
deploy script vs. verify script failures, and with the expectation that
deploy scripts are atomic.
- Target passwords can now be set via a single environment variable,
`$SQITCH_PASSWORD`. Its value will override URI-specified password.
- Added the sqitch-passwords and sqitch-environment guides.
0.998 2015-01-15T22:17:44Z
- Fixed a bug in `sqitch engine update-config` where it would add data to
config files that did not previously have them, or report that data was
present in nonexistent config files.
- Added the `releases` table to the databases. This table will keep track
of releases of the Sqitch registry schema.
- The Oracle `registry` variable is now always `DEFINE`d when Oracle
scripts run.
- Added the `upgrade` command, which upgrades the schema for the Sqitch
registry for a target database.
- Added the `script_hash` column to the `changes` registry table. This
column contains a SHA-1 hash of the deploy script for the change at the
time it was deployed. For existing registries, the upgrade script sets
its value to be the same as the change ID. This value is update the
next time a project is deployed to the database.
- The error message when `deploy` cannot find the currently-deployed
change ID in the plan now includes more contextual information,
including the change name, associated tags, and the plan file name.
Suggested by Curtis Poe (Issue #205).
- Comments on Firebird registry objects are now created with the
`COMMENT` command, rather than INSERTs into catalog tables.
- Added support for "merge" events, though none are logged, yet.
0.997 2014-11-04T22:52:23Z
[New Features]
- Added support for new target properties. In addition to the existing
`uri`, `client`, and `registry` properties, targets may also configure
these properties via the new `--set` option to and `set-*` actions on
the `target` command:
* `top_dir`
* `plan_file`
* `extension`
* `deploy_dir`
* `revert_dir`
* `verify_dir`
- Added support for new engine configuration variables. In addition to
the existing `target`, `client`, and `registry` variables, engine
configuration may also include these variables:
* `top_dir`
* `plan_file`
* `extension`
* `deploy_dir`
* `revert_dir`
* `verify_dir`
- Rationalized the hierarchical configuration of deployment targets. The
properties of any given target will now be determined by examining
values in the following order:
* Command-line options
* Target configuration
* Engine configuration
* Core configuration
* Reasonable engine-specific defaults
- Added the `engine` command to simplify engine configuration. This
complements the newly-improved `target` command. Run `sqitch engine
update-config` to update deprecated engine configurations and start
using it.
- Added the sqitch-configuration guide to provide an overview of core,
engine, and target configuration. Includes some use-case examples and
best suggested practices.
[Improvements]
- Simplified the output of `sqitch help`, and added the more important
options to it.
- Added the `--guide` option to `sqitch help` to list Sqitch guides.
- Renamed the `--db-client` option to `--client`. `--db-client` still
works, but is deprecated.
- Added the `--registry` core option for parity with `--client`,
`--top-dir`, `--plan-file`, and the rest of the hierarchical
configuration properties.
- Updated the `init` documentation to better cover all the options
processed.
- Incremented the version plan file format version to v1.0.0. No changes;
it has been stable for at least a year, so it's time.
[Bug Fixes]
- At runtime, the Vertica engine now properly requires DBD::ODBC
instead of DBD::Pg.
- The Vertica engine now supports Vertica 6, as documented.
- Fixed a warning from Type::Utils, thanks to a report from Géraud
CONTINSOUZAS.
- The `status` command once again notices if the specified database is
uninitialized and says as much, rather than dying with an SQL error.
- The `--etc-path` option works again.
[Deprecations]
- Deprecated `core.$engine` configuration in favor of `engine.$engine`. A
warning will be emitted if Sqitch sees the former. Run `sqitch engine
update-config` to update your configurations. Existing `core.$engine`
configurations will be left in place for compatibility with older
versions of Sqitch, but the `sqitch engine` command will not modify
them, so they can get out-of-sync. Run `sqitch config --remove-section
core.$engine` to remove them.
- Formally deprecated the database connection options in favor of target
URIs. If any of these options is used, a warning will be issued. They
will be dropped in v1.0:
* `--db-host`
* `--db-port`
* `--db-username`
* `--db-password`
* `--db-name`
- Formally deprecated the database connection configuration variables in
favor of target URIs. If any of these variables is used, a warning will
be issued. Run `sqitch engine update-config` to update your
configurations. Existing `core.$engine` configurations will be left in
place for compatibility with older versions of Sqitch, but the `sqitch
engine` command will not modify them, so they can get out-of-sync. Run
`sqitch config --remove-section core.$engine` to remove them. Sqitch
will cease to support them in v1.0:
* `core.$engine.host`
* `core.$engine.port`
* `core.$engine.username`
* `core.$engine.password`
* `core.$engine.db_name`
- Deprecated the `--registry` and `--client` options of the `target`
command. All target properties should now be set via the new `--set`
option, such as `--set registry=reg`.
- Formally deprecated the following options of the `add` command. They
have been replaced with the `--with`, `--without`, and `--use` options
since v0.991. Their use will emit a warning, and they will be removed
in v1.0:
* `--deploy-template`
* `--revert-template`
* `--verify-template`
* `--deploy`
* `--no-deploy`
* `--revert`
* `--no-revert`
* `--verify`
* `--no-verify`
- Dropped support for the long-deprecated (and likely never used outside
ancient tests long deleted) engine configuration variables
`core.sqlite.sqitch_db` and `core.pg.sqitch_schema`. Both have been
replaced with `engine.$engine.registry`, which applies to all engines.
- Formally deprecated the `@FIRST` and `@LAST` symbolic tags. Their use
will trigger a warning to use `@ROOT` and `@HEAD`, instead. They will
be removed in v1.0.
[Internals]
- Moved target and engine configuration from App::Sqitch and
App::Sqitch::Engine to a new class, App::Sqitch::Target. This class is
solely responsible for finding the appropriate values for attributes on
every run. The target knows what plan and engine to use, based on those
properties. App::Sqitch is now responsible solely for encapsulating
command-line options, configuration, and utilities. Classes are now
responsible for instantiating both an App::Sqitch and
App::Sqitch::Target options as appropriate.
- Updated all classes to create both Sqitch and Target objects as
appropriate. This change touched almost every class.
- Replaced attributes in App::Sqitch that were previously set from
command-line options or configuration with a single attribute,
`options`, which is a hash only of the command-line options. Classes
are now responsible for finding the proper values in config or options.
Mostly this requirement is encapsulated by the new App::Sqitch::Target
class.
- Updated the command classes to use either a "default target" derived
from command-line options, engine configuration, and core
configuration, or a target looked up by name in the configuration
maintained by the `target` command.
0.996 2014-09-05T21:11:00Z
- Fixed one more test failure due to the introduction of "Negative repeat
count does nothing" warning in Perl 5.21.1.
- Fixed "Redundant argument in printf" warning on Perl 5.21.2.
- Switched from Digest::SHA1, which is deprecated, to Digest::SHA for
generating SHA-1 IDs.
- Switched from Mouse and Moose to Moo. Sqitch no longer depends on any
modules that use Moose, either. This results in an approximately 40%
startup time speedup.
- Loading of App::Sqitch::DateTime is now deferred until it's needed.
This is because DateTime is rather expensive to load. Since a number of
commands don't need it, it seems silly to load it in those cases.
- Now recommend Type::Tiny::XS and Class::XSAccessor for improved
performance.
- The `check` command now properly fails on a plan parse error, instead
of blindly continuing on.
- Fixed a failing test on PostgreSQL due to localization issues. Thanks
to Sven Schoberf for the report (Issue #171).
- Added the `revert.prompt_accept`, `rebase.prompt_accept`, and
`checkout.prompt_accept` boolean configuration variables. Set these
variables to false to change the default answer to the revert prompt to
"No". When rebasing or checking out, if the variables specific to those
commands are not set, Sqitch will fall back on the value of
`revert.prompt_accept`. Suggested by Graeme Lawton (Issue #164).
- The MySQL engine now sets the `$MYSQL_PWD` environment variable if a
password is provided in a target. This should simplify authentication
when running MySQL change scripts through the `mysql` client client
(Issue #150).
- The MySQL engine now reads `client` and `mysql` groups in the MySQL
configuration files for a password when connecting to the registry
database, and when the target URI includes no password. The MySQL
client already read those files, of course, but now the internal
database connection does as well (Issue #150).
- The Firebird engine now sets the `$ISC_PASSWORD` environment variable
if a password is provided in a target. This should simplify
authentication when running Firebird change scripts through the `isql`
client client. Patch from Ștefan Suciu.
- No longer passing URI query params as DBI params, because they are
already included in the DSN provided by URI::db.
- Added the Vertica engine.
0.995 2014-07-13T22:24:53Z
- Fixed test failures due to the introduction of "Negative repeat count
does nothing" warning in Perl 5.21.1.
- Fixed more test failures when DBD::Firebird is installed but Firebird
isql cannot be found.
- Fixed registry file naming issues on Win32 for the SQLite engine, and
as well as the tests that failed because of it.
- Worked around Config::GitLike bug on Windows in the target test.
- Changed the exit value for an attempt to deploy to an up-to-date
database from 1 to 0. In other words, it no longer looks like an error
(Issue #147).
0.994 2014-06-20T02:58:10Z
- Fixed installation failure due to missing IO::File module on Windows.
- Fixed file test failure for the Oracle engine on Windows.
- Fixed bug where namespace-autoclean: 0.16 caused errors such as
"Invalid object instance: 'yellow'".
- Fixed Oracle SQL*Plus capture test failure on Windows.
0.993 2014-06-04T20:14:34Z
- Fixed engine loading to prefer the engine implied by the target URI
over the `core.engine` configuration variable. This means that you no
longer have to pass `--engine` when using commands that accept a target
option or argument, such as `deploy`.
- Fixed test failure when DBD::Firebird is installed but Firebird isql
cannot be found.
- Fixed issue where the revert command fails to execute the proper revert
script. This can occur when a change has been reworked in the plan, but
the reworked version of the change has not been deployed to the
database. Thanks to Timothy Procter for the report (Issue #166).
- Fixed issue with aggregating text values with `COLLECT()` on Oracle.
Thanks to Timothy Procter for the digging and invocation of an Oracle
support request (Issue #91).
- Fixed issue where SQL*Plus could not run rework scripts because of the
`@` in the file name. It now uses a symlink (or copied file on Windows)
to circumvent the problem. Thanks to Timothy Procter for the report
(Issue #165).
- Fix issue where, on first deploy, the MySQL engine would fail to notice
that the server was not the right version of MySQL. Thanks to Luke
Young for the report (Issue #158).
- Made the `checkit()` MySQL function DETERMINISTIC, to improve
compatibility with MariaDB. Thanks to Jesse Luehrs for the report
(Issue #158).
- Fixed deployment to PostgreSQL 8.4 so that it no longer chokes on the
`:tableopts`. Thanks to Justin Hawkins for the report!
0.992 2014-03-05T00:34:49Z
- Fixed target test failures on Windows.
- Added support for Postgres-XC to the PostgreSQL engine. Sqitch registry
tables are distributed by replication to all data nodes.
- Added support to MariaDB 5.3 and higher to the MySQL engine, thanks to
Ed Silva.
0.991 2014-01-16T23:24:33Z
- Greatly simplified determining the Firebird ISQL client. It no longer
tries so hard to find a full path, but does search through the path list
for a likely candidate between fbsql, isql-fb, and isql (or equivalents
ending in .exe on Windows).
- Removed a bunch of inappropriately pasted stuff from the Firebird
tutorial, and updated it a bit.
- `HEAD` and `ROOT` are now recognized as aliases for `@HEAD` and
`@ROOT`, when querying the database, too. That means that `revert --to
HEAD` now works the same as `revert --to @HEAD`, as had been expected
in v0.990.
- Eliminated "use of uninitialized value" warnings when database
connections fail.
- Reduced the minimum required DBD::Firebird to v1.11.
- Fixed the `--verbose` option to the `target` command.
- Eliminated more user-configuration issues in tests, thanks to
chromatic.
- Fixed test failures when the `$PGPASSWORD` environment variable is set,
thanks to Ioan Rogers's test smoker.
0.990 2014-01-04T01:14:24Z
[New Features]
- Added new command and feature: `target`. Use it to manage multiple
database targets, each with an associated URI and, optionally, a
registry name and command-line client. Inspired by Git remotes.
- Added Firebird engine. Three cheers to Ștefan Suciu for this
contribution!
- Added support for the generation of arbitrary scripts from templates to
the `add` command. Just add template files to subdirectories of the
`templates` directory, and scripts will be created in a directory of
the same name based on those templates.
- Added `--open-editor` option (and aliases) to the `add` and `rework`
commands. This option will open the newly-added change scripts in the
preferred editor. Thanks to Thomas Sibley for the patch!
[Improvements]
- Improved database driver loading to ensure the proper version of the
driver is required.
- Non-fatal but possibly unexpected messages -- which correspond to exit
value 1 -- now send their messages to STDOUT instead of STDERR, and
respect the `--quiet` option. Thanks to @giorgio-v for the report!
- Added or replaced the `--target` option to commands that connect to a
database to specify the name of target managed by the new `target`
command or a database URI.
- `HEAD` and `ROOT` are now recognized as aliases for `@HEAD` and
`@ROOT`, respectively, since they are disallowed as change names,
anyway, and folks often use them out of habit from Git.
[Internals]
- Replaced the engine-specific connection attributes with three
attributes use by every engine:
* `target`: The name of a target managed by the new `target` command.
Defaults to a value stored for the `core.$engine.target`
configuration variable. If that variable does not exist, the target
falls back on the stringification of `uri`.
* `uri`: a database URI with the format `db:{engine}:{dbname}` or
`db:{engine}://{user}:{password}@{host}:{port}/{dbname}`. If its
value is not passed to the constructor, a `uri` value is looked up
for the associated `target`. If `target` is not passed or configured,
or if it has no URI associated with it, the `config.$engine.uri`
configuration variable is used. If that value does not exist, the URI
defaults to `db:$engine:`. In any of these cases, if any of the
`--db-*` options are passed, they will be merged into the URI.
* `registry`: the name to use for the Sqitch registry schema or
database, where Sqitch's own data will be stored, as appropriate to
each engine. If its value is not passed to the constructor, a
`registry` value is looked up for the associated `target`. If
`target` is not passed or configured, or if it has no registry
associated with it, the `config.$engine.registry` configuration
variable is used. If no value is found there, it defaults to an
engine-specific value, usually "sqitch".
[Bug Fixes]
- Fixed a bug when installing under local::lib. Thanks to Thomas Sibley
for the pull request!
- Eliminated "Wide character in print" warnings when piping the `log`
command.
- Documented that reworked changes do not have their verify tests run by
the `verify` command. They do run when using the `--verify` deploy
option.
- Removed the documentation for the `add.with_deploy`, `add.with_revert`,
and `add.with_verify` configuration variables, which were never
implemented.
[Deprecations]
- Deprecated engine-specific connection attributes and configuration
variables. See the "Internals" section for their replacements. The
deprecated options are:
* `core.$engine.username`
* `core.$engine.password`
* `core.$engine.db_name`
* `core.$engine.host`
* `core.$engine.port`
* `core.$engine.sqitch_schema`
* `core.$engine.sqitch_db`
- Deprecated all command-specific options with the string "target" in
them, such as `--to-target`, `--upto-target`, etc. They have been
replaced with options containing the string "change", instead, such as
`--to-change` and `--upto-change`. Few people used these options,
preferring their shorter aliases (`--to`, `--upto`, etc.).
- Deprecated the `--deploy-template`, `--revert-template`, and
`--verify-template` options to the `add` command. They are replaced
with a single option, `--use` which takes a key/value pair for the
script name and template path. This makes it useful for arbitrary
script generation, as well.
- Deprecated the `--deploy`, `--revert`, and `--verify` options to the
`add` command, as well as their `--no-*` variants. They are replaced
with two new options, `--with` and `--without`, to which a script name
is passed. These are useful for arbitrary script generation, as well.
- Deprecated the `add.deploy_template`, `add.revert_template`, and
`add.verify_template` configuration settings. They have been replaced
with a section, `add.templates`, which is more general, and supports
arbitrary script generation, as well.
[Incompatibilities]
- Removed the undocumented `--test` option to the `add` command.
- Changed the meaning of `--target` from specifying a change to
specifying a deployment target. Use the new `--change` option to
specify a change.
0.983 2013-11-21T21:50:12Z
- Fixed "Use of uninitialized value" in the MySQL engine. Thanks to
Jean-Michel REY for the report.
- All tests now protect against failures due to the presence of the
`$SQITCH_CONFIG` environment variable (issue #114).
- The installer now respects the `distdir` option to `Build.PL` when
searching for existing templates. Important for packaging.
- Fixed the error "Table 'sqitch.changes' doesn't exist" when deploying
to a MySQL database that exists but has not been initialized. Thanks to
Jean-Michel REY for the report!
- Refactored the handling of the C<--log-only> option so it sets an
engine attribute, rather than passing the flag to a whole stack of
method calls.
- Fixed "Argument "en_us" isn't numeric" error on Windows.
- Now using `LC_ALL` instead of `LC_MESSAGES` when setting the locale, as
the latter is not present on Windows.
- The sqitch-pg RPM now requires DBD::Pg 2.0.0 or higher.
- Improved handling of invalid command names so that the error message is
less ambiguous when triggered by a Perl parse error.
- Added `-m` as an alias for `--note`, for you Git folks out there.
- Added exception handling to the Postgres and Oracle engines to avoid
unexpected errors when deploying to a database that has not been
deployed to before.
- Updated detection of an uninitialized database to double-check with the
engine that it really thinks it's uninitialized, not just that the
"changes" table is missing. This should catch the case where the
database has its own "changes" table unrelated to Sqitch.
0.982 2013-09-11T18:26:07Z
- Errors thrown by Template toolkit are no longer silently ignored.
- Variables passed to change templates are now cloned before the
execution of each template. This prevents one template from deleting
variable values another template might also need.
- Fixed "The getpwnam function is unimplemented" errors on Win32.
- No longer runs revert scripts when deploying with `--log-only` and a
verify script fails, as that could lead to data loss (yikes!). Thanks
to BryLo for the report (issue #112).
0.981 2013-09-06T00:22:26Z
- Now use Encode::Locale to try to decode the user's full name from the
system encoding when fetched from the system on all OSes. Note that
this is not necessary if the `user.name` config is explicitly set, as
recommended. Issue #107.
- Removed the special-case handling of the user's full name fetched from
the system on OS X.
- Added call to `sleep` to test in an attempt to fix SQLite failures.
- The SQLite engine now requires that the SQLite client be 3.3.9 or
later, for support of the `-bail` option.
- Bug fix: The MySQL engine now properly uses the host, port, and
password options when connecting to the database. Thanks to vreb87 for
the report!
0.980 2013-08-28T21:40:00Z
- Changed the default SQLite Sqitch database name from
`$dbname-sqitch.$suffix` to `sqitch.$suffix`. The `$suffix` still
comes from the destination database name. This breaks compatibility
with previous releases. If you need the old name, set it with
`sqitch config core.sqlite.sqitch_db $dbname`.
- Fixed encoding of the user's full name when fetched from the system on
OS X. Thanks to Tomohiro Hosaka for the pull request!
- Fixed test failures when DBD::SQLite is installed but compiled with
SQLite 3.7.10 or lower.
- Fixed a bug where declaring a dependency on a reworked change would
incorrectly result in the error "Key "foo" matches multiple changes".
Thanks to BryLo for the report (issue #103).
- Modified tests to allow them to run in parallel without stomping on
each other.
- Bundling of options, such as `-vvv`, now works properly (issue #108).
- Added alias `--get-regexp` for `--get-regex` to the `config` command.
This brings it in line with the documentation for the `config` command
(Issue #110).
- Fixed all of the `config` command actions that contain a dash so that
they actually work. Thanks to Ștefan Suciu for the report (issue #110).
- All leading and trailing white space is now trimmed from plan notes,
rather than just vertical white space. Thanks to Ronan Dunklau for the
report (issue #106).
- The `status` command now notices if the specified database is
uninitialized and says as much, rather than dying with an SQL error
(issue #109).
- When reading the user's username from the system Sqitch now uses
Encode::Locale to try to decode the value from the system encoding.
Issue #107.
- Compatibility change: Changed the location and name of script template
files. Previously they were called `deploy.tmpl`, `revert.tmpl`, and
`verify.tmpl`, and they lived in the `templates` subdirectory of the
system-wide and user-specific configuration directories. They now live
in subdirectories of the `templates` directory named for each action
(deploy, revert, and verify), and with file names matching engine names
(`pg.tmpl`, `sqlite.tmpl`, `oracle.tmpl`, and `mysql.tmpl`). The
installer will move old files from the system-wide config directory
(`sqitch --etc-path`) to their new homes, named `pg.tmpl` and
`sqlite.tmpl`. It assumes no customizations exist for Oracle. If that's
not true in your case, simply copy the `pg.tmpl` files to
`oracle.tmpl`.
- Added the `--template-name` option to the `add` command. By default, it
looks for templates named for the current engine. The option allows for
the user of task-specific templates. For example, if you create
templates named `createtable.tmpl` in the `deploy`, `revert`, and
`verify` subdirectories of `~/.sqitch/templates`, You can specify
`--template-name createtable` to use those templates when adding a
change.
- Added the `--exists` option to the `show` command.
- Fixed the `--set` option to the `add` command so that duplicate keys
have their values passed to the template as an array, as documented.
- If Template::Toolkit is installed, the `add` command will use it for
processing templates instead of Template::Tiny. This makes it easy to
upgrade the templating environment just by installing a module.
0.973 2013-07-03T13:47:22Z
- Now Require DBD::SQLite compiled with SQLite 3.7.11 or higher. It
always has, but now it throws a meaningful exception if an older
version is compiled into DBD::SQLite. Thanks to Damon Buckwalter for
the report.
- When a deploy fails because of missing dependencies, the list of
missing dependencies no longer contains duplicates. Thanks to Damon
Buckwalter for the report.
0.972 2013-05-31T23:26:52Z
- Fixed test failures on Windows.
- Fixed locale configuration on Windows so that `sqitch` will actually
run, rather than exiting with an error about `LC_MESSAGES` not being
set.
- Fixed a test hang on Windows when DBD::Oracle is installed but the
Oracle libraries (`OCI.dll`) are not or cannot be found. This was
triggering a UI dialog that did not dismiss itself. Using Win32::API
to work around this issue. Thanks to Jan Dubois for the fix.
0.971 2013-05-18T21:08:51Z
- Removed most uses of the smartmatch operator, since as of Perl 5.17.11
it is marked as experimental, and silenced the warning where it is
still used.
- Added 0.1s sleep between logging changes back-to-back in the engine
tests, mostly to try to get SQLite to generate different timestamps.
Pretty sure the recent test failures have been due to the passage of
less than a millisecond between the two inserts.
- Added the `shell` and `quote_shell` methods to Sqitch.pm for shelling
out a command.
- Sqitch now shells out to an editor when opening a file for the user to
edit. For example, if the `$EDITOR` environment variable is set to
`"emacs -nw"`, it will now work. Thanks to Florian Ragwitz for the
report (issue #80).
- Removed the pod-checking tests from the distribution.
0.970 2013-05-09T00:21:06Z
- Fixed the default ordering of changes displayed by the `plan` command.
They are now ascending by default.
- Switched to PerlIO::utf8_strict for fast character encoding and
decoding.
- The help emitted when an unknown option is passed to `sqitch` now
consists of a usage statement and brief table of options, rather than
the entire man page.
- Added the project name in a header to the output of the `plan` command.
- Added the Oracle engine.
- Added `sqitchtutorial-oracle.pod`, a Oracle-specific variant of
`sqitchtutorial.pod`.
- Added missing version declaration to the App::Sqitch::Plan::* modules.
- Devel::StackTrace 1.30 is now properly required (it was previously
recommended).
- The `--show-tags` and `--show-changes` options to the `status` command
now show the changes when the project plan cannot be found (issue #90).
0.965 2013-04-23T16:25:59Z
- Fixed failing test due to line-ending character variations on Windows.
Many thanks to Jan Dubois for the testing help.
- Replaced all uses of `$/` in output to `"\n"`. Thanks to Jan Dubois for
pointing out the incorrect use of `$/`.
- Fixed build error that prevented installation on Perl 5.10 when the
parent module was not installed.
0.964 2013-04-15T18:47:30Z
- Fixed test failures on Perl versions lower than 5.14 when DBD::SQLite
or DBD::Pg is not installed.
- Removed DBD::SQLite from the list of build dependencies.
- Fixed test failures due to encoded (wide-character) warnings on
triggered on systems with non-english locales. Thanks to Alexandr
Ciornii for the smoke testing that revealed this issue.
- Removed overriding of Throwable's `previous_exception` in
App::Sqitch::X on Throwable 0.200007 and higher, where it is no longer
needed.
- Changed test comparing file contents that fails on Windows to do a
looser comparison and hopefully fix the test failure.
0.963 2013-04-12T19:11:29Z
- Fixed a test failure when Git is in the execution path and the test is
not run from a Git checkout.
- Added `plan` to `sqitchchanges`, the contents of which are shown when
Sqitch is run with no command.
- Removed the unique constraint on tag names in the database, as it
prevented two projects from having the same tag name. Replaced it with
a unique constraint on the project and tag names. Folks with production
PostgreSQL installs should run these queries:
ALTER TABLE sqitch.tags DROP CONSTRAINT tags_tag_key, ADD UNIQUE(project, tag);
COMMENT ON COLUMN sqitch.tags.tag IS 'Project-unique tag name.';
- Fixed failing tests when DBD::SQLite is not installed.
- Removed dependency on Git::Wrapper. The `checkout` command does things
very simply, and we already have tools for running command-line
applications. So we just take advantage of that. The code is no more
complicated than it was before.
- Added the `core.vcs.client` configuration setting. Defaults to `git`
(or `git.exe` on Windows).
0.962 2013-04-10T17:10:05Z
- Fixed failing test on Perl 5.12 and lower.
- Fixed the French translation by re-encoding it in UTF-8 (Ronan
Dunklau).
- Fixed the loading of the editor with placeholder text to properly
encode that text as UTF-8 (Ronan Dunklau).
0.961 2013-04-09T19:21:15Z
- Fixed error when running on PostgreSQL 9.0.
- Added support for PostgreSQL 8.4.
- Fixed the SQLite tests to skip the live tests when `sqlite3` cannot be
found.
- Fixed the Postgres tests to skip the live tests if `psql` cannot be
found or cannot connect to the database.
- Fixed the `checkout` test to skip tests that depend on Git and Git is
not found in the path.
- Fixed test failures on Windows (hopefully).
- Made the order of commented configuration variables in the project
configuration file deterministic. It will now always be the same order
as specified by the engine class. This fixes test failures on Perl
5.17.
- Fixed encoding issue that caused test failures on Perl 5.17.
- Requiring Devel::StackTrace 1.30, as earlier versions can
intermittently suppress errors.
- Added hack to `App::Sqitch::X::hurl()` to work around a bug in
Throwable that prevents `previous_exception` from being set half the
time on v5.17.
0.960 2013-04-05T23:04:35Z
- Removed `-CAS` from the shebang line on Perl 5.10.0. This is to
eliminate `Too late for "-CAS" option` errors. This means that UTF-8
semantics will be suboptimal on Perl 5.10.0. Consider upgrading to 5.12
or higher.
- Added the `checkout` command. Pass it the name of a VCS branch, and it
will compare the plans between that branch and the current branch,
revert to the last common change, check out the branch, and then
redeploy. This makes it easy to switch between working branches that
have different sets of commits. Git-only for now. Idea and code by
Ronan Dunklau.
- The `rebase` command no longer fails if the database is already
reverted, but just makes a note of it and goes on to the deploy.
- Added the `plan` command. It's like `log`, but shows a list of changes
in the plan, rather than events recorded in the database.
- Added `search_changes()` to Plan. Used by the `plan` command.
- Added the `--oneline` option to the `log` command.
- Allow tagging of an arbitrary change, not just the last change in the
plan, by passing a change specification (name, ID, or tag) as the
second argument to the `tag` command.
- Updated error messages to note that blank characters are not allowed in
project, change, or tag names.
- Factored most of the engine-specific code into
App::Sqitch::Role::DBIEngine. Future DBI-based engines should be able
to use this role to handle most of the work.
- Factored the live engine tests int `t/lib/DBIEngineTest`. Future
DBI-based engines can use this module to do all or most of the live
testing.
- Added the SQLite engine. The Sqitch metadata is stored in a separate
file from a database, by default in the same directory as the database
file.
- Added `sqitchtutorial-sqlite.pod`, a SQLite-specific variant of
`sqitchtutorial.pod`.
0.953 2013-02-21T23:37:57Z
- Fixed test failure in `t/engine.t` triggered by a clock tick.
- Changed the verify template to end with `ROLLBACK` rather than
`COMMIT`. This it to encourage folks to make no lasting changes in
verify tests.
- Fixed exception triggered on an attempt to revert or rebase `--to` a
change that does not exist in the database.
- Added recommendation for Pod::Simple to the build process.
- Added the `--etcdir` build option to specify the directory in which
configuration and template files should be installed. Defaults to the
`etc/sqitch` subdirectory of the `--prefix`, `--install_base`, or
Perl's prefix.
- Added the `--installed_etcdir` build option. This is used to set
the location of the system etc directory. Defaults to the value of
`--etcdir`.
- When building with `--prefix` or `--install_base`, and without
`--etcdir`, the configuration files and tmeplates are now installed
into `etc/sqitch` in that directory, rather than just `etc`. This is to
enable packaging systems to move the directory to the proper location.
0.952 2013-01-12T00:02:54Z
- Switched from Moose to Mouse whever possible. Speeds load and runtime
20-30%. Thanks to Michael Schwern for the pull request!
0.951 2013-01-08T00:21:58Z
- Fixed double "@" displayed for tags in the output of `revert`.
- Fixed reversion of reworked changes to run the original revert script,
rather than the reworked script.
- Added `is_reworked` accessor to App::Sqitch::Plan::Change.
- Changed the behavior determining the file name to use for reworked
change scripts. It now looks for a deploy script using the name of any
tag between the reworked instances of a change and selects the first
one it finds that exists. This will allow Sqitch to find the proper
script name even if new tags have been added to the plan (issue #70).
0.950 2013-01-03T23:09:42Z
- Fixed the "Name" header in `sqitch-rebase` so that it will actually
show up on the CPAN search sites.
- Fixed test failure triggered by the passage of time in `t/engine.t`.
- At the start of a `deploy`, if the most recently deployed change has
any unlogged tags (that is, tags added since the last `deploy`), they
will be logged before the `deploy` continues (issue #60).
- Added the `--no-log` option to `deploy`, `revert`, and `rebase`. This
causes the changes to be logged as deployed without actually running
the deploy scripts. Useful for an existing database that is being
converted to Sqitch, and you need to log changes as deployed because
they have been deployed by other means in the past.
- Now check that dependencies are required for all changes to be deployed
or reverted before deploying or reverting anything, rather than
checking dependencies for each change just before deploying or reverting
it. This allows a or revert deploy to fail sooner, with no database
changes, when dependencies are not met.
- The `deploy` command now checks that no changes its about to deploy are
already deployed.
- Added `--mode` to the `rebase` command.
- Added the `--verify` option to `deploy` and `rebase`. Specify this
option to run the verify script, if it exists, for each change after it
is deployed. If the verify script dies, the deploy will be considered a
failure and the requisite reversion (as specified for `--mode`) will
begin.
- Added the `verify` command, which verifies that a database is valid
relative to the plan and each deployed change's verification scripts.
- Changed the format of the list of changes output by `deploy` and
`revert` so that each now gets "ok" or "not ok" printed on success or
failure.
- Added short aliases for commonly-used core options:
* -f for --plan-file
* -v for --verbose
* -h for --db-host
* -p for --db-port
0.940 2012-12-04T05:49:45Z
- Fixed tests that failed due to I18N issues, with thanks to Arnaud
(Arhuman) ASSAD!
- Localized messages are now properly encoded in UTF-8. Thanks to Ronan
Dunklau for the report (issue #46) and to Guido Flohr for details on
how to address the issue.
- The variables defined for the `add`, `deploy`, and `revert` commands
now have the case of there names preserved if Config::GitLike 1.10 or
later is installed. Thanks to Ronan Dunklau for the report (issue #48)
and to Alex Vandiver for the case-preserving update to Config::GitLike.
- Attempting to run `sqitch` with no command now outputs the list of
supported commands (`sqitchcommands`), rather than the list of core
options. Thanks to BryLo for the suggestion.
- Changed the plan parser so that it no longer changes the order of
changes based on the dependency graph. Unfortunately, this meant that
the order could change from one run to another, especially if new
changes were added since the last deploy. The planner now throws an
exception if the order in the plan is wrong, and suggests that the user
move changes in the plan file to get it to work properly.
- Fixed bug where the `core.plan_file` configuration variable was
ignored.
- Improved error handling when deploying and reverting a change. If the
change successfully deployed but the logging of the deployment to the
database failed, there was just a rollback message. Sqitch will now
emit the underlying error *and* run the revert script for the
just-deployed change.
- Modified the text hashed for change and tag IDs. Both now include the
note, if present, the ID of the preceding change, and the list of
dependencies. The result is that, when a change is modified or moved in
the plan, it gets a new ID ID. The upshot is that things *must* be in
order for a deploy to succeed. Existing deployments will automatically
have their IDs updated by the `deploy` command.
- Changed the `revert` command so that it *only* fetches information about
changes to be reverted from the database, rather than the plan.
- Deprecated the `@LAST` and `@FIRST` symbolic tags. With `revert` now
fetching change information from the database, there is no longer a
need to specify that changes be found in the database. It's possible
some other way to search database changes will be added in the future,
but if so, it will be less limiting than `@LAST` and `@FIRST`, because
it will likely allow searches by literal tags.
- Added the `rebase` command. This command combines a `revert` and a
`deploy` into a single command, which should allow for more natural
deployment testing during development. `sqitch rebase @HEAD^` should
become a common command for database developers.
- Duplicate values passed via `--requires` and `--conflicts` in the `add`
and `rework` actions are now ignored.
- The `add` command now throws an exception if `--template-directory` is
passed or specified in the configuration file, and the specified
directory does not exist or is not a directory. Thanks to Ronan Dunklau
for the report! (Issue #52).
- The `revert` command now prompts for confirmation before reverting
anything. The prompt can be skipped via the `-y` option or setting the
`revert.no_prompt` configuration variable. Works for rebase, too, which
reads `rebase.no_prompt` before `revert.no_prompt`.' (Issue #49.)
- Added the `show` command, which show information about changes or tags,
or the contents of change script files. (Issue #57.)
- Renamed the `test` scripts and planned command to `verify`.
0.938 2012-10-12T19:16:57Z
- Added a primary key to the PostgreSQL `events` table, which should make
it easier to support replication.
0.937 2012-10-09T21:54:36Z
- Fixed the `--to` option to `deploy` and `revert`, which was ignored
starting in v0.936.
0.936 2012-10-09T19:11:5Z2
- Added `--set` option to the `deploy` and `revert` commands. Useful for
setting database client variables for use in scripts. Used by the
PostgreSQL engine.
- Merged the contents of `dist/sqitch-pg.spec` into a subpackage in
`sqitch.spec`. This allows both RPMs are created from a single build
process. Simplifies things quite a bit and improves the flexibility for
adding other engines in the future.
- Reduced required Perl version from 5.10.1 to 5.10.0.
- Fixed inconsistent handling of command options with dashes where some
were ignored.
- The bundle command now properly copies scripts for changes with slashes
in their names -- that is, where the scripts are in subdirectories.
0.935 2012-10-02T19:21:05Z
- Updated `dist/sqitch-pg.spec` to require `postgresql` rather than
"postgresql91". The version doesn't matter so much.
- All known Windows issues and failures fixed, with many thanks to Randy
Stauner for repeatedly running tests and supplying patches:
- Fixed "'2' is not recognized as an internal or external command,
operable program or batch file" error on Windows.
- Fixed multiple errors detecting Windows. The OS name is "MSWin32",
not "Win32". The test failure thus addressed was the setting of the
DateTime locale.
- Fixed failing tests that were incorrectly comparing subprocess errors
messages on Windows
- Fixed bug in `bundle` where a file would be re-copied even if the
source and destination had the same timestamps, as they seem to do
during tests on Windows. Patch from Randy Stauner.
- Fixed failing test that failed to include `.exe` in a file name on
Windows. Patch from Randy Stauner.
- Added French translation, with thanks to Arnaud (Arhuman) ASSAD!
0.934 2012-09-28T16:43:43Z
- Fixed typo in error handling that prevented an I/O error message from
being properly emitted.
0.933 2012-09-27T18:04:53Z
- The `init` command no longer fails if `--top-dir` does not exist. It
creates it.
- Yet another attempt to fix "List form of pipe open not implemented" bug
on Windows.
0.932 2012-09-26T21:32:48Z
- One more attempt to fix "List form of pipe open not implemented" bug on
Windows.
0.931 2012-09-25T19:09:14Z
- Now properly require Text::LocaleDomain 1.20.
- Stubbed out French and German localization files. Translators wanted!
- Added LocaleTextDomain dzil support (no impact on distribution).
- Fix "List form of pipe open not implemented" bug on Windows by using
Win32::ShellQuote to quote commands.
0.93 2012-08-31T22:29:41Z
- Added forward and reverse change references. Append ^ to a change
reference to mean the change before, or ~ to mean the change following.
Use ~~ and ^^ to select two changes forward and back, and ~n and ^n,
where n is an integer, to select that number of changes forward or
back. Idea stolen from Git, though the meanings of the characters are
different.
- Added the @FIRST and @LAST symbolic references to refer to the first
and last changes deployed to the database, respectively. These vary
from the existing @ROOT and @HEAD symbolic references, which refer to
the first and last changes listed in the plan.
- Updated the tutorial to use the new symbolic references and ^ and ~
qualifiers where appropriate.
- The messages output by the `deploy` and `revert` commands now show the
resolved name of the `--to` target, rather than the value passed to
`--to`. This is most useful when using a symbolic reference, so you
can see what you're actually deploying or reverting to.
0.922 2012-08-30T17:41:59Z
- Loosened constraint to disallow only `/[~^/=%]/` before digits at the
end of name. This allows, for example, a tag to be named "v1.2-1".
- Added the `bundle` command to the documentation displayed by `sqitch
help`.
- Updated the mention of the `bundle` command in the main `sqitch`
documentation.
0.921 2012-08-30T00:09:56Z
- Made Win32::Locale required only on Windows.
- Fixed some module minimum version requirements so that dependencies
will be properly listed in `Build.PL`.
0.92 2012-08-28T23:14:37Z
- Added the `bundle` command.
- Attempts to deploy a project with a different name or URI than
previously registered now throws an exception.
- Added UNIQUE constraint to `projects.uri` in the PostgreSQL Sqitch
schema.
- Added ON UPDATE actions to foreign key constraints in the PostgreSQL
Sqitch schema.
0.913 2012-08-28T17:31:29Z
- Fixed oversight in test that still relied on `$ENV{USER}` instead of
`Sqitch->sysuser`,
0.912 2012-08-27T21:23:19Z
- Fall back on `Sqitch->sysuser` when looking for the PostgreSQL user,
rather than just `$ENV{USER}`. The method does a lot more work to find
the system user name. This will hopefully also fix test failures on
systems where `$ENV{USER}` is not set.
- Use Win32::Locale to set the locale on DateTime objects on Windows.
0.911 2012-08-23T19:19:17Z
- Fixed more platform-specific test failures in `t/base.t`.
- Increased liklihood of finding a user's full name on Windows. Thanks to
H. Merijn Brand for testing.
0.91 2012-08-23T00:37:36Z
- Moved `requires` and `conflicts` array columns from the `changes` table
to an new table, `dependencies`, where there is just one per row.
- Requirements are now checked before reverting a change. If the change
is depended on by other changes, it will not be reverted (Issue #36).
- Fixed bug where the `status` command would show changes and/or tags
from other projects when `--show-tags` or `--show-changes` were used.
- Fixed test failures on Windows.
- Added more ways to look up the current username to minimize the chances
that none is found.
- Added Windows-specific way of finding the current user's full name,
since the existing approach died on Windows.
- Windows-specific modules are no longer required, but are recommended on
Windows. They will be listed by `./Build` and added to the "recommends"
section of the the generated `MYMETA.*` files on Windows.
- Fixed a bug where dependencies on other projects would be rejected
in calls to `add` and `rework`.
0.902 2012-08-20T21:14:08Z
- Fixed another occasional test failure due to a clock tick in `t/pg.t.`
- Fixed test failures in `t/status.t` on systems without DBD::Pg.
0.901 2012-08-20T19:31:03Z
- Fix test failure in `t/status.t` caused by failing to ignore a
pre-existing `~/.sqitch/sqitch.conf` configuration file.
- Eliminated "Use of uninitialized value in length" warnings.
0.90 2012-08-18T00:05:41Z
- Added `dist/sqitch.spec`. This file was created to generate an RPM for
CentOS 6.1.
- Added `dist/sqitch-pg.spec` to use for creating RPMs for Sqitch with
PostgreSQL support.
- Fixed an occasional test failure due to a clock tick in `t/pg.t.`
- Switched to Dist::Zilla for creating the distribution. For end-users,
this just means that `Build.PL` is now a generated file.
- Required module versions are now declared in code. This is so that they
are enforced at runtime, and also so that they will be picked up by
Dist::Zilla for inclusion in the generated `Build.PL` and `META` files.x
- Added support for declaring dependencies (required and conflicting
changes) from other Sqitch projects. This allows one project to depend
on changes from another. The syntax is `--requires $projname:$change`.
This use of the colon required a few changes to the Plan syntax:
+ Pragmas may now appear only in the first "header" section of the
plan, separated from the changes in the "body" of the plan by a blank
line.
+ Required dependencies no longer begin with ":". Conflicts still must
begin with "!".
+ Object names may no longer contain ":", as it is used for project
specification.
+ Project-qualified dependencies are supported by the project name
appearing before the change name, separated by a colon.
- Added App::Sqitch::Plan::Depend, an object to parse, represent, and
serialize dependencies.
- The plan parser does not validate changes required from other projects,
as it has no access to the plans from those projects.
- The engine interface validates cross-project dependencies before
deploying changes.
- Project data is not included in the Sqitch metadata tables in the
database. There is a table for all known projects, as well as foreign
key references in the `changes`, `tags`, and `events` tables.
- Project information is now displayed in the output of `sqitch status`
and `sqitch log` (in some formats).
- Added `--project` option to `sqitch status` to identify the project for
which to display the status. Defaults to the current project, if there
is one, or to the project in the database, if there is only one
registered project.
- Added `--project` option to `sqitch log` to allow searching for events
from projects matching a regular expression.
- Now require Config::GitLike 1.09 for its improved character encoding
support.
- Dependencies can now be declared as SHA1 hash IDs, including for IDs
from other projects.
- Fixed change and tag name validation to count "_" as a non-punctuation
character, and therefore able to be used at the beginning or end of
names.
- Replaced the `appuser` change in `sqitchtutorial` with `appschema`.
This simplifies things, since users are global objects in PostgreSQL,
while schemas are not. As a result, a bunch of irrelevant code was
removed from the tutorial.
0.82 2012-08-03T21:25:27Z
- Now require Moose 2.0300, since MooseX::Role::Parameterized, which
requires Role::HasMessage, requires it, anyway,
- Fixed test failure in `t/pg.t` when running on Test::More 0.94.
- Require POSIX in `t/datetime.t` to fix test failure with CentOS 6
Perl. Not sure why it did not fail anywhere else, but it's harmless
enough to make sure it's loaded early.
0.81 2012-08-03T11:34:46Z
- Removed wayward `/l` from a regular expression, which breaks Perls
earlier than 5.14, and is not needed anyway.
- Fixed error in `log` that caused invalid output on Perls earlier than
5.14. Seems that `return` is required for `when` statements meant to
return a value, and postfix `when` is not supported in Perl 5.10.
0.80 2012-08-01T21:54:00Z
- Added the `log` command to `sqitchcommands.pod`, which is shown as the
output of `sqitch help`.
- Added `user.name` and `user.email` configuration variables.
- Now using `user.name` and `user.email`, rather than the system or
database user name, to log the user committing changes to a database.
- Database-specific options are now prefixed with `--db-`.
- Added "raw" format to App::Sqitch::DateTime. It is ISO-8601 format in
UTC.
- Modified the "raw" log format to use the raw DateTime format.
- Added timestamp and planner info to the plan. This is additional
metadata included in every change and tag: The planner's name and email
address and the current timestamp. This makes it easier to audit who
added changes to a plan and when.
- Added the `--note` option to the `add`, `rework`, and `tag` commands.
- For consistency throughout, renamed all attributes and options from
"message" and "comment" to "note", which is shorter and better reflects
their purpose.
- The planner's name and email address, as well as the plan time and
note, are now stored in the database whenever changes or tags are
committed and logged.
- Renamed various database columns to be more consistent, with the terms
"commit", "plan", and "note".
- Added `requires` and `conflicts` columns to the events table, so that
they can become available to the `log` command.
- Various `log` format changes:
* Renamed %n (newline) to %v (vertical space)
* Renamed %c to %n (change name)
* Replaced %a (committer name) with %c (committer info). It takes an
optional argument:
+ "name" or "n" for committer name
+ "email" or "e" for committer email
+ "d" or "date" for commit date
+ "d:$format" or "date:$format" for formatted commit date
* Added %p (planner info). It takes an optional argument just like
"%c" does:
+ "name" or "n" for planner name
+ "email" or "e" for planner email
+ "d" or "date" for plan date
+ "d:$format" or "date:$format" for formatted plan date
* Added special argument to "%C", `:event", which returns a color based
on the value of the event type:
+ Green for "deploy"
+ Blue for "revert"
+ Red for "fail"
* Added "%r" and "%R" for lists of required changes.
* Added "%x" and "%X" for lists of conflicting changes.
* Added "%a" to display an unlocalized attribute name and value.
* Added "planner", "committer", "planned", and "email" arguments to %_.
* Documented that the dates can take CLDR or strftime formats, too.
* Added the %s, %b, and %B format for "subject", "body", and raw body
akin to Git. The values are taken from the note value, if available.
* Added committer email addresses to default formats.
* Added plan data to default formats.
* Added note data to default formats.
* Added lists of required and conflicting changes to the "raw" and
"full" formats.
* Switched to event-driven colors for event types and change IDs in
default formats.
* Added color to the event type and change ID output in the "raw"
format.
- Added detailed descriptions of the default formats to `sqitch-log.pod`.
- Updated the Change object to encode and decode vertical whitespace in a
note, so that all data remains on a single line for each object in the
plan file.
- Now require a note when adding, reworking, or tagging a change. If
`--note` is not specified, an editor will be launched and the user
prompted to write a note. This is similar to how `git commit` behaves,
and encourages documentation of changes.
- Added required "project" and optional "uri" pragmas to the plan.
- Added `--project` and `--uri` attributes to the `init` command.
- Removed the `core.uri` configuration variable and corresponding core
`--uri` option (since it has been replaced with the `init` command's
`--uri` option.
- Command-line arguments are now all assumed to be UTF-8, and are parsed
as such.
- Added workaround to force the configuration file to be written and read
as UTF-8. Requires an unreleased version of Config::GitLike to actually
work properly.
- Text passed to a pager (as when running `sqitch log`) is now encoded in
UTF-8.
- Fixed `--quiet` option so that it properly trumps `--verbose`.
0.71 2012-07-12T15:30:27Z
- Updated the example `sqitch log` output in `sqitchtutorial`.
- Changed the terms "actor", "agent" to "committer" throughout the API
and output.
- Renamed the `events` table columns from `logged_at` and `logged_by` to
`committed_at` and `committed_by`.
0.70 2012-07-12T13:24:13Z
- Changed the `current_changes()` and `current_tags()` Engine methods so
that they return iterator code references instead of lists.
- Added the `search_events()` Engine method, to search the event log.
- Added the `pager` attribute and `page()` methods to App::Sqitch.
- Added support for `strftime:` and `cldr:` options to the `status`
command's `--date-format` option.
- Added the `log` command.
- Added the `strftime:$string` and `cldr:$string` options to
`--date-format` in the `status` and `log` commands.
0.60 2012-07-07T11:12:26Z
- Removed some discussion of VCS integration, since it is not yet
implemented, and it may be a while before it is.
- Added `sqitchcommands`, documentation of the most common Sqitch
commands, and fixed `--help` to show it.
- Fixed `--man` to show the sqitch command documentation.
- Fixed error handling for unknown commands, so that it displays a
message saying the command is unknown, rather than a stack trace.
- Adding a change after a tag now also inserts a blank line into the plan
between the tag and the new change, for nicer plan file formatting.
- Added the `status` command.
- Added App::Sqitch::DateTime, a DateTime subclass with named formats.
0.51 2012-07-04T18:34:07Z
- Added Role::HasMessage to the list or requirements in `Build.PL`. Was
an oversight that it was omitted in v0.50.
- Removed the `--dry-run` option. It was completely ignored. Maybe it
will return someday.
- Removed `fail()`, `bail()`, `unfound()`, and `help()`. It's better for
commands not to exit, so have them throw exceptions in the appropriate
places, instead.
- Replaced all uses of Carp and non-exception handling uses of `die` with
our own localized exceptions.
- Localized all output and exception messages.
0.50 2012-07-03T19:55:20Z
- Require a plan file.
- Renamed "steps" to "changes".
- New plan file spec.
+ Tags are just labels on a particular change, no longer a list of
changes.
+ Dependencies now specified in the plan file, not in the deploy
script.
+ Changes can be specified as deploys or reverts, though reverts
are not currently supported.
+ Changes can be specified with an optional leading `+` for deploy or
`-` for revert, which will eventually be important for conflict
management.
+ Dependencies can be specified as other change names, tags, or a
change as of a tag (e.g., `foo@beta`).
+ Pragmas can be specified with a leading `%`. Only `%syntax-version`
is currently recognized; all others are ignored.
- Renamed the `add-step` command to just `add`.
- Added the `tag` command.
- Added the `revert` command.
- Added the `rework` command.
- Added exception objects and started using them.
- Added localization support and started using it.
- Added IDs to changes and tags. These are SHA1s generated from the return
value of the new `info` method, which describes the change or tag.
- Updated the PostgreSQL engine to comply with the new Engine API.
- Updated the PostgreSQL engine to use IDs for tracking changes and tags.
- Eliminated the term "node" from the plan implementation and docs.
- Updated the engine base class for the new plan API, and to just deploy
changes one-at-a-time.
- Added many new ways to look for changes in the plan, including:
+ `change_name`
+ `@tag_name`
+ `change_name@tag_name`
+ `change_id`
+ `tag_id`
- The plan file can now be written out with nearly all white space and
comments preserved.
- Changed the `add` command to write out the plan file after a new change
is added.
- Change names can now be duplicated, as long as a tag name appears
between them.
- Renamed `target` to destination in Engine.
- Started referring to the change to deploy or revert to in docs as the
"target".
- PostgreSQL errors will now be thrown as Sqitch exceptions, for proper
handling during command execution.
- Added required `core.uri` configuration setting. Used to keep change
IDs unique across projects.
- Added `--mode` option to `deploy`, to trigger reverts on failure to
either:
+ Not at all: keep the latest successful change.
+ To the last deployed tag
+ To the point at which the current deploy started
- Added the implicit tags `@ROOT` and `@HEAD` for looking up changes in
the plan.
- Renamed `sql_dir` to `top_dir` and made it default to the current
directory.
- Changed the location of the plan file to the top directory. This will
make it easier to have plans and scripts for multiple database
platforms in a single project.
- Fixed a bug in the build process so that template files will be
properly written to the `etc` directory.
- Rewrote `sqitchtutorial` to reflect the new realities.
- Updated `sqitch` documentation, and moved the plan file information to
App::Sqitch::Plan.
0.31 2012-05-21T22:29:42Z
- Fixed some typos and failing tests.
0.30 2012-05-18T15:43:12Z
- The `init` command now properly writes out the `[core]` section header
when there are only commented core settings.
- The `--requires` and `--conflicts` options to `add` now work
properly.
- Fixed anticipated Win32 test failures in `t/init.t`.'
- Fixed the `--plan-file`, `--top-dir`, and other directory options so
that they no longer throw errors, but actually work.
- Implemented the plan parser. It's designed to later be subclassed to
support VCS integration. Includes dependency parsing and sorting.
- Switched to IPC::System::Simple instead for system/capture code.
- Implemented Engine interface for deploying and reverting tags.
- Implemented PostgreSQL engine. It uses a lock to ensure that only one
deployment can run at any time.
- Added the `deploy` command. it is now possible to deploy to a
PostgreSQL database.
0.20 2012-05-01T02:48:47Z
- Added `--local` option to `sqitch config`.
- Renamed `project_file()` to `--local_file()` in App::Sqitch::Config.
- `sqitch init` now writes core and engine config settings with default
values to the configuration file. This makes it easier for folks to get
started editing it.
- Implemented `add` command. Includes support for system-wide or
use-specific templates using Template::Tiny.
- Added `etc` directory with default templates. This is installed into
`$Config{prefix}/etc/skitch`, unless built with `--prefix` or
`--install_base`, in which case it will simply be installed into `etc`
in that directory.
- Added `--etc-path`, so that one can know where the system-wide
configuration and templates are to be found.
0.11 2012-04-27T06:44:54Z
- Implemented `init` command.
- Started sketching out the engine interface, with preliminary PostgreSQL
and SQLite implementations.
- Require Perl v5.10.1 (did before, but in the wrong place, so it was
ignored).
- Fixed test failures on different verions of Moose.
- Fixed test failure on Perl 5.12.
0.10 2012-04-25T20:46:59Z
- Initial unstable release.
- Implemented `help` command.
- Implemented `config` command, very similar to `git-config`.
log.t 100644 001751 000166 71652 15004170404 15142 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 253;
#use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use Test::Warn;
use Test::MockModule;
use Path::Class;
use Term::ANSIColor qw(color);
use Encode;
use lib 't/lib';
use MockOutput;
use TestConfig;
use LC;
local $ENV{TZ} = 'America/Los_Angeles';
my $CLASS = 'App::Sqitch::Command::log';
require_ok $CLASS;
my $plan_file = Path::Class::File->new('t/sql/sqitch.plan')->stringify;
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => Path::Class::Dir->new('test-log')->stringify,
'core.plan_file' => $plan_file,
);
ok my $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
isa_ok my $log = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'log',
config => $config,
}), $CLASS, 'log command';
can_ok $log, qw(
target
change_pattern
project_pattern
committer_pattern
max_count
skip
reverse
format
options
execute
configure
headers
does
);
ok $CLASS->does("App::Sqitch::Role::ConnectingCommand"),
"$CLASS does ConnectingCommand";
is_deeply [$CLASS->options], [qw(
event=s@
target|t=s
change-pattern|change=s
project-pattern|project=s
committer-pattern|committer=s
format|f=s
date-format|date=s
max-count|n=i
skip=i
reverse!
color=s
no-color
abbrev=i
oneline
headers!
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
##############################################################################
# Test database.
is $log->target, undef, 'Default target should be undef';
isa_ok $log = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
), $CLASS, 'new status with target';
is $log->target, 'foo', 'Should have target "foo"';
##############################################################################
# Test configure().
my $configured = $CLASS->configure($config, {});
isa_ok delete $configured->{formatter}, 'App::Sqitch::ItemFormatter', 'Formatter';
is_deeply $configured, {_params => []},
'Should get empty hash for no config or options';
# Test date_format validation.
$config->update('log.date_format' => 'nonesuch');
throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X',
'Should get error for invalid date format in config';
is $@->ident, 'datetime',
'Invalid date format error ident should be "datetime"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'nonesuch',
), 'Invalid date format error message should be correct';
throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} }
'App::Sqitch::X',
'Should get error for invalid date format in optsions';
is $@->ident, 'datetime',
'Invalid date format error ident should be "log"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'non',
), 'Invalid date format error message should be correct';
# Test format validation.
$config = TestConfig->new('log.format' => 'nonesuch');
throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X',
'Should get error for invalid format in config';
is $@->ident, 'log',
'Invalid format error ident should be "log"';
is $@->message, __x(
'Unknown log format "{format}"',
format => 'nonesuch',
), 'Invalid format error message should be correct';
throws_ok { $CLASS->configure($config, { format => 'non'}), {} }
'App::Sqitch::X',
'Should get error for invalid format in optsions';
is $@->ident, 'log',
'Invalid format error ident should be "log"';
is $@->message, __x(
'Unknown log format "{format}"',
format => 'non',
), 'Invalid format error message should be correct';
# Test color configuration.
$config = TestConfig->new;
$configured = $CLASS->configure( $config, { no_color => 1 } );
is $configured->{formatter}->color, 'never',
'Configuration should respect --no-color, setting "never"';
# Test oneline configuration.
$configured = $CLASS->configure( $config, { oneline => 1 });
is $configured->{format}, '%{:event}C%h %l%{reset}C %o:%n %s',
'--oneline should set format';
is $configured->{formatter}{abbrev}, 6, '--oneline should set abbrev to 6';
$configured = $CLASS->configure( $config, { oneline => 1, format => 'format:foo', abbrev => 5 });
is $configured->{format}, 'foo', '--oneline should not override --format';
is $configured->{formatter}{abbrev}, 5, '--oneline should not overrride --abbrev';
$config->update('log.color' => 'auto');
$configured = $CLASS->configure( $config, { no_color => 1 } );
is $configured->{formatter}->color, 'never',
'Configuration should respect --no-color even when configure is set';
NEVER: {
my $configured = $CLASS->configure( $config, { color => 'never' } );
is $configured->{formatter}->color, 'never',
'Configuration should respect color option';
# Try it with config.
$config->update('log.color' => 'never');
$configured = $CLASS->configure( $config, {} );
is $configured->{formatter}->color, 'never',
'Configuration should respect color config';
}
ALWAYS: {
my $configured = $CLASS->configure( $config, { color => 'always' } );
is_deeply $configured->{formatter}->color, 'always',
'Configuration should respect color option';
# Try it with config.
$config->update('log.color' => 'always');
$configured = $CLASS->configure( $config, {} );
is_deeply $configured->{formatter}->color, 'always',
'Configuration should respect color config';
}
AUTO: {
for my $enabled (0, 1) {
$config->update('log.color' => 'always');
my $configured = $CLASS->configure( $config, { color => 'auto' } );
is_deeply $configured->{formatter}->color, 'auto',
'Configuration should respect color option';
# Try it with config.
$config->update('log.color' => 'auto');
$configured = $CLASS->configure( $config, {} );
is_deeply $configured->{formatter}->color, 'auto',
'Configuration should respect color config';
}
}
###############################################################################
# Test named formats.
my $cdt = App::Sqitch::DateTime->now;
my $pdt = $cdt->clone->subtract(days => 1);
my $event = {
event => 'deploy',
project => 'logit',
change_id => '000011112222333444',
change => 'lolz',
tags => [ '@beta', '@gamma' ],
committer_name => 'larry',
committer_email => 'larry@example.com',
committed_at => $cdt,
planner_name => 'damian',
planner_email => 'damian@example.com',
planned_at => $pdt,
note => "For the LOLZ.\n\nYou know, funny stuff and cute kittens, right?",
requires => [qw(foo bar)],
conflicts => []
};
my $ciso = $cdt->as_string( format => 'iso' );
my $craw = $cdt->as_string( format => 'raw' );
my $piso = $pdt->as_string( format => 'iso' );
my $praw = $pdt->as_string( format => 'raw' );
for my $spec (
[ raw => "deploy 000011112222333444 (\@beta, \@gamma)\n"
. "name lolz\n"
. "project logit\n"
. "requires foo, bar\n"
. "planner damian \n"
. "planned $praw\n"
. "committer larry \n"
. "committed $craw\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ full => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n"
. __('Name: ') . " lolz\n"
. __('Project: ') . " logit\n"
. __('Requires: ') . " foo, bar\n"
. __('Planner: ') . " damian \n"
. __('Planned: ') . " __PDATE__\n"
. __('Committer:') . " larry \n"
. __('Committed:') . " __CDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ long => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n"
. __('Name: ') . " lolz\n"
. __('Project: ') . " logit\n"
. __('Planner: ') . " damian \n"
. __('Committer:') . " larry \n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ medium => __('Deploy') . " 000011112222333444\n"
. __('Name: ') . " lolz\n"
. __('Committer:') . " larry \n"
. __('Date: ') . " __CDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ short => __('Deploy') . " 000011112222333444\n"
. __('Name: ') . " lolz\n"
. __('Committer:') . " larry \n\n"
. " For the LOLZ.\n",
],
[ oneline => '000011112222333444 ' . __('deploy') . ' logit:lolz For the LOLZ.' ],
) {
local $ENV{ANSI_COLORS_DISABLED} = 1;
my $configured = $CLASS->configure( $config, { format => $spec->[0] } );
my $format = $configured->{format};
ok my $log = $CLASS->new( sqitch => $sqitch, %{ $configured } ),
qq{Instantiate with format "$spec->[0]"};
(my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/;
$exp =~ s/__PDATE__/$piso/;
is $log->formatter->format( $log->format, $event ), $exp,
qq{Format "$spec->[0]" should output correctly};
if ($spec->[1] =~ /__CDATE__/) {
# Test different date formats.
for my $date_format (qw(rfc long medium)) {
ok my $log = $CLASS->new(
sqitch => $sqitch,
format => $format,
formatter => App::Sqitch::ItemFormatter->new(date_format => $date_format),
), qq{Instantiate with format "$spec->[0]" and date format "$date_format"};
my $date = $cdt->as_string( format => $date_format );
(my $exp = $spec->[1]) =~ s/__CDATE__/$date/;
$date = $pdt->as_string( format => $date_format );
$exp =~ s/__PDATE__/$date/;
is $log->formatter->format( $log->format, $event ), $exp,
qq{Format "$spec->[0]" and date format "$date_format" should output correctly};
}
}
if ($spec->[1] =~ s/\s+[(]?[@]beta,\s+[@]gamma[)]?//) {
# Test without tags.
local $event->{tags} = [];
(my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/;
$exp =~ s/__PDATE__/$piso/;
is $log->formatter->format( $log->format, $event ), $exp,
qq{Format "$spec->[0]" should output correctly without tags};
}
}
###############################################################################
# Test all formatting characters.
my $local_cdt = $cdt->clone;
$local_cdt->set_time_zone('local');
$local_cdt->set_locale($LC::TIME);
my $local_pdt = $pdt->clone;
$local_pdt->set_time_zone('local');
$local_pdt->set_locale($LC::TIME);
my $formatter = $log->formatter;
for my $spec (
['%e', { event => 'deploy' }, 'deploy' ],
['%e', { event => 'revert' }, 'revert' ],
['%e', { event => 'fail' }, 'fail' ],
['%L', { event => 'deploy' }, __ 'Deploy' ],
['%L', { event => 'revert' }, __ 'Revert' ],
['%L', { event => 'fail' }, __ 'Fail' ],
['%l', { event => 'deploy' }, __ 'deploy' ],
['%l', { event => 'revert' }, __ 'revert' ],
['%l', { event => 'fail' }, __ 'fail' ],
['%{event}_', {}, __ 'Event: ' ],
['%{change}_', {}, __ 'Change: ' ],
['%{committer}_', {}, __ 'Committer:' ],
['%{planner}_', {}, __ 'Planner: ' ],
['%{by}_', {}, __ 'By: ' ],
['%{date}_', {}, __ 'Date: ' ],
['%{committed}_', {}, __ 'Committed:' ],
['%{planned}_', {}, __ 'Planned: ' ],
['%{name}_', {}, __ 'Name: ' ],
['%{email}_', {}, __ 'Email: ' ],
['%{requires}_', {}, __ 'Requires: ' ],
['%{conflicts}_', {}, __ 'Conflicts:' ],
['%H', { change_id => '123456789' }, '123456789' ],
['%h', { change_id => '123456789' }, '123456789' ],
['%{5}h', { change_id => '123456789' }, '12345' ],
['%{7}h', { change_id => '123456789' }, '1234567' ],
['%n', { change => 'foo' }, 'foo'],
['%n', { change => 'bar' }, 'bar'],
['%o', { project => 'foo' }, 'foo'],
['%o', { project => 'bar' }, 'bar'],
['%c', { committer_name => 'larry', committer_email => 'larry@example.com' }, 'larry '],
['%{n}c', { committer_name => 'damian' }, 'damian'],
['%{name}c', { committer_name => 'chip' }, 'chip'],
['%{e}c', { committer_email => 'larry@example.com' }, 'larry@example.com'],
['%{email}c', { committer_email => 'damian@example.com' }, 'damian@example.com'],
['%{date}c', { committed_at => $cdt }, $cdt->as_string( format => 'iso' ) ],
['%{date:rfc}c', { committed_at => $cdt }, $cdt->as_string( format => 'rfc' ) ],
['%{d:long}c', { committed_at => $cdt }, $cdt->as_string( format => 'long' ) ],
["%{d:cldr:HH'h' mm'm'}c", { committed_at => $cdt }, $local_cdt->format_cldr( q{HH'h' mm'm'} ) ],
["%{d:strftime:%a at %H:%M:%S}c", { committed_at => $cdt }, $local_cdt->strftime('%a at %H:%M:%S') ],
['%p', { planner_name => 'larry', planner_email => 'larry@example.com' }, 'larry '],
['%{n}p', { planner_name => 'damian' }, 'damian'],
['%{name}p', { planner_name => 'chip' }, 'chip'],
['%{e}p', { planner_email => 'larry@example.com' }, 'larry@example.com'],
['%{email}p', { planner_email => 'damian@example.com' }, 'damian@example.com'],
['%{date}p', { planned_at => $pdt }, $pdt->as_string( format => 'iso' ) ],
['%{date:rfc}p', { planned_at => $pdt }, $pdt->as_string( format => 'rfc' ) ],
['%{d:long}p', { planned_at => $pdt }, $pdt->as_string( format => 'long' ) ],
["%{d:cldr:HH'h' mm'm'}p", { planned_at => $pdt }, $local_pdt->format_cldr( q{HH'h' mm'm'} ) ],
["%{d:strftime:%a at %H:%M:%S}p", { planned_at => $pdt }, $local_pdt->strftime('%a at %H:%M:%S') ],
['%t', { tags => [] }, '' ],
['%t', { tags => ['@foo'] }, ' @foo' ],
['%t', { tags => ['@foo', '@bar'] }, ' @foo, @bar' ],
['%{|}t', { tags => [] }, '' ],
['%{|}t', { tags => ['@foo'] }, ' @foo' ],
['%{|}t', { tags => ['@foo', '@bar'] }, ' @foo|@bar' ],
['%T', { tags => [] }, '' ],
['%T', { tags => ['@foo'] }, ' (@foo)' ],
['%T', { tags => ['@foo', '@bar'] }, ' (@foo, @bar)' ],
['%{|}T', { tags => [] }, '' ],
['%{|}T', { tags => ['@foo'] }, ' (@foo)' ],
['%{|}T', { tags => ['@foo', '@bar'] }, ' (@foo|@bar)' ],
['%r', { requires => [] }, '' ],
['%r', { requires => ['foo'] }, ' foo' ],
['%r', { requires => ['foo', 'bar'] }, ' foo, bar' ],
['%{|}r', { requires => [] }, '' ],
['%{|}r', { requires => ['foo'] }, ' foo' ],
['%{|}r', { requires => ['foo', 'bar'] }, ' foo|bar' ],
['%R', { requires => [] }, '' ],
['%R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ],
['%R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo, bar\n" ],
['%{|}R', { requires => [] }, '' ],
['%{|}R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ],
['%{|}R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo|bar\n" ],
['%x', { conflicts => [] }, '' ],
['%x', { conflicts => ['foo'] }, ' foo' ],
['%x', { conflicts => ['foo', 'bax'] }, ' foo, bax' ],
['%{|}x', { conflicts => [] }, '' ],
['%{|}x', { conflicts => ['foo'] }, ' foo' ],
['%{|}x', { conflicts => ['foo', 'bax'] }, ' foo|bax' ],
['%X', { conflicts => [] }, '' ],
['%X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ],
['%X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo, bar\n" ],
['%{|}X', { conflicts => [] }, '' ],
['%{|}X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ],
['%{|}X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo|bar\n" ],
['%{yellow}C', {}, '' ],
['%{:event}C', { event => 'deploy' }, '' ],
['%v', {}, "\n" ],
['%%', {}, '%' ],
['%s', { note => 'hi there' }, 'hi there' ],
['%s', { note => "hi there\nyo" }, 'hi there' ],
['%s', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, 'subject line' ],
['%{ }s', { note => 'hi there' }, ' hi there' ],
['%{xx}s', { note => 'hi there' }, 'xxhi there' ],
['%b', { note => 'hi there' }, '' ],
['%b', { note => "hi there\nyo" }, 'yo' ],
['%b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "first graph\n\nsecond graph\n\n" ],
['%{ }b', { note => 'hi there' }, '' ],
['%{xxx }b', { note => "hi there\nyo" }, "xxx yo" ],
['%{x}b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xfirst graph\nx\nxsecond graph\nx\n" ],
['%{ }b', { note => "hi there\r\nyo" }, " yo" ],
['%B', { note => 'hi there' }, 'hi there' ],
['%B', { note => "hi there\nyo" }, "hi there\nyo" ],
['%B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "subject line\n\nfirst graph\n\nsecond graph\n\n" ],
['%{ }B', { note => 'hi there' }, ' hi there' ],
['%{xxx }B', { note => "hi there\nyo" }, "xxx hi there\nxxx yo" ],
['%{x}B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xsubject line\nx\nxfirst graph\nx\nxsecond graph\nx\n" ],
['%{ }B', { note => "hi there\r\nyo" }, " hi there\r\n yo" ],
['%{change}a', $event, "change $event->{change}\n" ],
['%{change_id}a', $event, "change_id $event->{change_id}\n" ],
['%{event}a', $event, "event $event->{event}\n" ],
['%{tags}a', $event, 'tags ' . join(', ', @{ $event->{tags} }) . "\n" ],
['%{requires}a', $event, 'requires ' . join(', ', @{ $event->{requires} }) . "\n" ],
['%{conflicts}a', $event, '' ],
['%{committer_name}a', $event, "committer_name $event->{committer_name}\n" ],
['%{committed_at}a', $event, "committed_at $craw\n" ],
) {
local $ENV{ANSI_COLORS_DISABLED} = 1;
(my $desc = encode_utf8 $spec->[2]) =~ s/\n/[newline]/g;
is $formatter->format( $spec->[0], $spec->[1] ), $spec->[2],
qq{Format "$spec->[0]" should output "$desc"};
}
throws_ok { $formatter->format( '%_', {} ) } 'App::Sqitch::X',
'Should get exception for format "%_"';
is $@->ident, 'format', '%_ error ident should be "format"';
is $@->message, __ 'No label passed to the _ format',
'%_ error message should be correct';
throws_ok { $formatter->format( '%{foo}_', {} ) } 'App::Sqitch::X',
'Should get exception for unknown label in format "%_"';
is $@->ident, 'format', 'Invalid %_ label error ident should be "format"';
is $@->message, __x(
'Unknown label "{label}" passed to the _ format',
label => 'foo'
), 'Invalid %_ label error message should be correct';
ok $log = $CLASS->new(
sqitch => $sqitch,
formatter => App::Sqitch::ItemFormatter->new(abbrev => 4)
), 'Instantiate with abbrev => 4';
is $log->formatter->format( '%h', { change_id => '123456789' } ),
'1234', '%h should respect abbrev';
is $log->formatter->format( '%H', { change_id => '123456789' } ),
'123456789', '%H should not respect abbrev';
ok $log = $CLASS->new(
sqitch => $sqitch,
formatter => App::Sqitch::ItemFormatter->new(date_format => 'rfc')
), 'Instantiate with date_format => "rfc"';
is $log->formatter->format( '%{date}c', { committed_at => $cdt } ),
$cdt->as_string( format => 'rfc' ),
'%{date}c should respect the date_format attribute';
is $log->formatter->format( '%{d:iso}c', { committed_at => $cdt } ),
$cdt->as_string( format => 'iso' ),
'%{iso}c should override the date_format attribute';
throws_ok { $formatter->format( '%{foo}a', {}) } 'App::Sqitch::X',
'Should get exception for unknown attribute passed to %a';
is $@->ident, 'format', '%a error ident should be "format"';
is $@->message, __x(
'{attr} is not a valid change attribute', attr => 'foo'
), '%a error message should be correct';
delete $ENV{ANSI_COLORS_DISABLED};
for my $color (qw(yellow red blue cyan magenta)) {
is $formatter->format( "%{$color}C", {} ), color($color),
qq{Format "%{$color}C" should output }
. color($color) . $color . color('reset');
}
for my $spec (
[ ':event', { event => 'deploy' }, 'green', 'deploy' ],
[ ':event', { event => 'revert' }, 'blue', 'revert' ],
[ ':event', { event => 'fail' }, 'red', 'fail' ],
) {
is $formatter->format( "%{$spec->[0]}C", $spec->[1] ), color($spec->[2]),
qq{Format "%{$spec->[0]}C" on "$spec->[3]" should output }
. color($spec->[2]) . $spec->[2] . color('reset');
}
# Make sure other colors work.
my $yellow = color('yellow') . '%s' . color('reset');
my $green = color('green') . '%s' . color('reset');
$event->{conflicts} = [qw(dr_evil)];
for my $spec (
[ full => sprintf($green, __ ('Deploy') . ' 000011112222333444')
. " (\@beta, \@gamma)\n"
. __ ('Name: ') . " lolz\n"
. __ ('Project: ') . " logit\n"
. __ ('Requires: ') . " foo, bar\n"
. __ ('Conflicts:') . " dr_evil\n"
. __ ('Planner: ') . " damian \n"
. __ ('Planned: ') . " __PDATE__\n"
. __ ('Committer:') . " larry \n"
. __ ('Committed:') . " __CDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ long => sprintf($green, __ ('Deploy') . ' 000011112222333444')
. " (\@beta, \@gamma)\n"
. __ ('Name: ') . " lolz\n"
. __ ('Project: ') . " logit\n"
. __ ('Planner: ') . " damian \n"
. __ ('Committer:') . " larry \n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ medium => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n"
. __ ('Name: ') . " lolz\n"
. __ ('Committer:') . " larry \n"
. __ ('Date: ') . " __CDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ short => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n"
. __ ('Name: ') . " lolz\n"
. __ ('Committer:') . " larry \n\n"
. " For the LOLZ.\n",
],
[ oneline => sprintf "$green %s %s", '000011112222333444' . ' '
. __('deploy'), 'logit:lolz', 'For the LOLZ.',
],
) {
my $format = $CLASS->configure( $config, { format => $spec->[0] } )->{format};
ok my $log = $CLASS->new( sqitch => $sqitch, format => $format ),
qq{Instantiate with format "$spec->[0]" again};
(my $exp = $spec->[1]) =~ s/__CDATE__/$ciso/;
$exp =~ s/__PDATE__/$piso/;
is $log->formatter->format( $log->format, $event ), $exp,
qq{Format "$spec->[0]" should output correctly with color};
}
throws_ok { $formatter->format( '%{BLUELOLZ}C', {} ) } 'App::Sqitch::X',
'Should get an error for an invalid color';
is $@->ident, 'format', 'Invalid color error ident should be "format"';
is $@->message, __x(
'{color} is not a valid ANSI color', color => 'BLUELOLZ'
), 'Invalid color error message should be correct';
##############################################################################
# Test execute().
my $emock = Test::MockModule->new('App::Sqitch::Engine::sqlite');
$emock->mock(destination => 'flipr');
my $mock_target = Test::MockModule->new('App::Sqitch::Target');
my ($target_name_arg, $orig_meth);
$target_name_arg = '_blah';
$mock_target->mock(new => sub {
my $self = shift;
my %p = @_;
$target_name_arg = $p{name};
$self->$orig_meth(@_);
});
$orig_meth = $mock_target->original('new');
# First test for uninitialized DB.
my $init = 0;
$emock->mock(initialized => sub { $init });
throws_ok { $log->execute } 'App::Sqitch::X',
'Should get exception for unititialied db';
is $@->ident, 'log', 'Uninit db error ident should be "log"';
is $@->exitval, 1, 'Uninit db exit val should be 1';
is $@->message, __x(
'Database {db} has not been initialized for Sqitch',
db => 'db:sqlite:',
), 'Uninit db error message should be correct';
is $target_name_arg, undef, 'Should have passed undef to Target';
# Next, test for no events.
$init = 1;
$target_name_arg = '_blah';
my @events;
my $iter = sub { shift @events };
my $search_args;
$emock->mock(search_events => sub {
shift;
$search_args = [@_];
return $iter;
});
$log = $CLASS->new(sqitch => $sqitch);
throws_ok { $log->execute } 'App::Sqitch::X',
'Should get error for empty event table';
is $@->ident, 'log', 'no events error ident should be "log"';
is $@->exitval, 1, 'no events exit val should be 1';
is $@->message, __x(
'No events logged for {db}',
db => 'flipr',
), 'no events error message should be correct';
is_deeply $search_args, [limit => 1],
'Search should have been limited to one row';
is $target_name_arg, undef, 'Should have passed undef to Target again';
# Okay, let's add some events.
push @events => {}, $event;
$target_name_arg = '_blah';
$log = $CLASS->new(sqitch => $sqitch);
ok $log->execute, 'Execute log';
is $target_name_arg, undef, 'Should have passed undef to Target once more';
is_deeply $search_args, [
event => undef,
change => undef,
project => undef,
committer => undef,
limit => undef,
offset => undef,
direction => 'DESC'
], 'The proper args should have been passed to search_events';
is_deeply +MockOutput->get_page, [
[__x 'On database {db}', db => 'flipr'],
[ $log->formatter->format( $log->format, $event ) ],
], 'The change should have been paged';
# Make sure a passed target is processed.
push @events => {}, $event;
$target_name_arg = '_blah';
ok $log->execute('db:sqlite:whatever.db'), 'Execute with target arg';
is $target_name_arg, 'db:sqlite:whatever.db',
'Target name should have been passed to Target';
is_deeply $search_args, [
event => undef,
change => undef,
project => undef,
committer => undef,
limit => undef,
offset => undef,
direction => 'DESC'
], 'The proper args should have been passed to search_events';
is_deeply +MockOutput->get_page, [
[__x 'On database {db}', db => 'flipr'],
[ $log->formatter->format( $log->format, $event ) ],
], 'The change should have been paged';
# Make sure we can pass a plan file.
push @events => {}, $event;
$target_name_arg = '_blah';
ok $log->execute($plan_file), 'Execute with plan file arg';
is $target_name_arg, 'db:sqlite:',
'Default engine target should have been passed to Target';
is_deeply $search_args, [
event => undef,
change => undef,
project => undef,
committer => undef,
limit => undef,
offset => undef,
direction => 'DESC'
], 'The proper args should have been passed to search_events';
is_deeply +MockOutput->get_page, [
[__x 'On database {db}', db => 'flipr'],
[ $log->formatter->format( $log->format, $event ) ],
], 'The change should have been paged';
# Set attributes and add more events.
my $event2 = {
event => 'revert',
change_id => '84584584359345',
change => 'barf',
tags => [],
committer_name => 'theory',
committer_email => 'theory@example.com',
committed_at => $cdt,
note => 'Oh man this was a bad idea',
};
push @events => {}, $event, $event2;
isa_ok $log = $CLASS->new(
sqitch => $sqitch,
target => 'db:sqlite:foo.db',
event => [qw(revert fail)],
change_pattern => '.+',
project_pattern => '.+',
committer_pattern => '.+',
max_count => 10,
skip => 5,
reverse => 1,
headers => 0,
), $CLASS, 'log with attributes';
$target_name_arg = '_blah';
ok $log->execute, 'Execute log with attributes';
is $target_name_arg, $log->target, 'Should have passed target name to Target';
is_deeply $search_args, [
event => [qw(revert fail)],
change => '.+',
project => '.+',
committer => '.+',
limit => 10,
offset => 5,
direction => 'ASC'
], 'All params should have been passed to search_events';
is_deeply +MockOutput->get_page, [
[ $log->formatter->format( $log->format, $event ) ],
[ $log->formatter->format( $log->format, $event2 ) ],
], 'Both changes should have been paged with no headers';
# Make sure we get a warning when both the option and the arg are specified.
push @events => {}, $event;
ok $log->execute('pg'), 'Execute log with attributes';
is $target_name_arg, 'db:pg:', 'Should have passed enginetarget to Target';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => $log->target,
)]], 'Should have got warning for two targets';
# Make sure we catch bad format codes.
isa_ok $log = $CLASS->new(
sqitch => $sqitch,
format => '%Z',
), $CLASS, 'log with bad format';
push @events, {}, $event;
$target_name_arg = '_blah';
throws_ok { $log->execute } 'App::Sqitch::X',
'Should get an exception for a bad format code';
is $@->ident, 'format',
'bad format code format error ident should be "format"';
is $@->message, __x(
'Unknown format code "{code}"', code => 'Z',
), 'bad format code format error message should be correct';
is $target_name_arg, $log->target, 'Should have passed target name to Target';
tag.t 100644 001751 000166 11006 15004170404 15117 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 22;
#use Test::More 'no_plan';
use Test::NoWarnings;
use Path::Class;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use Test::MockModule;
use Digest::SHA;
use URI;
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan::Tag';
require_ok $CLASS or die;
delete $ENV{PGDATABASE};
delete $ENV{PGUSER};
delete $ENV{USER};
}
can_ok $CLASS, qw(
name
info
id
lspace
rspace
note
plan
timestamp
planner_name
planner_email
format_planner
);
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
my $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'roles' );
isa_ok my $tag = $CLASS->new(
name => 'foo',
plan => $plan,
change => $change,
), $CLASS;
isa_ok $tag, 'App::Sqitch::Plan::Line';
my $mock_plan = Test::MockModule->new('App::Sqitch::Plan');
$mock_plan->mock(index_of => 0); # no other changes
is $tag->format_name, '@foo', 'Name should format as "@foo"';
isa_ok $tag->timestamp, 'App::Sqitch::DateTime', 'Timestamp';
is $tag->planner_name, $sqitch->user_name,
'Planner name shoudld default to user name';
is $tag->planner_email, $sqitch->user_email,
'Planner email shoudld default to user email';
is $tag->format_planner, join(
' ',
$sqitch->user_name,
'<' . $sqitch->user_email . '>'
), 'Planner name and email should format properly';
my $ts = $tag->timestamp->as_string;
is $tag->as_string, "\@foo $ts ". $tag->format_planner,
'Should as_string to "@foo" + timstamp + planner';
my $uri = URI->new('https://github.com/sqitchers/sqitch/');
$mock_plan->mock( uri => $uri );
is $tag->info, join("\n",
'project sql',
'uri https://github.com/sqitchers/sqitch/',
'tag @foo',
'change ' . $change->id,
'planner ' . $tag->format_planner,
'date ' . $ts,
), 'Tag info should incldue the URI';
my $date = App::Sqitch::DateTime->new(
year => 2012,
month => 7,
day => 16,
hour => 17,
minute => 25,
second => 7,
time_zone => 'UTC',
);
ok $tag = $CLASS->new(
name => 'howdy',
plan => $plan,
change => $change,
lspace => ' ',
rspace => "\t",
note => 'blah blah blah',
timestamp => $date,
planner_name => 'Barack Obama',
planner_email => 'potus@whitehouse.gov',
), 'Create tag with more stuff';
my $ts2 = '2012-07-16T17:25:07Z';
is $tag->as_string,
" \@howdy $ts2 Barack Obama \t# blah blah blah",
'It should as_string correctly';
$mock_plan->mock(index_of => 1);
$mock_plan->mock(change_at => $change);
is $tag->change, $change, 'Change should be correct';
is $tag->format_planner, 'Barack Obama ',
'Planner name and email should format properly';
# Make sure it gets the change even if there is a tag in between.
my @prevs = ($tag, $change);
$mock_plan->mock(index_of => 8);
$mock_plan->mock(change_at => sub { shift @prevs });
is $tag->change, $change, 'Change should be for previous change';
is $tag->info, join("\n",
'project sql',
'uri https://github.com/sqitchers/sqitch/',
'tag @howdy',
'change ' . $change->id,
'planner Barack Obama ',
'date 2012-07-16T17:25:07Z',
'', 'blah blah blah',
), 'Tag info should include the change';
is $tag->id, do {
my $content = $tag->info;
Digest::SHA->new(1)->add(
'tag ' . length($content) . "\0" . $content
)->hexdigest;
},'Tag ID should be correct';
##############################################################################
# Test ID for a tag with a UTF-8 name.
ok $tag = $CLASS->new(
name => '阱阪阬',
plan => $plan,
change => $change,
), 'Create tag with UTF-8 name';
is $tag->info, join("\n",
'project sql',
'uri https://github.com/sqitchers/sqitch/',
'tag ' . '@阱阪阬',
'change ' . $change->id,
'planner ' . $tag->format_planner,
'date ' . $tag->timestamp->as_string,
), 'The name should be decoded text in info';
is $tag->id, do {
my $content = Encode::encode_utf8 $tag->info;
Digest::SHA->new(1)->add(
'tag ' . length($content) . "\0" . $content
)->hexdigest;
},'Tag ID should be hahsed from encoded UTF-8';
add.t 100644 001751 000166 113206 15004170404 15121 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 243;
#use Test::More 'no_plan';
use App::Sqitch;
use App::Sqitch::Target;
use Locale::TextDomain qw(App-Sqitch);
use Path::Class;
use Test::Exception;
use Test::Warn;
use Test::Dir;
use File::Temp 'tempdir';
use Test::File qw(file_not_exists_ok file_exists_ok);
use Test::File::Contents 0.05;
use File::Path qw(make_path remove_tree);
use Test::NoWarnings 0.083;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::add';
my $config = TestConfig->new(
'core.engine' => 'pg',
'core.top_dir' => dir('test-add')->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
isa_ok my $add = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'add',
config => $config,
args => [],
}), $CLASS, 'add command';
my $target = $add->default_target;
sub dep($$) {
my $dep = App::Sqitch::Plan::Depend->new(
%{ App::Sqitch::Plan::Depend->parse( $_[1] ) },
plan => $add->default_target->plan,
conflicts => $_[0],
);
$dep->project;
return $dep;
}
can_ok $CLASS, qw(
options
requires
conflicts
variables
template_name
template_directory
with_scripts
templates
open_editor
configure
execute
_config_templates
all_templates
_slurp
_add
does
);
ok $CLASS->does("App::Sqitch::Role::ContextCommand"),
"$CLASS does ContextCommand";
is_deeply [$CLASS->options], [qw(
change-name|change|c=s
requires|r=s@
conflicts|x=s@
note|n|m=s@
all|a!
template-name|template|t=s
template-directory=s
with=s@
without=s@
use=s%
open-editor|edit|e!
plan-file|f=s
top-dir=s
)], 'Options should be set up';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
sub contents_of ($) {
my $file = shift;
open my $fh, "<:utf8_strict", $file or die "cannot open $file: $!";
local $/;
return <$fh>;
}
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}, $sqitch), {
requires => [],
conflicts => [],
note => [],
_cx => [],
}, 'Should have default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
requires => [qw(foo bar)],
conflicts => ['baz'],
note => [qw(hellow there)],
}), {
requires => [qw(foo bar)],
conflicts => ['baz'],
note => [qw(hellow there)],
_cx => [],
}, 'Should have get requires and conflicts options';
is_deeply $CLASS->configure($config, { template_directory => 't' }), {
requires => [],
conflicts => [],
note => [],
_cx => [],
template_directory => dir('t'),
}, 'Should set up template directory option';
is_deeply $CLASS->configure($config, { change_name => 'blog' }), {
requires => [],
conflicts => [],
note => [],
_cx => [],
change_name => 'blog',
}, 'Should set up change name option';
throws_ok {
$CLASS->configure($config, { template_directory => '__nonexistent__' });
} 'App::Sqitch::X', 'Should die if --template-directory does not exist';
is $@->ident, 'add', 'Missing directory ident should be "add"';
is $@->message, __x(
'Directory "{dir}" does not exist',
dir => '__nonexistent__',
), 'Missing directory error message should be correct';
throws_ok {
$CLASS->configure($config, { template_directory => 'README.md' });
} 'App::Sqitch::X', 'Should die if --template-directory does is not a dir';
is $@->ident, 'add', 'In alid directory ident should be "add"';
is $@->message, __x(
'"{dir}" is not a directory',
dir => 'README.md',
), 'Invalid directory error message should be correct';
is_deeply $CLASS->configure($config, { template_name => 'foo' }), {
requires => [],
conflicts => [],
note => [],
_cx => [],
template_name => 'foo',
}, 'Should set up template name option';
is_deeply $CLASS->configure($config, {
all => 1,
with_scripts => { deploy => 1, revert => 1, verify => 0 },
use => {
deploy => 'etc/templates/deploy/pg.tmpl',
revert => 'etc/templates/revert/pg.tmpl',
verify => 'etc/templates/verify/pg.tmpl',
whatev => 'etc/templates/verify/pg.tmpl',
},
}), {
all => 1,
requires => [],
conflicts => [],
note => [],
_cx => [],
with_scripts => { deploy => 1, revert => 1, verify => 0 },
templates => {
deploy => file('etc/templates/deploy/pg.tmpl'),
revert => file('etc/templates/revert/pg.tmpl'),
verify => file('etc/templates/verify/pg.tmpl'),
whatev => file('etc/templates/verify/pg.tmpl'),
}
}, 'Should have get template options';
# Test variable configuration.
CONFIG: {
my $config = TestConfig->from(
local => File::Spec->catfile(qw(t add_change.conf))
);
my $dir = dir 't';
is_deeply $CLASS->configure($config, {}), {
template_directory => $dir,
template_name => 'hi',
requires => [],
conflicts => [],
note => [],
_cx => [],
}, 'Variables should by default not be loaded from config';
is_deeply $CLASS->configure($config, {set => { yo => 'dawg' }}), {
template_directory => $dir,
template_name => 'hi',
requires => [],
conflicts => [],
note => [],
_cx => [],
variables => {
foo => 'bar',
baz => [qw(hi there you)],
yo => 'dawg',
},
}, '--set should be merged with config variables';
is_deeply $CLASS->configure($config, {set => { foo => 'ick' }}), {
template_directory => $dir,
template_name => 'hi',
requires => [],
conflicts => [],
note => [],
_cx => [],
variables => {
foo => 'ick',
baz => [qw(hi there you)],
},
}, '--set should be override config variables';
}
##############################################################################
# Test attributes.
is_deeply $add->requires, [], 'Requires should be an arrayref';
is_deeply $add->conflicts, [], 'Conflicts should be an arrayref';
is_deeply $add->note, [], 'Notes should be an arrayref';
is_deeply $add->variables, {}, 'Varibles should be a hashref';
is $add->template_directory, undef, 'Default dir should be undef';
is $add->template_name, undef, 'Default temlate_name should be undef';
is_deeply $add->with_scripts, { map { $_ => 1} qw(deploy revert verify) },
'Default with_scripts should be all true';
is_deeply $add->templates, {}, 'Default templates should be empty';
##############################################################################
# Test _check_script.
isa_ok my $check = $CLASS->can('_check_script'), 'CODE', '_check_script';
my $tmpl = 'etc/templates/verify/pg.tmpl';
is $check->($tmpl), file($tmpl), '_check_script should be okay with script';
throws_ok { $check->('nonexistent') } 'App::Sqitch::X',
'_check_script should die on nonexistent file';
is $@->ident, 'add', 'Nonexistent file ident should be "add"';
is $@->message, __x(
'Template {template} does not exist',
template => 'nonexistent',
), 'Nonexistent file error message should be correct';
throws_ok { $check->('lib') } 'App::Sqitch::X',
'_check_script should die on directory';
is $@->ident, 'add', 'Directory error ident should be "add"';
is $@->message, __x(
'Template {template} is not a file',
template => 'lib',
), 'Directory error message should be correct';
##############################################################################
# Test _config_templates.
READCONFIG: {
my $config = TestConfig->from(
local => file('t/templates.conf')->stringify
);
$config->update('core.top_dir' => dir('test-add')->stringify);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load another sqitch sqitch object';
ok $add = $CLASS->new(sqitch => $sqitch),
'Create add with template config';
is_deeply $add->_config_templates($config), {
deploy => file('etc/templates/deploy/pg.tmpl'),
revert => file('etc/templates/revert/pg.tmpl'),
test => file('etc/templates/verify/pg.tmpl'),
verify => file('etc/templates/verify/pg.tmpl'),
}, 'Should load the config templates';
}
##############################################################################
# Test all_templates().
my $tmpldir = dir 'etc/templates';
my $sysdir = dir 'nonexistent';
my $usrdir = dir 'nonexistent';
my $mock = TestConfig->mock(
system_dir => sub { $sysdir },
user_dir => sub { $usrdir },
);
# First, specify template directory.
ok $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmpldir),
'Add object with template directory';
is $add->template_name, undef, 'Template name should be undef';
my $tname = $add->template_name || $target->engine_key;
is_deeply $add->all_templates($tname), {
deploy => file('etc/templates/deploy/pg.tmpl'),
revert => file('etc/templates/revert/pg.tmpl'),
verify => file('etc/templates/verify/pg.tmpl'),
}, 'Should find all pg templates in directory';
# Make sure it works for a second name.
is_deeply $add->all_templates('sqlite'), {
deploy => file('etc/templates/deploy/sqlite.tmpl'),
revert => file('etc/templates/revert/sqlite.tmpl'),
verify => file('etc/templates/verify/sqlite.tmpl'),
}, 'Should find all sqlite templates in directory';
# Now let it find the templates in the user dir.
$usrdir = dir 'etc';
ok $add = $CLASS->new(sqitch => $sqitch, template_name => 'sqlite'),
'Add object with template name';
is_deeply $add->all_templates($add->template_name), {
deploy => file('etc/templates/deploy/sqlite.tmpl'),
revert => file('etc/templates/revert/sqlite.tmpl'),
verify => file('etc/templates/verify/sqlite.tmpl'),
}, 'Should find all templates in user directory';
# And then the system dir.
($usrdir, $sysdir) = ($sysdir, $usrdir);
ok $add = $CLASS->new(sqitch => $sqitch, template_name => 'mysql'),
'Add object with another template name';
is_deeply $add->all_templates($add->template_name), {
deploy => file('etc/templates/deploy/mysql.tmpl'),
revert => file('etc/templates/revert/mysql.tmpl'),
verify => file('etc/templates/verify/mysql.tmpl'),
}, 'Should find all templates in systsem directory';
# Now make sure it combines directories.
my $tmp_dir = dir tempdir CLEANUP => 1;
for my $script (qw(deploy whatev)) {
my $subdir = $tmp_dir->subdir($script);
$subdir->mkpath;
$subdir->file('pg.tmpl')->touch;
}
ok $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmp_dir),
'Add object with temporary template directory';
is_deeply $add->all_templates($tname), {
deploy => $tmp_dir->file('deploy/pg.tmpl'),
whatev => $tmp_dir->file('whatev/pg.tmpl'),
revert => file('etc/templates/revert/pg.tmpl'),
verify => file('etc/templates/verify/pg.tmpl'),
}, 'Template dir files should override others';
# Add in configured files.
ok $add = $CLASS->new(
sqitch => $sqitch,
template_directory => $tmp_dir,
templates => {
foo => file('foo'),
verify => file('verify'),
deploy => file('deploy'),
},
), 'Add object with configured templates';
is_deeply $add->all_templates($tname), {
deploy => file('deploy'),
verify => file('verify'),
foo => file('foo'),
whatev => $tmp_dir->file('whatev/pg.tmpl'),
revert => file('etc/templates/revert/pg.tmpl'),
}, 'Template dir files should override others';
# Should die when missing files.
$sysdir = $usrdir;
for my $script (qw(deploy revert verify)) {
ok $add = $CLASS->new(
sqitch => $sqitch,
with_scripts => { deploy => 0, revert => 0, verify => 0, $script => 1 },
), "Add object requiring $script template";
throws_ok { $add->all_templates($tname) } 'App::Sqitch::X',
"Should get error for missing $script template";
is $@->ident, 'add', qq{Missing $script template ident should be "add"};
is $@->message, __x(
'Cannot find {script} template',
script => $script,
), "Missing $script template message should be correct";
}
##############################################################################
# Test _slurp().
$tmpl = file(qw(etc templates deploy pg.tmpl));
is $ { $add->_slurp($tmpl)}, contents_of $tmpl,
'_slurp() should load a reference to file contents';
##############################################################################
# Test _add().
my $test_add = sub {
my $engine = shift;
make_path 'test-add';
my $fn = $target->plan_file;
open my $fh, '>', $fn or die "Cannot open $fn: $!";
say $fh "%project=add\n\n";
close $fh or die "Error closing $fn: $!";
END { remove_tree 'test-add' };
my $out = file 'test-add', 'sqitch_change_test.sql';
file_not_exists_ok $out;
ok my $add = $CLASS->new(
sqitch => $sqitch,
template_directory => $tmpldir,
), 'Create add command';
ok $add->_add('sqitch_change_test', $out, $tmpl, 'sqlite', 'add'),
'Write out a script';
file_exists_ok $out;
file_contents_is $out, <get_info, [[__x 'Created {file}', file => $out ]],
'Info should show $out created';
unlink $out;
# Try with requires and conflicts.
ok $add = $CLASS->new(
sqitch => $sqitch,
requires => [qw(foo bar)],
conflicts => ['baz'],
template_directory => $tmpldir,
), 'Create add cmd with requires and conflicts';
$out = file 'test-add', 'another_change_test.sql';
ok $add->_add('another_change_test', $out, $tmpl, 'sqlite', 'add'),
'Write out a script with requires and conflicts';
is_deeply +MockOutput->get_info, [[__x 'Created {file}', file => $out ]],
'Info should show $out created';
file_contents_is $out, <_add('duplicate_extension_test.sql', $out, $tmpl, 'sqlite', 'add');
is_deeply +MockOutput->get_info, [[__x 'Created {file}', file => $out ]],
'Info should show $out created';
is_deeply +MockOutput->get_warn, [[__x(
'File {file} has a double extension of {ext}',
file => $out,
ext => 'sql',
)]], 'Should have warned about double extension';
unlink $out;
};
# First, test with Template::Tiny.
unshift @INC => sub {
my ($self, $file) = @_;
return if $file ne 'Template.pm';
my $i = 0;
return sub {
$_ = 'die "NO ONE HERE";';
return $i = !$i;
}, 1;
};
$test_add->('Template::Tiny');
# Test _add() with Template.
shift @INC;
delete $INC{'Template.pm'};
SKIP: {
skip 'Template Toolkit not installed', 16 unless eval 'use Template; 1';
$test_add->('Template Toolkit');
# Template Toolkit should throw an error on template syntax errors.
ok my $add = $CLASS->new(sqitch => $sqitch, template_directory => $tmpldir),
'Create add command';
my $mock_add = Test::MockModule->new($CLASS);
$mock_add->mock(_slurp => sub { \'[% IF foo %]' });
my $out = file 'test-add', 'sqitch_change_test.sql';
throws_ok { $add->_add('sqitch_change_test', $out, $tmpl) }
'App::Sqitch::X', 'Should get an exception on TT syntax error';
is $@->ident, 'add', 'TT exception ident should be "add"';
is $@->message, __x(
'Error executing {template}: {error}',
template => $tmpl,
error => 'file error - parse error - input text line 1: unexpected end of input',
), 'TT exception message should include the original error message';
}
##############################################################################
# Test execute.
ok $add = $CLASS->new(
sqitch => $sqitch,
template_directory => $tmpldir,
), 'Create another add with template_directory';
# Override request_note().
my $change_mocker = Test::MockModule->new('App::Sqitch::Plan::Change');
my %request_params;
$change_mocker->mock(request_note => sub {
my $self = shift;
%request_params = @_;
return $self->note;
});
# Set up a function to force the reload of the plan.
my $reload = sub {
my $plan = shift;
$plan->_plan( $plan->load);
delete $plan->{$_} for qw(_changes _lines project uri);
};
my $deploy_file = file qw(test-add deploy widgets_table.sql);
my $revert_file = file qw(test-add revert widgets_table.sql);
my $verify_file = file qw(test-add verify widgets_table.sql);
my $plan = $add->default_target->plan;
is $plan->get('widgets_table'), undef, 'Should not have "widgets_table" in plan';
dir_not_exists_ok +File::Spec->catdir('test-add', $_) for qw(deploy revert verify);
ok $add->execute('widgets_table'), 'Add change "widgets_table"';
# Reload the plan.
$reload->($plan);
# Make sure the change was written to the plan file.
isa_ok my $change = $plan->get('widgets_table'), 'App::Sqitch::Plan::Change',
'Added change';
is $change->name, 'widgets_table', 'Change name should be set';
is_deeply [$change->requires], [], 'It should have no requires';
is_deeply [$change->conflicts], [], 'It should have no conflicts';
is_deeply \%request_params, {
for => __ 'add',
scripts => [$change->deploy_file, $change->revert_file, $change->verify_file],
}, 'It should have prompted for a note';
file_exists_ok $_ for ($deploy_file, $revert_file, $verify_file);
file_contents_like $deploy_file, qr/^-- Deploy add:widgets_table/,
'Deploy script should look right';
file_contents_like $revert_file, qr/^-- Revert add:widgets_table/,
'Revert script should look right';
file_contents_like $verify_file, qr/^-- Verify add:widgets_table/,
'Verify script should look right';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $deploy_file],
[__x 'Created {file}', file => $revert_file],
[__x 'Created {file}', file => $verify_file],
[__x 'Added "{change}" to {file}',
change => 'widgets_table',
file => $target->plan_file,
],
], 'Info should have reported file creation';
# Make sure conflicts are avoided and conflicts and requires are respected.
ok $add = $CLASS->new(
change_name => 'foo_table',
sqitch => $sqitch,
requires => ['widgets_table'],
conflicts => [qw(dr_evil joker)],
note => [qw(hello there)],
with_scripts => { verify => 0 },
template_directory => $tmpldir,
), 'Create another add with template_directory and no verify script';
$deploy_file = file qw(test-add deploy foo_table.sql);
$revert_file = file qw(test-add revert foo_table.sql);
$verify_file = file qw(test-add ferify foo_table.sql);
$deploy_file->touch;
file_exists_ok $deploy_file;
file_not_exists_ok $_ for ($revert_file, $verify_file);
is $plan->get('foo_table'), undef, 'Should not have "foo_table" in plan';
ok $add->execute, 'Add change "foo_table"';
file_exists_ok $_ for ($deploy_file, $revert_file);
file_not_exists_ok $verify_file;
$plan = $add->default_target->plan;
isa_ok $change = $plan->get('foo_table'), 'App::Sqitch::Plan::Change',
'"foo_table" change';
is_deeply \%request_params, {
for => __ 'add',
scripts => [$change->deploy_file, $change->revert_file],
}, 'It should have prompted for a note';
is $change->name, 'foo_table', 'Change name should be set to "foo_table"';
is_deeply [$change->requires], [dep 0, 'widgets_table'], 'It should have requires';
is_deeply [$change->conflicts], [map { dep 1, $_ } qw(dr_evil joker)], 'It should have conflicts';
is $change->note, "hello\n\nthere", 'It should have a comment';
is_deeply +MockOutput->get_info, [
[__x 'Skipped {file}: already exists', file => $deploy_file],
[__x 'Created {file}', file => $revert_file],
[__x 'Added "{change}" to {file}',
change => 'foo_table [widgets_table !dr_evil !joker]',
file => $target->plan_file,
],
], 'Info should report skipping file and include dependencies';
# Make sure we die on an unknown argument.
throws_ok { $add->execute(qw(foo bar)) } 'App::Sqitch::X',
'Should get an error on unkonwn argument';
is $@->ident, 'add', 'Unkown argument error ident should be "add"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'foo, bar',
), 'Unknown argument error message should be correct';
# Make sure we die if the passed name conflicts with a target.
TARGET: {
my $mock_add = Test::MockModule->new($CLASS);
$mock_add->mock(parse_args => sub {
return undef, [$target];
});
$mock_add->mock(name => 'blog');
my $mock_target = Test::MockModule->new('App::Sqitch::Target');
$mock_target->mock(name => 'blog');
throws_ok { $add->execute('blog') } 'App::Sqitch::X',
'Should get an error for conflict with target name';
is $@->ident, 'add', 'Conflicting target error ident should be "add"';
is $@->message, __x(
'Name "{name}" identifies a target; use "--change {name}" to use it for the change name',
name => 'blog',
), 'Conflicting target error message should be correct';
}
# Make sure we get a usage message when no name specified.
USAGE: {
my @args;
my $mock_add = Test::MockModule->new($CLASS);
$mock_add->mock(usage => sub { @args = @_; die 'USAGE' });
my $add = $CLASS->new(sqitch => $sqitch);
throws_ok { $add->execute } qr/USAGE/,
'No name arg or option should yield usage';
is_deeply \@args, [$add], 'No args should be passed to usage';
# Should get usage when no change name passed or specified.
@args = ();
throws_ok { $add->execute('pg') } qr/USAGE/,
'No name arg or option should yield usage';
is_deeply \@args, [$add], 'No args should be passed to usage';
# Should get usage when no engine is specified, either.
@args = ();
$add = $CLASS->new(sqitch => App::Sqitch->new(config => TestConfig->new));
throws_ok { $add->execute } qr/USAGE/,
'No name arg or option should yield usage';
is_deeply \@args, [$add], 'No args should be passed to usage';
}
# Make sure --open-editor works
MOCKSHELL: {
my $sqitch_mocker = Test::MockModule->new('App::Sqitch');
my $shell_cmd;
$sqitch_mocker->mock(shell => sub { $shell_cmd = $_[1] });
$sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ });
ok $add = $CLASS->new(
sqitch => $sqitch,
template_directory => $tmpldir,
note => ['Testing --open-editor'],
open_editor => 1,
), 'Create another add with open_editor';
my $deploy_file = file qw(test-add deploy open_editor.sql);
my $revert_file = file qw(test-add revert open_editor.sql);
my $verify_file = file qw(test-add verify open_editor.sql);
my $plan = $add->default_target->plan;
is $plan->get('open_editor'), undef, 'Should not have "open_editor" in plan';
ok $add->execute('open_editor'), 'Add change "open_editor"';
# Instantiate fresh target and plan to force the file to be re-read.
$target = App::Sqitch::Target->new(sqitch => $sqitch);
$plan = App::Sqitch::Plan->new( sqitch => $sqitch, target => $target );
isa_ok my $change = $plan->get('open_editor'), 'App::Sqitch::Plan::Change',
'Added change';
is $change->name, 'open_editor', 'Change name should be set';
is $shell_cmd, join(' ', $sqitch->editor, $deploy_file, $revert_file, $verify_file),
'It should have prompted to edit sql files';
file_exists_ok $_ for ($deploy_file, $revert_file, $verify_file);
file_contents_like +File::Spec->catfile(qw(test-add deploy open_editor.sql)),
qr/^-- Deploy add:open_editor/, 'Deploy script should look right';
file_contents_like +File::Spec->catfile(qw(test-add revert open_editor.sql)),
qr/^-- Revert add:open_editor/, 'Revert script should look right';
file_contents_like +File::Spec->catfile(qw(test-add verify open_editor.sql)),
qr/^-- Verify add:open_editor/, 'Verify script should look right';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $deploy_file],
[__x 'Created {file}', file => $revert_file],
[__x 'Created {file}', file => $verify_file],
[__x 'Added "{change}" to {file}',
change => 'open_editor',
file => $target->plan_file,
],
], 'Info should have reported file creation';
};
# Make sure an additional script and an exclusion work properly.
EXTRAS: {
ok my $add = $CLASS->new(
sqitch => $sqitch,
template_directory => $tmpldir,
with_scripts => { verify => 0 },
templates => { whatev => file(qw(etc templates verify mysql.tmpl)) },
note => ['Testing custom scripts'],
), 'Create another add with custom script and no verify';
my $deploy_file = file qw(test-add deploy custom_script.sql);
my $revert_file = file qw(test-add revert custom_script.sql);
my $verify_file = file qw(test-add verify custom_script.sql);
my $whatev_file = file qw(test-add whatev custom_script.sql);
ok $add->execute('custom_script'), 'Add change "custom_script"';
my $plan = $add->default_target->plan;
isa_ok my $change = $plan->get('custom_script'), 'App::Sqitch::Plan::Change',
'Added change';
is $change->name, 'custom_script', 'Change name should be set';
is_deeply [$change->requires], [], 'It should have no requires';
is_deeply [$change->conflicts], [], 'It should have no conflicts';
is_deeply \%request_params, {
for => __ 'add',
scripts => [ map { $change->script_file($_) } qw(deploy revert whatev)]
}, 'It should have prompted for a note';
file_exists_ok $_ for ($deploy_file, $revert_file, $whatev_file);
file_not_exists_ok $verify_file;
file_contents_like $deploy_file, qr/^-- Deploy add:custom_script/,
'Deploy script should look right';
file_contents_like $revert_file, qr/^-- Revert add:custom_script/,
'Revert script should look right';
file_contents_like $whatev_file, qr/^-- Verify add:custom_script/,
'Whatev script should look right';
file_contents_unlike $whatev_file, qr/^BEGIN/,
'Whatev script should be based on the MySQL verify script';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $deploy_file],
[__x 'Created {file}', file => $revert_file],
[__x 'Created {file}', file => $whatev_file],
[__x 'Added "{change}" to {file}',
change => 'custom_script',
file => $target->plan_file,
],
], 'Info should have reported file creation';
# Relod the plan file to make sure change is written to it.
$reload->($plan);
isa_ok $change = $plan->get('custom_script'), 'App::Sqitch::Plan::Change',
'Added change in reloaded plan';
}
# Make sure a configuration with multiple plans works.
MULTIPLAN: {
make_path 'test-multiadd';
END { remove_tree 'test-multiadd' };
chdir 'test-multiadd';
my $config = TestConfig->new(
'core.engine' => 'pg',
'engine.pg.top_dir' => 'pg',
'engine.sqlite.top_dir' => 'sqlite',
'engine.mysql.top_dir' => 'mysql',
);
# Create plan files and determine the scripts that to be created.
my @scripts = map {
my $dir = dir $_;
$dir->mkpath;
$dir->file('sqitch.plan')->spew("%project=add\n\n");
map { $dir->file($_, 'widgets.sql') } qw(deploy revert verify);
} qw(pg sqlite mysql);
# Load up the configuration for this project.
my $sqitch = App::Sqitch->new(config => $config);
ok my $add = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another add with custom multiplan config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 3, 'Should have three targets';
# Make sure the target list matches our script list order (by engine).
# pg always comes first, as primary engine, but the other two are random.
push @targets, splice @targets, 1, 1 if $targets[1]->engine_key ne 'sqlite';
# Let's do this thing!
ok $add->execute('widgets'), 'Add change "widgets" to all plans';
ok $_->plan->get('widgets'), 'Should have "widgets" in ' . $_->engine_key . ' plan'
for @targets;
file_exists_ok $_ for @scripts;
# Make sure we see the proper output.
my $info = MockOutput->get_info;
my $ekey = $targets[1]->engine_key;
if ($info->[4][0] !~ /$ekey/) {
# Got the targets in a different order. So reorder results to match.
push @{ $info } => splice @{ $info }, 4, 4;
}
is_deeply $info, [
(map { [__x 'Created {file}', file => $_] } @scripts[0..2]),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[0]->plan_file,
],
(map { [__x 'Created {file}', file => $_] } @scripts[3..5]),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[1]->plan_file,
],
(map { [__x 'Created {file}', file => $_] } @scripts[6..8]),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[2]->plan_file,
],
], 'Info should have reported all script creations and plan updates';
# Make sure we get an error using --all and a target arg.
throws_ok { $add->execute('foo', 'pg' ) } 'App::Sqitch::X',
'Should get an error for --all and a target arg';
is $@->ident, 'add', 'Mixed arguments error ident should be "add"';
is $@->message, __(
'Cannot specify both --all and engine, target, or plan arugments'
), 'Mixed arguments error message should be correct';
# Now try adding a change to just one engine. Remove --all
ok $add = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create yet another add with custom multiplan config';
ok $add->execute('choc', 'sqlite'), 'Add change "choc" to the sqlite plan';
my %targets = map { $_->engine_key => $_ }
App::Sqitch::Target->all_targets(sqitch => $sqitch);
is keys %targets, 3, 'Should still have three targets';
ok !$targets{pg}->plan->get('choc'), 'Should not have "choc" in the pg plan';
ok !$targets{mysql}->plan->get('choc'), 'Should not have "choc" in the mysql plan';
ok $targets{sqlite}->plan->get('choc'), 'Should have "choc" in the sqlite plan';
@scripts = map {
my $dir = dir $_;
$dir->mkpath;
map { $dir->file($_, 'choc.sql') } qw(deploy revert verify);
} qw(sqlite pg mysql);
file_exists_ok $_ for @scripts[0..2];
file_not_exists_ok $_ for @scripts[3..8];
is_deeply +MockOutput->get_info, [
(map { [__x 'Created {file}', file => $_] } @scripts[0..2]),
[
__x 'Added "{change}" to {file}',
change => 'choc',
file => $targets{sqlite}->plan_file,
],
], 'Info should have reported sqlite choc script creations and plan updates';
chdir File::Spec->updir;
}
# Make sure we update only one plan but write out multiple target files.
MULTITARGET: {
remove_tree 'test-multiadd';
make_path 'test-multiadd';
chdir 'test-multiadd';
my $config = TestConfig->new(
'core.engine' => 'pg',
'core.plan_file' => 'sqitch.plan',
'engine.pg.top_dir' => 'pg',
'engine.sqlite.top_dir' => 'sqlite',
'add.all' => 1,
);
file('sqitch.plan')->spew("%project=add\n\n");
# Create list of scripts to be created.
my @scripts = map {
my $dir = dir $_;
$dir->mkpath;
map { $dir->file($_, 'widgets.sql') } qw(deploy revert verify);
} qw(pg sqlite);
# Load up the configuration for this project.
my $sqitch = App::Sqitch->new(config => $config);
ok my $add = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple targets'],
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another add with single plan, multi-target config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
is $targets[0]->plan_file, $targets[1]->plan_file,
'Targets should use the same plan file';
# Let's do this thing!
ok $add->execute('widgets'), 'Add change "widgets" to all plans';
ok $targets[0]->plan->get('widgets'), 'Should have "widgets" in the plan';
file_exists_ok $_ for @scripts;
is_deeply \%request_params, {
for => __ 'add',
scripts => \@scripts,
}, 'Should have the proper files listed in the note promt';
is_deeply +MockOutput->get_info, [
(map { [__x 'Created {file}', file => $_] } @scripts),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[0]->plan_file,
],
], 'Info should have reported all script creations and one plan update';
chdir File::Spec->updir;
}
# Make sure we're okay with multiple plans sharing the same top dir.
ONETOP: {
remove_tree 'test-multiadd';
make_path 'test-multiadd';
chdir 'test-multiadd';
my $config = TestConfig->new(
'core.engine' => 'pg',
'engine.pg.plan_file' => 'pg.plan',
'engine.sqlite.plan_file' => 'sqlite.plan',
);
file("$_.plan")->spew("%project=add\n\n") for qw(pg sqlite);
# Create list of scripts to be created.
my @scripts = map { file $_, 'widgets.sql' } qw(deploy revert verify);
# Load up the configuration for this project.
my $sqitch = App::Sqitch->new(config => $config);
ok my $add = $CLASS->new(
sqitch => $sqitch,
note => ['Testing two targets, one top_dir'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another add with two targets, one top dir';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
is $targets[0]->plan_file, file('pg.plan'),
'First target plan should be in pg.plan';
is $targets[1]->plan_file, file('sqlite.plan'),
'Second target plan should be in sqlite.plan';
# Let's do this thing!
ok $add->execute('widgets'), 'Add change "widgets" to all plans';
ok $_->plan->get('widgets'), 'Should have "widgets" in ' . $_->engine_key . ' plan'
for @targets;
file_exists_ok $_ for @scripts;
is_deeply \%request_params, {
for => __ 'add',
scripts => \@scripts,
}, 'Should have the proper files listed in the note promt';
is_deeply my $info = MockOutput->get_info, [
(map { [__x 'Created {file}', file => $_] } @scripts),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[0]->plan_file,
],
(map { [__x 'Skipped {file}: already exists', file => $_] } @scripts),
[
__x 'Added "{change}" to {file}',
change => 'widgets',
file => $targets[1]->plan_file,
],
], 'Info should have script creations and skips';
chdir File::Spec->updir;
}
##############################################################################
# Test options parsing.
can_ok $CLASS, 'options', '_parse_opts';
ok $add = $CLASS->new({ sqitch => $sqitch }), "Create a $CLASS object again";
is_deeply $add->_parse_opts([]),
{ with_scripts => { map { $_ => 1} qw(deploy revert verify) } },
'Base _parse_opts should return the script config';
is_deeply $add->_parse_opts([1]), {
with_scripts => { deploy => 1, verify => 1, revert => 1 },
}, '_parse_opts() hould use options spec';
my $args = [qw(
--note foo
--template bar
whatever
)];
is_deeply $add->_parse_opts($args), {
note => ['foo'],
template_name => 'bar',
with_scripts => { deploy => 1, verify => 1, revert => 1 },
}, '_parse_opts() should parse options spec';
is_deeply $args, ['whatever'], 'Args array should be cleared of options';
# Make sure --set works.
push @{ $args }, '--set' => 'schema=foo', '--set' => 'table=bar';
is_deeply $add->_parse_opts($args), {
set => { schema => 'foo', table => 'bar' },
with_scripts => { deploy => 1, verify => 1, revert => 1 },
}, '_parse_opts() should parse --set options';
is_deeply $args, ['whatever'], 'Args array should be cleared of options';
# make sure --set works with repeating keys.
push @{ $args }, '--set' => 'column=id', '--set' => 'column=name';
is_deeply $add->_parse_opts($args), {
set => { column => [qw(id name)] },
with_scripts => { deploy => 1, verify => 1, revert => 1 },
}, '_parse_opts() should parse --set options with repeting key';
is_deeply $args, ['whatever'], 'Args array should be cleared of options';
# Make sure --with and --use work.
push @{ $args }, qw(--with deploy --without verify --use),
"foo=$tmpl";
is_deeply $add->_parse_opts($args), {
with_scripts => { deploy => 1, verify => 0, revert => 1 },
use => { foo => $tmpl }
}, '_parse_opts() should parse --with, --without, and --user';
is_deeply $args, ['whatever'], 'Args array should be cleared of options';
LICENSE 100644 001751 000166 2241 15004170404 14702 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 This software is Copyright (c) 2012-2025 by "iovation Inc., David E. Wheeler".
This is free software, licensed under:
The MIT (X11) License
The MIT License
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated
documentation files (the "Software"), to deal in the Software
without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to
whom the Software is furnished to do so, subject to the
following conditions:
The above copyright notice and this permission notice shall
be included in all copies or substantial portions of the
Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT
WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE AND NONINFRINGEMENT. IN NO EVENT
SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
plan.t 100644 001751 000166 236644 15004170404 15337 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Locale::TextDomain qw(App-Sqitch);
use Path::Class;
use Test::Exception;
use Test::File;
use Test::Deep;
use Test::File::Contents;
use Encode;
#use Test::NoWarnings;
use File::Path qw(make_path remove_tree);
use App::Sqitch::DateTime;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan';
use_ok $CLASS or die;
}
can_ok $CLASS, qw(
sqitch
target
file
changes
position
load
syntax_version
project
uri
_parse
check_changes
open_script
);
my $config = TestConfig->new('core.engine' => 'sqlite');
my $sqitch = App::Sqitch->new( config => $config );
my $target = App::Sqitch::Target->new( sqitch => $sqitch );
isa_ok my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target),
$CLASS;
is $plan->file, $target->plan_file, 'File should be coopied from Target';
# Set up some some utility functions for creating changes.
sub blank {
App::Sqitch::Plan::Blank->new(
plan => $plan,
lspace => $_[0] // '',
note => $_[1] // '',
);
}
my $prev_tag;
my $prev_change;
my %seen;
sub clear {
undef $prev_tag;
undef $prev_change;
%seen = ();
return ();
}
my $ts = App::Sqitch::DateTime->new(
year => 2012,
month => 7,
day => 16,
hour => 17,
minute => 25,
second => 7,
time_zone => 'UTC',
);
sub ts($) {
my $str = shift || return $ts;
my @parts = split /[-:T]/ => $str;
return App::Sqitch::DateTime->new(
year => $parts[0],
month => $parts[1],
day => $parts[2],
hour => $parts[3],
minute => $parts[4],
second => $parts[5],
time_zone => 'UTC',
);
}
my $vivify = 0;
my $project;
sub dep($) {
App::Sqitch::Plan::Depend->new(
plan => $plan,
(defined $project ? (project => $project) : ()),
%{ App::Sqitch::Plan::Depend->parse(shift) },
)
}
sub change($) {
my $p = shift;
if ( my $op = delete $p->{op} ) {
@{ $p }{ qw(lopspace operator ropspace) } = split /([+-])/, $op;
$p->{$_} //= '' for qw(lopspace ropspace);
}
$p->{requires} = [ map { dep $_ } @{ $p->{requires} } ]
if $p->{requires};
$p->{conflicts} = [ map { dep "!$_" } @{ $p->{conflicts} }]
if $p->{conflicts};
$prev_change = App::Sqitch::Plan::Change->new(
plan => $plan,
timestamp => ts delete $p->{ts},
planner_name => 'Barack Obama',
planner_email => 'potus@whitehouse.gov',
( $prev_tag ? ( since_tag => $prev_tag ) : () ),
( $prev_change ? ( parent => $prev_change ) : () ),
%{ $p },
);
if (my $duped = $seen{ $p->{name} }) {
$duped->add_rework_tags(map { $seen{$_}-> tags } @{ $p->{rtag} });
}
$seen{ $p->{name} } = $prev_change;
if ($vivify) {
$prev_change->id;
$prev_change->tags;
}
return $prev_change;
}
sub tag($) {
my $p = shift;
my $ret = delete $p->{ret};
$prev_tag = App::Sqitch::Plan::Tag->new(
plan => $plan,
change => $prev_change,
timestamp => ts delete $p->{ts},
planner_name => 'Barack Obama',
planner_email => 'potus@whitehouse.gov',
%{ $p },
);
$prev_change->add_tag($prev_tag);
$prev_tag->id, if $vivify;
return $ret ? $prev_tag : ();
}
sub prag {
App::Sqitch::Plan::Pragma->new(
plan => $plan,
lspace => $_[0] // '',
hspace => $_[1] // '',
name => $_[2],
(defined $_[3] ? (lopspace => $_[3]) : ()),
(defined $_[4] ? (operator => $_[4]) : ()),
(defined $_[5] ? (ropspace => $_[5]) : ()),
(defined $_[6] ? (value => $_[6]) : ()),
rspace => $_[7] // '',
note => $_[8] // '',
);
}
my $mocker = Test::MockModule->new($CLASS);
# Do no sorting for now.
my $sorted = 0;
sub sorted () {
my $ret = $sorted;
$sorted = 0;
return $ret;
}
$mocker->mock(check_changes => sub { $sorted++; shift, shift, shift; @_ });
sub version () {
prag(
'', '', 'syntax-version', '', '=', '', App::Sqitch::Plan::SYNTAX_VERSION
);
}
##############################################################################
# Test parsing.
my $file = file qw(t plans widgets.plan);
my $fh = $file->open('<:utf8_strict');
ok my $parsed = $plan->_parse($file, $fh),
'Should parse simple "widgets.plan"';
is sorted, 1, 'Should have sorted changes';
isa_ok $parsed->{changes}, 'ARRAY', 'changes';
isa_ok $parsed->{lines}, 'ARRAY', 'lines';
cmp_deeply $parsed->{changes}, [
clear,
change { name => 'hey', ts => '2012-07-16T14:01:20' },
change { name => 'you', ts => '2012-07-16T14:01:35' },
tag {
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T14:02:05',
rspace => ' '
},
,
], 'All "widgets.plan" changes should be parsed';
cmp_deeply $parsed->{lines}, [
clear,
version,
prag( '', '', 'project', '', '=', '', 'widgets'),
blank('', 'This is a note'),
blank(),
blank(' ', 'And there was a blank line.'),
blank(),
change { name => 'hey', ts => '2012-07-16T14:01:20' },
change { name => 'you', ts => '2012-07-16T14:01:35' },
tag {
ret => 1,
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T14:02:05',
rspace => ' '
},
], 'All "widgets.plan" lines should be parsed';
# Plan with multiple tags.
$file = file qw(t plans multi.plan);
$fh = $file->open('<:utf8_strict');
ok $parsed = $plan->_parse($file, $fh),
'Should parse multi-tagged "multi.plan"';
is sorted, 2, 'Should have sorted changes twice';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'multi',
}, 'Should have captured the multi pragmas';
cmp_deeply $parsed, {
changes => [
clear,
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar' },
tag { name => 'baz' },
],
lines => [
clear,
version,
prag( '', '', 'project', '', '=', '', 'multi'),
blank('', 'This is a note'),
blank(),
blank('', 'And there was a blank line.'),
blank(),
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
ret => 1,
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
blank(' '),
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar', ret => 1 },
tag { name => 'baz', ret => 1 },
],
}, 'Should have "multi.plan" lines and changes';
# Try a plan with changes appearing without a tag.
$file = file qw(t plans changes-only.plan);
$fh = $file->open('<:utf8_strict');
ok $parsed = $plan->_parse($file, $fh), 'Should read plan with no tags';
is sorted, 1, 'Should have sorted changes';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'changes_only',
}, 'Should have captured the changes-only pragmas';
cmp_deeply $parsed, {
lines => [
clear,
version,
prag( '', '', 'project', '', '=', '', 'changes_only'),
blank('', 'This is a note'),
blank(),
blank('', 'And there was a blank line.'),
blank(),
change { name => 'hey' },
change { name => 'you' },
change { name => 'whatwhatwhat' },
],
changes => [
clear,
change { name => 'hey' },
change { name => 'you' },
change { name => 'whatwhatwhat' },
],
}, 'Should have lines and changes for tagless plan';
# Try plans with DOS line endings.
$file = file qw(t plans dos.plan);
$fh = $file->open('<:utf8_strict');
ok $parsed = $plan->_parse($file, $fh), 'Should read plan with DOS line endings';
is sorted, 1, 'Should have sorted changes';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'dos',
}, 'Should have captured the dos pragmas';
# Try a plan with a bad change name.
$file = file qw(t plans bad-change.plan);
$fh = $file->open('<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on plan with bad change name';
is $@->ident, 'parse', 'Bad change name error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 5,
error => __(
qq{Invalid name; names must not begin with punctuation, }
. 'contain "@", ":", "#", "\\", "[", "]", or blanks, or end in punctuation or digits following punctuation',
),
), 'And the bad change name error message should be correct';
is sorted, 0, 'Should not have sorted changes';
my @bad_names = (
'^foo', # No leading punctuation
'foo^', # No trailing punctuation
'foo^6', # No trailing punctuation+digit
'foo^666', # No trailing punctuation+digits
'%hi', # No leading punctuation
'hi!', # No trailing punctuation
'foo@bar', # No @ allowed at all
'foo:bar', # No : allowed at all
'foo\\bar', # No \ allowed at all
'+foo', # No leading +
'-foo', # No leading -
'@foo', # No leading @
);
# Try other invalid change and tag name issues.
my $prags = '%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION
. "\n%project=test\n\n";
for my $name (@bad_names) {
for my $line ("+$name", "\@$name") {
my $buf = $prags . $line;
my $fh = IO::File->new(\$buf, '<:utf8_strict');
throws_ok { $plan->_parse('baditem', $fh) } 'App::Sqitch::X',
qq{Should die on plan with bad name "$line"};
is $@->ident, 'parse', 'Exception ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => 'baditem',
lineno => 4,
error => __(
qq{Invalid name; names must not begin with punctuation, }
. 'contain "@", ":", "#", "\\", "[", "]", or blanks, or end in punctuation or digits following punctuation',
),
), qq{And "$line" should trigger the appropriate message};
is sorted, 0, 'Should not have sorted changes';
}
}
# Valid change names but invalid tag names.
my @bad_tags = (
'foo/bar', # No slash allowed in tags
);
for my $name (@bad_tags) {
my $line = "\@$name" . ' 2012-07-16T17:25:07Z X ';
my ($sep) = $name =~ qr{([/\\])};
my $buf = $prags . $line;
my $fh = IO::File->new(\$buf, '<:utf8_strict');
throws_ok { $plan->_parse('baditem', $fh) } 'App::Sqitch::X',
qq{Should die on plan with bad name "$line"};
is $@->ident, 'parse', 'Exception ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => 'baditem',
lineno => 4,
error => __x(
'Tag "{tag}" contains illegal character {sep}',
tag => $name,
sep => $sep,
),
), qq{And "$name" should trigger the appropriate message};
is sorted, 0, 'Should not have sorted changes';
}
# Try some valid change and tag names.
my $tsnp = '2012-07-16T17:25:07Z Barack Obama ';
my $foo_proj = App::Sqitch::Plan::Pragma->new(
plan => $plan,
name => 'project',
value => 'foo',
operator => '=',
);
for my $name (
'foo', # alpha
'12', # digits
't', # char
'6', # digit
'阱阪阬', # multibyte
'foo,bar', # middle punct
'beta1', # ending digit
'foo_', # ending underscore
'_foo', # leading underscore
'v1.0-1b', # punctuation followed by digit in middle
'v1.2-1', # version number with dash
'v1.2+1', # version number with plus
'v1.2_1', # version number with underscore
) {
# Test a change name.
my $lines = encode_utf8 "\%project=foo\n\n$name $tsnp";
my $fh = IO::File->new(\$lines, '<:utf8_strict');
ok my $parsed = $plan->_parse('odditem', $fh),
encode_utf8(qq{Should parse "$name"});
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'foo',
}, encode_utf8("Should have captured the $name pragmas");
cmp_deeply $parsed, {
changes => [ clear, change { name => $name } ],
lines => [ clear, version, $foo_proj, blank, change { name => $name } ],
}, encode_utf8(qq{Should have pragmas in plan with change "$name"});
# Test a tag name.
my $tag = '@' . $name;
$lines = encode_utf8 "\%project=foo\n\nfoo $tsnp\n$tag $tsnp";
$fh = IO::File->new(\$lines, '<:utf8_strict');
ok $parsed = $plan->_parse('gooditem', $fh),
encode_utf8(qq{Should parse "$tag"});
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'foo',
}, encode_utf8(qq{Should have pragmas in plan with tag "$name"});
cmp_deeply $parsed, {
changes => [ clear, change { name => 'foo' }, tag { name => $name } ],
lines => [
clear,
version,
$foo_proj,
blank,
change { name => 'foo' },
tag { name => $name, ret => 1 }
],
}, encode_utf8(qq{Should have line and change for "$tag"});
}
is sorted, 26, 'Should have sorted changes 26 times';
# Try planning with other reserved names.
for my $reserved (qw(HEAD ROOT)) {
my $root = $prags . '@' . $reserved . " $tsnp";
$file = file qw(t plans), "$reserved.plan";
$fh = IO::File->new(\$root, '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
qq{Should die on plan with reserved tag "\@$reserved"};
is $@->ident, 'parse', qq{\@$reserved exception should have ident "plan"};
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __x(
'"{name}" is a reserved name',
name => '@' . $reserved,
),
), qq{And the \@$reserved error message should be correct};
is sorted, 0, "Should have sorted \@$reserved changes nonce";
}
# Try a plan with a change name that looks like a sha1 hash.
my $sha1 = '6c2f28d125aff1deea615f8de774599acf39a7a1';
$file = file qw(t plans sha1.plan);
$fh = IO::File->new(\"$prags$sha1 $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on plan with SHA1 change name';
is $@->ident, 'parse', 'The SHA1 error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __x(
'"{name}" is invalid because it could be confused with a SHA1 ID',
name => $sha1,
),
), 'And the SHA1 error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan with a tag but no change.
$file = file qw(t plans tag-no-change.plan);
$fh = IO::File->new(\"$prags\@foo $tsnp\nbar $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on plan with tag but no preceding change';
is $@->ident, 'parse', 'The missing change error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __x(
'Tag "{tag}" declared without a preceding change',
tag => 'foo',
),
), 'And the missing change error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan with a duplicate tag name.
$file = file qw(t plans dupe-tag.plan);
$fh = $file->open('<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on plan with dupe tag';
is $@->ident, 'parse', 'The dupe tag error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 12,
error => __x(
'Tag "{tag}" duplicates earlier declaration on line {line}',
tag => 'bar',
line => 7,
),
), 'And the missing change error message should be correct';
is sorted, 2, 'Should have sorted changes twice';
# Try a plan with a duplicate change within a tag section.
$file = file qw(t plans dupe-change.plan);
$fh = $file->open('<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on plan with dupe change';
is $@->ident, 'parse', 'The dupe change error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 9,
error => __x(
'Change "{change}" duplicates earlier declaration on line {line}',
change => 'greets',
line => 7,
),
), 'And the dupe change error message should be correct';
is sorted, 1, 'Should have sorted changes once';
# Try a plan with an invalid requirement.
$fh = IO::File->new(\"\%project=foo\n\nfoo [^bar] $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse('badreq', $fh ) } 'App::Sqitch::X',
'Should die on invalid dependency';
is $@->ident, 'parse', 'The invalid dependency error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => 'badreq',
lineno => 3,
error => __x(
'"{dep}" is not a valid dependency specification',
dep => '^bar',
),
), 'And the invalid dependency error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan with duplicate requirements.
$fh = IO::File->new(\"\%project=foo\n\nfoo [bar baz bar] $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse('dupedep', $fh ) } 'App::Sqitch::X',
'Should die on dupe dependency';
is $@->ident, 'parse', 'The dupe dependency error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => 'dupedep',
lineno => 3,
error => __x(
'Duplicate dependency "{dep}"',
dep => 'bar',
),
), 'And the dupe dependency error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan without a timestamp.
$file = file qw(t plans no-timestamp.plan);
$fh = IO::File->new(\"${prags}foo hi ", '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on change with no timestamp';
is $@->ident, 'parse', 'The missing timestamp error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __ 'Missing timestamp',
), 'And the missing timestamp error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan without a planner.
$file = file qw(t plans no-planner.plan);
$fh = IO::File->new(\"${prags}foo 2012-07-16T23:12:34Z", '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on change with no planner';
is $@->ident, 'parse', 'The missing parsener error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __ 'Missing planner name and email',
), 'And the missing planner error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan with neither timestamp nor planner.
$file = file qw(t plans no-timestamp-or-planner.plan);
$fh = IO::File->new(\"%project=foo\n\nfoo", '<:utf8_strict');
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should die on change with no timestamp or planner';
is $@->ident, 'parse', 'The missing timestamp or parsener error ident should be "parse"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 3,
error => __ 'Missing timestamp and planner name and email',
), 'And the missing timestamp or planner error message should be correct';
is sorted, 0, 'Should have sorted changes nonce';
# Try a plan with pragmas.
$file = file qw(t plans pragmas.plan);
$fh = $file->open('<:utf8_strict');
ok $parsed = $plan->_parse($file, $fh),
'Should parse plan with pragmas"';
is sorted, 1, 'Should have sorted changes once';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
foo => 'bar',
project => 'pragmata',
uri => 'https://github.com/sqitchers/sqitch/',
strict => 1,
}, 'Should have captured all of the pragmas';
cmp_deeply $parsed, {
changes => [
clear,
change { name => 'hey' },
change { name => 'you' },
],
lines => [
clear,
prag( '', ' ', 'syntax-version', '', '=', '', App::Sqitch::Plan::SYNTAX_VERSION),
prag( ' ', '', 'foo', ' ', '=', ' ', 'bar', ' ', 'lolz'),
prag( '', ' ', 'project', '', '=', '', 'pragmata'),
prag( '', ' ', 'uri', '', '=', '', 'https://github.com/sqitchers/sqitch/'),
prag( '', ' ', 'strict'),
blank(),
change { name => 'hey' },
change { name => 'you' },
blank(),
],
}, 'Should have "multi.plan" lines and changes';
# Try a plan with deploy/revert operators.
$file = file qw(t plans deploy-and-revert.plan);
$fh = $file->open('<:utf8_strict');
ok $parsed = $plan->_parse($file, $fh),
'Should parse plan with deploy and revert operators';
is sorted, 2, 'Should have sorted changes twice';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'deploy_and_revert',
}, 'Should have captured the deploy-and-revert pragmas';
cmp_deeply $parsed, {
changes => [
clear,
change { name => 'hey', op => '+' },
change { name => 'you', op => '+' },
change { name => 'dr_evil', op => '+ ', lspace => ' ' },
tag { name => 'foo' },
change { name => 'this/rocks', op => '+', pspace => ' ' },
change { name => 'hey-there', lspace => ' ' },
change {
name => 'dr_evil',
note => 'revert!',
op => '-',
rspace => ' ',
pspace => ' ',
rtag => [qw(dr_evil)],
},
tag { name => 'bar', lspace => ' ' },
],
lines => [
clear,
version,
prag( '', '', 'project', '', '=', '', 'deploy_and_revert'),
blank,
change { name => 'hey', op => '+' },
change { name => 'you', op => '+' },
change { name => 'dr_evil', op => '+ ', lspace => ' ' },
tag { name => 'foo', ret => 1 },
blank( ' '),
change { name => 'this/rocks', op => '+', pspace => ' ' },
change { name => 'hey-there', lspace => ' ' },
change {
name => 'dr_evil',
note => 'revert!',
op => '-',
rspace => ' ',
pspace => ' ',
rtag => [qw(dr_evil)],
},
tag { name => 'bar', lspace => ' ', ret => 1 },
],
}, 'Should have "deploy-and-revert.plan" lines and changes';
# Try a non-existent plan file with load().
$file = file qw(t hi nonexistent.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
throws_ok { App::Sqitch::Plan->new(sqitch => $sqitch, target => $target)->load } 'App::Sqitch::X',
'Should get exception for nonexistent plan file';
is $@->ident, 'plan', 'Nonexistent plan file ident should be "plan"';
is $@->message, __x(
'Plan file {file} does not exist',
file => $file,
), 'Nonexistent plan file message should be correct';
# Try a plan with dependencies.
$file = file qw(t plans dependencies.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS,
'Plan with sqitch with plan file with dependencies';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
ok $parsed = $plan->load, 'Load plan with dependencies file';
is_deeply $parsed->{changes}, [
clear,
change { name => 'roles', op => '+' },
change { name => 'users', op => '+', pspace => ' ', requires => ['roles'] },
change { name => 'add_user', op => '+', pspace => ' ', requires => [qw(users roles)] },
change { name => 'dr_evil', op => '+' },
tag { name => 'alpha' },
change {
name => 'users',
op => '+',
pspace => ' ',
requires => ['users@alpha'],
rtag => [qw(dr_evil add_user users)],
},
change { name => 'dr_evil', op => '-', rtag => [qw(dr_evil)] },
change {
name => 'del_user',
op => '+',
pspace => ' ',
requires => ['users'],
conflicts => ['dr_evil']
},
], 'The changes should include the dependencies';
is sorted, 2, 'Should have sorted changes twice';
# Try a plan with cross-project dependencies.
$file = file qw(t plans project_deps.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS,
'Plan with sqitch with plan file with project deps';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
ok $parsed = $plan->load, 'Load plan with project deps file';
is_deeply $parsed->{changes}, [
clear,
change { name => 'roles', op => '+' },
change { name => 'users', op => '+', pspace => ' ', requires => ['roles'] },
change { name => 'add_user', op => '+', pspace => ' ', requires => [qw(users roles log:logger)] },
change { name => 'dr_evil', op => '+' },
tag { name => 'alpha' },
change {
name => 'users',
op => '+',
pspace => ' ',
requires => ['users@alpha'],
rtag => [qw(dr_evil add_user users)],
},
change { name => 'dr_evil', op => '-', rtag => [qw(dr_evil)] },
change {
name => 'del_user',
op => '+',
pspace => ' ',
requires => ['users', 'log:logger@beta1'],
conflicts => ['dr_evil']
},
], 'The changes should include the cross-project deps';
is sorted, 2, 'Should have sorted changes twice';
# Should fail with dependencies on tags.
$file = file qw(t plans tag_dependencies.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
$fh = IO::File->new(\"%project=tagdep\n\nfoo $tsnp\n\@bar [:foo] $tsnp", '<:utf8_strict');
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target),
$CLASS, 'Plan with sqitch with plan with tag dependencies';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
throws_ok { $plan->_parse($file, $fh) } 'App::Sqitch::X',
'Should get an exception for tag with dependencies';
is $@->ident, 'parse', 'The tag dependencies error ident should be "plan"';
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => $file,
lineno => 4,
error => __ 'Tags may not specify dependencies',
), 'And the tag dependencies error message should be correct';
# Make sure that lines() loads the plan.
$file = file qw(t plans multi.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target), $CLASS,
'Plan with sqitch with plan file';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
cmp_deeply [$plan->lines], [
clear,
version,
prag( '', '', 'project', '', '=', '', 'multi'),
blank('', 'This is a note'),
blank(),
blank('', 'And there was a blank line.'),
blank(),
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
ret => 1,
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
blank(' '),
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar', ret => 1 },
tag { name => 'baz', ret => 1 },
], 'Lines should be parsed from file';
$vivify = 1;
cmp_deeply [$plan->changes], [
clear,
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar' },
tag { name => 'baz' },
], 'Changes should be parsed from file';
clear;
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' };
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' };
my $foo_tag = tag {
ret => 1,
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
};
change { name => 'this/rocks', pspace => ' ' };
change { name => 'hey-there', rspace => ' ', note => 'trailing note!' };
cmp_deeply [$plan->tags], [
$foo_tag,
tag { name =>, 'bar', ret => 1 },
tag { name => 'baz', ret => 1 },
], 'Should get all tags from tags()';
is sorted, 2, 'Should have sorted changes twice';
ok $parsed = $plan->load, 'Load should parse plan from file';
cmp_deeply delete $parsed->{pragmas}, {
syntax_version => App::Sqitch::Plan::SYNTAX_VERSION,
project => 'multi',
}, 'Should have captured the multi pragmas';
$vivify = 0;
cmp_deeply $parsed, {
lines => [
clear,
version,
prag( '', '', 'project', '', '=', '', 'multi'),
blank('', 'This is a note'),
blank(),
blank('', 'And there was a blank line.'),
blank(),
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
ret => 1,
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
blank(' '),
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar', ret => 1 },
tag { name => 'baz', ret => 1 },
],
changes => [
clear,
change { name => 'hey', planner_name => 'theory', planner_email => 't@heo.ry' },
change { name => 'you', planner_name => 'anna', planner_email => 'a@n.na' },
tag {
name => 'foo',
note => 'look, a tag!',
ts => '2012-07-16T17:24:07',
rspace => ' ',
planner_name => 'julie',
planner_email => 'j@ul.ie',
},
change { name => 'this/rocks', pspace => ' ' },
change { name => 'hey-there', note => 'trailing note!', rspace => ' ' },
tag { name =>, 'bar' },
tag { name => 'baz' },
],
}, 'And the parsed file should have lines and changes';
is sorted, 2, 'Should have sorted changes twice';
##############################################################################
# Test the interator interface.
can_ok $plan, qw(
index_of
contains
get
seek
reset
next
current
peek
do
);
is $plan->position, -1, 'Position should start at -1';
is $plan->current, undef, 'Current should be undef';
ok my $change = $plan->next, 'Get next change';
isa_ok $change, 'App::Sqitch::Plan::Change', 'First change';
is $change->name, 'hey', 'It should be the first change';
is $plan->position, 0, 'Position should be at 0';
is $plan->count, 4, 'Count should be 4';
is $plan->current, $change, 'Current should be current';
is $plan->change_at(0), $change, 'Should get first change from change_at(0)';
ok my $next = $plan->peek, 'Peek to next change';
isa_ok $next, 'App::Sqitch::Plan::Change', 'Peeked change';
is $next->name, 'you', 'Peeked change should be second change';
is $plan->last->format_name, 'hey-there', 'last() should return last change';
is $plan->current, $change, 'Current should still be current';
is $plan->peek, $next, 'Peek should still be next';
is $plan->next, $next, 'Next should be the second change';
is $plan->position, 1, 'Position should be at 1';
is $plan->change_at(1), $next, 'Should get second change from change_at(1)';
ok my $third = $plan->peek, 'Peek should return an object';
isa_ok $third, 'App::Sqitch::Plan::Change', 'Third change';
is $third->name, 'this/rocks', 'It should be the foo tag';
is $plan->current, $next, 'Current should be the second change';
is $plan->next, $third, 'Should get third change next';
is $plan->position, 2, 'Position should be at 2';
is $plan->current, $third, 'Current should be third change';
is $plan->change_at(2), $third, 'Should get third change from change_at(1)';
ok my $fourth = $plan->next, 'Get fourth change';
isa_ok $fourth, 'App::Sqitch::Plan::Change', 'Fourth change';
is $fourth->name, 'hey-there', 'Fourth change should be "hey-there"';
is $plan->position, 3, 'Position should be at 3';
is $plan->peek, undef, 'Peek should return undef';
is $plan->next, undef, 'Next should return undef';
is $plan->position, 4, 'Position should be at 7';
is $plan->next, undef, 'Next should still return undef';
is $plan->position, 4, 'Position should still be at 7';
ok $plan->reset, 'Reset the plan';
is $plan->position, -1, 'Position should be back at -1';
is $plan->current, undef, 'Current should still be undef';
is $plan->next, $change, 'Next should return the first change again';
is $plan->position, 0, 'Position should be at 0 again';
is $plan->current, $change, 'Current should be first change';
is $plan->index_of($change->name), 0, "Index of change should be 0";
ok $plan->contains($change->name), 'Plan should contain change';
is $plan->get($change->name), $change, 'Should be able to get change 0 by name';
is $plan->find($change->name), $change, 'Should be able to find change 0 by name';
is $plan->get($change->id), $change, 'Should be able to get change 0 by ID';
is $plan->find($change->id), $change, 'Should be able to find change 0 by ID';
is $plan->index_of('@bar'), 3, 'Index of @bar should be 3';
ok $plan->contains('@bar'), 'Plan should contain @bar';
is $plan->get('@bar'), $fourth, 'Should be able to get hey-there via @bar';
is $plan->get($fourth->id), $fourth, 'Should be able to get hey-there via @bar ID';
is $plan->find('@bar'), $fourth, 'Should be able to find hey-there via @bar';
is $plan->find($fourth->id), $fourth, 'Should be able to find hey-there via @bar ID';
ok $plan->seek('@bar'), 'Seek to the "@bar" change';
is $plan->position, 3, 'Position should be at 3 again';
is $plan->current, $fourth, 'Current should be fourth again';
is $plan->index_of('you'), 1, 'Index of you should be 1';
ok $plan->contains('you'), 'Plan should contain "you"';
is $plan->get('you'), $next, 'Should be able to get change 1 by name';
is $plan->find('you'), $next, 'Should be able to find change 1 by name';
ok $plan->seek('you'), 'Seek to the "you" change';
is $plan->position, 1, 'Position should be at 1 again';
is $plan->current, $next, 'Current should be second again';
is $plan->index_of('baz'), undef, 'Index of baz should be undef';
ok !$plan->contains('baz'), 'Plan should not contain "baz"';
is $plan->index_of('@baz'), 3, 'Index of @baz should be 3';
ok $plan->contains('@baz'), 'Plan should contain @baz';
ok $plan->seek('@baz'), 'Seek to the "baz" change';
is $plan->position, 3, 'Position should be at 3 again';
is $plan->current, $fourth, 'Current should be fourth again';
is $plan->change_at(0), $change, 'Should still get first change from change_at(0)';
is $plan->change_at(1), $next, 'Should still get second change from change_at(1)';
is $plan->change_at(2), $third, 'Should still get third change from change_at(1)';
# Make sure seek() chokes on a bad change name.
throws_ok { $plan->seek('nonesuch') } 'App::Sqitch::X',
'Should die seeking invalid change';
is $@->ident, 'plan', 'Invalid seek change error ident should be "plan"';
is $@->message, __x(
'Cannot find change "{change}" in plan',
change => 'nonesuch',
), 'And the failure message should be correct';
# Get all!
my @changes = ($change, $next, $third, $fourth);
cmp_deeply [$plan->changes], \@changes, 'All should return all changes';
ok $plan->reset, 'Reset the plan again';
$plan->do(sub {
is shift, $changes[0], 'Change ' . $changes[0]->name . ' should be passed to do sub';
is $_, $changes[0], 'Change ' . $changes[0]->name . ' should be the topic in do sub';
shift @changes;
});
# There should be no more to iterate over.
$plan->do(sub { fail 'Should not get anything passed to do()' });
##############################################################################
# Let's try searching changes.
isa_ok my $iter = $plan->search_changes, 'CODE',
'search_changes() should return a code ref';
my $get_all_names = sub {
my $iter = shift;
my @res;
while (my $change = $iter->()) {
push @res => $change->name;
}
return \@res;
};
is_deeply $get_all_names->($iter), [qw(hey you this/rocks hey-there)],
'All the changes should be returned in the proper order';
# Try reverse order.
is_deeply $get_all_names->( $plan->search_changes( direction => 'DESC' ) ),
[qw(hey-there this/rocks you hey)], 'Direction "DESC" should work';
# Try invalid directions.
throws_ok { $plan->search_changes( direction => 'foo' ) } 'App::Sqitch::X',
'Should get error for invalid direction';
is $@->ident, 'DEV', 'Invalid direction error ident should be "DEV"';
is $@->message, 'Search direction must be either "ASC" or "DESC"',
'Invalid direction error message should be correct';
# Try ascending lowercased.
is_deeply $get_all_names->( $plan->search_changes( direction => 'asc' ) ),
[qw(hey you this/rocks hey-there)], 'Direction "asc" should work';
# Try change name.
is_deeply $get_all_names->( $plan->search_changes( name => 'you')),
[qw(you)], 'Search by change name should work';
is_deeply $get_all_names->( $plan->search_changes( name => 'hey')),
[qw(hey hey-there)], 'Search by change name should work as a regex';
is_deeply $get_all_names->( $plan->search_changes( name => '[-/]')),
[qw(this/rocks hey-there)],
'Search by change name should with a character class';
# Try planner name.
is_deeply $get_all_names->( $plan->search_changes( planner => 'Barack' ) ),
[qw(this/rocks hey-there)], 'Search by planner should work';
is_deeply $get_all_names->( $plan->search_changes( planner => 'a..a' ) ),
[qw(you)], 'Search by planner should work as a regex';
# Search by operation.
is_deeply $get_all_names->( $plan->search_changes( operation => 'deploy' ) ),
[qw(hey you this/rocks hey-there)], 'Search by operation "deploy" should work';
is_deeply $get_all_names->( $plan->search_changes( operation => 'revert' ) ),
[], 'Search by operation "rever" should return nothing';
# Fake out an operation.
my $mock_change = Test::MockModule->new('App::Sqitch::Plan::Change');
$mock_change->mock( operator => sub { return shift->name =~ /hey/ ? '-' : '+' });
is_deeply $get_all_names->( $plan->search_changes( operation => 'DEPLOY' ) ),
[qw(you this/rocks)], 'Search by operation "DEPLOY" should now return two changes';
is_deeply $get_all_names->( $plan->search_changes( operation => 'REVERT' ) ),
[qw(hey hey-there)], 'Search by operation "REVERT" should return the other two';
$mock_change->unmock_all;
# Make sure we test only for legal operations.
throws_ok { $plan->search_changes( operation => 'foo' ) } 'App::Sqitch::X',
'Should get an error for unknown operation';
is $@->ident, 'DEV', 'Unknown operation error ident should be "DEV"';
is $@->message, 'Unknown change operation "foo"',
'Unknown operation error message should be correct';
# Test offset and limit.
is_deeply $get_all_names->( $plan->search_changes( offset => 2 ) ),
[qw(this/rocks hey-there)], 'Search with offset 2 should work';
is_deeply $get_all_names->( $plan->search_changes( offset => 2, limit => 1 ) ),
[qw(this/rocks)], 'Search with offset 2, limit 1 should work';
is_deeply $get_all_names->( $plan->search_changes( offset => 3, direction => 'desc' ) ),
[qw(hey)], 'Search with offset 3 and direction "desc" should work';
is_deeply $get_all_names->( $plan->search_changes( offset => 2, limit => 1, direction => 'desc' ) ),
[qw(you)], 'Search with offset 2, limit 1, direction "desc" should work';
is_deeply $get_all_names->( $plan->search_changes( limit => 3, direction => 'desc' ) ),
[qw(hey-there this/rocks you)], 'Search with limit 3, direction "desc" should work';
##############################################################################
# Test writing the plan.
can_ok $plan, 'write_to';
my $to = file 'plan.out';
END { unlink $to }
file_not_exists_ok $to;
ok $plan->write_to($to), 'Write out the file';
file_exists_ok $to;
my $v = App::Sqitch->VERSION;
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. $file->slurp(iomode => '<:utf8_strict'),
'The contents should look right';
# Make sure it will start from a certain point.
ok $plan->write_to($to, 'this/rocks'), 'Write out the file from "this/rocks"';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=multi' . "\n"
. '# This is a note' . "\n"
. "\n"
. $plan->find('this/rocks')->as_string . "\n"
. $plan->find('hey-there')->as_string . "\n"
. join( "\n", map { $_->as_string } $plan->find('hey-there')->tags ) . "\n",
'Plan should have been written from "this/rocks" through tags at end';
# Make sure it ends at a certain point.
ok $plan->write_to($to, undef, 'you'), 'Write the file up to "you"';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=multi' . "\n"
. '# This is a note' . "\n"
. "\n"
. '# And there was a blank line.' . "\n"
. "\n"
. $plan->find('hey')->as_string . "\n"
. $plan->find('you')->as_string . "\n"
. join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n",
'Plan should have been written through "you" and its tags';
# Try both.
ok $plan->write_to($to, '@foo', 'this/rocks'),
'Write from "@foo" to "this/rocks"';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=multi' . "\n"
. '# This is a note' . "\n"
. "\n"
. $plan->find('you')->as_string . "\n"
. join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n"
. ' ' . "\n"
. $plan->find('this/rocks')->as_string . "\n",
'Plan should have been written from "@foo" to "this/rocks"';
# End with a tag.
ok $plan->write_to($to, 'hey', '@foo'), 'Write from "hey" to "@foo"';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=multi' . "\n"
. '# This is a note' . "\n"
. "\n"
. $plan->find('hey')->as_string . "\n"
. $plan->find('you')->as_string . "\n"
. join( "\n", map { $_->as_string } $plan->find('you')->tags ) . "\n",
'Plan should have been written from "hey" through "@foo"';
##############################################################################
# Test _is_valid.
can_ok $plan, '_is_valid';
for my $name (@bad_names) {
throws_ok { $plan->_is_valid( tag => $name) } 'App::Sqitch::X',
qq{Should find "$name" invalid};
is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"};
is $@->message, __x(
qq{"{name}" is invalid: tags must not begin with punctuation, }
. 'contain "@", ":", "#", "/", "\\", "[", "]", or blanks, or end in punctuation or digits following punctuation',
name => $name,
), qq{And the "$name" error message should be correct};
}
# Try some valid names.
for my $name (
'foo', # alpha
'12', # digits
't', # char
'6', # digit
'阱阪阬', # multibyte
'foo/bar', # middle punct
'beta1', # ending digit
'v1.2-1', # version number with dash
'v1.2+1', # version number with plus
'v1.2_1', # version number with underscore
) {
local $ENV{FOO} = 1;
my $disp = Encode::encode_utf8($name);
ok $plan->_is_valid(change => $name), qq{Name "$disp" should be valid};
}
##############################################################################
# Try adding a tag.
ok my $tag = $plan->tag( name => 'w00t' ), 'Add tag "w00t"';
is $plan->count, 4, 'Should have 4 changes';
ok $plan->contains('@w00t'), 'Should find "@w00t" in plan';
is $plan->index_of('@w00t'), 3, 'Should find "@w00t" at index 3';
is $plan->last->name, 'hey-there', 'Last change should be "hey-there"';
is_deeply [map { $_->name } $plan->last->tags], [qw(bar baz w00t)],
'The w00t tag should be on the last change';
isa_ok $tag, 'App::Sqitch::Plan::Tag';
is $tag->name, 'w00t', 'The returned tag should be @w00t';
is $tag->change, $plan->last, 'The @w00t change should be the last change';
ok $plan->write_to($to), 'Write out the file again';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. $file->slurp(iomode => '<:utf8_strict')
. $tag->as_string . "\n",
{ encoding => 'UTF-8' },
'The contents should include the "w00t" tag';
# Try passing the tag name with a leading @.
ok my $tag2 = $plan->tag( name => '@alpha' ), 'Add tag "@alpha"';
ok $plan->contains('@alpha'), 'Should find "@alpha" in plan';
is $plan->index_of('@alpha'), 3, 'Should find "@alpha" at index 3';
is $tag2->name, 'alpha', 'The returned tag should be @alpha';
is $tag2->change, $plan->last, 'The @alpha change should be the last change';
# Try specifying the change to tag.
ok my $tag3 = $plan->tag(name => 'blarney', change => 'you'),
'Tag change "you"';
is $plan->count, 4, 'Should still have 4 changes';
ok $plan->contains('@blarney'), 'Should find "@blarney" in plan';
is $plan->index_of('@blarney'), 1, 'Should find "@blarney" at index 1';
is_deeply [map { $_->name } $plan->change_at(1)->tags], [qw(foo blarney)],
'The blarney tag should be on the second change';
isa_ok $tag3, 'App::Sqitch::Plan::Tag';
is $tag3->name, 'blarney', 'The returned tag should be @blarney';
is $tag3->change, $plan->change_at(1), 'The @blarney change should be the second change';
# Should choke on a duplicate tag.
throws_ok { $plan->tag( name => 'w00t' ) } 'App::Sqitch::X',
'Should get error trying to add duplicate tag';
is $@->ident, 'plan', 'Duplicate tag error ident should be "plan"';
is $@->message, __x(
'Tag "{tag}" already exists',
tag => '@w00t',
), 'And the error message should report it as a dupe';
# Should choke on an invalid tag names.
for my $name (@bad_names, 'foo#bar', @bad_tags) {
next if $name =~ /^@/;
throws_ok { $plan->tag( name => $name ) } 'App::Sqitch::X',
qq{Should get error for invalid tag "$name"};
is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"};
is $@->message, __x(
qq{"{name}" is invalid: tags must not begin with punctuation, }
. 'contain "@", ":", "#", "/", "\\", "[", "]", or blanks, or end in punctuation or digits following punctuation',
name => $name,
), qq{And the "$name" error message should be correct};
}
# Validate reserved names.
for my $reserved (qw(HEAD ROOT)) {
throws_ok { $plan->tag( name => $reserved ) } 'App::Sqitch::X',
qq{Should get error for reserved tag "$reserved"};
is $@->ident, 'plan', qq{Reserved tag "$reserved" error ident should be "plan"};
is $@->message, __x(
'"{name}" is a reserved name',
name => $reserved,
), qq{And the reserved tag "$reserved" message should be correct};
}
throws_ok { $plan->tag( name => $sha1 ) } 'App::Sqitch::X',
'Should get error for a SHA1 tag';
is $@->ident, 'plan', 'SHA1 tag error ident should be "plan"';
is $@->message, __x(
'"{name}" is invalid because it could be confused with a SHA1 ID',
name => $sha1,,
), 'And the reserved name error should be output';
##############################################################################
# Try adding a change.
ok my $new_change = $plan->add(name => 'booyah', note => 'Hi there'),
'Add change "booyah"';
is $plan->count, 5, 'Should have 5 changes';
ok $plan->contains('booyah'), 'Should find "booyah" in plan';
is $plan->index_of('booyah'), 4, 'Should find "booyah" at index 4';
is $plan->last->name, 'booyah', 'Last change should be "booyah"';
isa_ok $new_change, 'App::Sqitch::Plan::Change';
is $new_change->as_string, join (' ',
'booyah',
$new_change->timestamp->as_string,
$new_change->format_planner,
$new_change->format_note,
), 'Should have plain stringification of "booya"';
my $contents = $file->slurp(iomode => '<:utf8_strict');
$contents =~ s{(\s+this/rocks)}{"\n" . $tag3->as_string . $1}ems;
ok $plan->write_to($to), 'Write out the file again';
file_contents_is $to,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. $contents
. $tag->as_string . "\n"
. $tag2->as_string . "\n\n"
. $new_change->as_string . "\n",
{ encoding => 'UTF-8' },
'The contents should include the "booyah" change';
# Make sure dependencies are verified.
ok $new_change = $plan->add(name => 'blow', requires => ['booyah']),
'Add change "blow"';
is $plan->count, 6, 'Should have 6 changes';
ok $plan->contains('blow'), 'Should find "blow" in plan';
is $plan->index_of('blow'), 5, 'Should find "blow" at index 5';
is $plan->last->name, 'blow', 'Last change should be "blow"';
is $new_change->as_string,
'blow [booyah] ' . $new_change->timestamp->as_string . ' '
. $new_change->format_planner,
'Should have nice stringification of "blow [booyah]"';
is [$plan->lines]->[-1], $new_change,
'The new change should have been appended to the lines, too';
# Make sure dependencies are unique.
ok $new_change = $plan->add(name => 'jive', requires => [qw(blow blow)]),
'Add change "jive" with dupe dependency';
is $plan->count, 7, 'Should have 7 changes';
ok $plan->contains('jive'), 'Should find "jive" in plan';
is $plan->index_of('jive'), 6, 'Should find "jive" at index 6';
is $plan->last->name, 'jive', 'jive change should be "jive"';
is_deeply [ map { $_->change } $new_change->requires ], ['blow'],
'Should have dependency "blow"';
is $new_change->as_string,
'jive [blow] ' . $new_change->timestamp->as_string . ' '
. $new_change->format_planner,
'Should have nice stringification of "jive [blow]"';
is [$plan->lines]->[-1], $new_change,
'The new change should have been appended to the lines, too';
# Make sure externals and conflicts are unique.
ok $new_change = $plan->add(
name => 'moo',
requires => [qw(ext:foo ext:foo)],
conflicts => [qw(blow blow ext:whu ext:whu)],
), 'Add change "moo" with dupe dependencies';
is $plan->count, 8, 'Should have 8 changes';
ok $plan->contains('moo'), 'Should find "moo" in plan';
is $plan->index_of('moo'), 7, 'Should find "moo" at index 7';
is $plan->last->name, 'moo', 'moo change should be "moo"';
is_deeply [ map { $_->as_string } $new_change->requires ], ['ext:foo'],
'Should require "ext:whu"';
is_deeply [ map { $_->as_string } $new_change->conflicts ], [qw(blow ext:whu)],
'Should conflict with "blow" and "ext:whu"';
is $new_change->as_string,
'moo [ext:foo !blow !ext:whu] ' . $new_change->timestamp->as_string . ' '
. $new_change->format_planner,
'Should have nice stringification of "moo [ext:foo !blow !ext:whu]"';
is [$plan->lines]->[-1], $new_change,
'The new change should have been appended to the lines, too';
# Should choke on a duplicate change.
throws_ok { $plan->add(name => 'blow') } 'App::Sqitch::X',
'Should get error trying to add duplicate change';
is $@->ident, 'plan', 'Duplicate change error ident should be "plan"';
is $@->message, __x(
qq{Change "{change}" already exists in plan {file}.\nUse "sqitch rework" to copy and rework it},
change => 'blow',
file => $plan->file,
), 'And the error message should suggest "rework"';
# Should choke on an invalid change names.
for my $name (@bad_names) {
throws_ok { $plan->add( name => $name ) } 'App::Sqitch::X',
qq{Should get error for invalid change "$name"};
is $@->ident, 'plan', qq{Invalid name "$name" error ident should be "plan"};
is $@->message, __x(
qq{"{name}" is invalid: changes must not begin with punctuation, }
. 'contain "@", ":", "#", "\\", "[", "]", or blanks, or end in punctuation or digits following punctuation',
name => $name,
), qq{And the "$name" error message should be correct};
}
# Try a reserved name.
for my $reserved (qw(HEAD ROOT)) {
throws_ok { $plan->add( name => $reserved ) } 'App::Sqitch::X',
qq{Should get error for reserved name "$reserved"};
is $@->ident, 'plan', qq{Reserved name "$reserved" error ident should be "plan"};
is $@->message, __x(
'"{name}" is a reserved name',
name => $reserved,
), qq{And the reserved name "$reserved" message should be correct};
}
# Try an unknown dependency.
throws_ok { $plan->add( name => 'whu', requires => ['nonesuch' ] ) } 'App::Sqitch::X',
'Should get failure for failed dependency';
is $@->ident, 'plan', 'Dependency error ident should be "plan"';
is $@->message, __x(
'Cannot add change "{change}": requires unknown change "{req}"',
change => 'whu',
req => 'nonesuch',
), 'The dependency error should be correct';
# Try invalid dependencies.
throws_ok { $plan->add( name => 'whu', requires => ['^bogus' ] ) } 'App::Sqitch::X',
'Should get failure for invalid dependency';
is $@->ident, 'plan', 'Invalid dependency error ident should be "plan"';
is $@->message, __x(
'"{dep}" is not a valid dependency specification',
dep => '^bogus',
), 'The invalid dependency error should be correct';
throws_ok { $plan->add( name => 'whu', conflicts => ['^bogus' ] ) } 'App::Sqitch::X',
'Should get failure for invalid conflict';
is $@->ident, 'plan', 'Invalid conflict error ident should be "plan"';
is $@->message, __x(
'"{dep}" is not a valid dependency specification',
dep => '^bogus',
), 'The invalid conflict error should be correct';
# Should choke on an unknown tag, too.
throws_ok { $plan->add(name => 'whu', requires => ['@nonesuch' ] ) } 'App::Sqitch::X',
'Should get failure for failed tag dependency';
is $@->ident, 'plan', 'Tag dependency error ident should be "plan"';
is $@->message, __x(
'Cannot add change "{change}": requires unknown change "{req}"',
change => 'whu',
req => '@nonesuch',
), 'The tag dependency error should be correct';
# Should choke on a change that looks like a SHA1.
throws_ok { $plan->add(name => $sha1) } 'App::Sqitch::X',
'Should get error for a SHA1 change';
is $@->ident, 'plan', 'SHA1 tag error ident should be "plan"';
is $@->message, __x(
'"{name}" is invalid because it could be confused with a SHA1 ID',
name => $sha1,,
), 'And the reserved name error should be output';
##############################################################################
# Try reworking a change.
can_ok $plan, 'rework';
ok my $rev_change = $plan->rework( name => 'you' ), 'Rework change "you"';
isa_ok $rev_change, 'App::Sqitch::Plan::Change';
is $rev_change->name, 'you', 'Reworked change should be "you"';
ok my $orig = $plan->change_at($plan->first_index_of('you')),
'Get original "you" change';
is $orig->name, 'you', 'It should also be named "you"';
is_deeply [ map { $_->format_name } $orig->rework_tags ],
[qw(@bar)], 'And it should have the one rework tag';
is $orig->deploy_file, $target->deploy_dir->file('you@bar.sql'),
'The original file should now be named you@bar.sql';
is $rev_change->as_string,
'you [you@bar] ' . $rev_change->timestamp->as_string . ' '
. $rev_change->format_planner,
'It should require the previous "you" change';
is [$plan->lines]->[-1], $rev_change,
'The new "you" should have been appended to the lines, too';
# Make sure it was appended to the plan.
ok $plan->contains('you@HEAD'), 'Should find "you@HEAD" in plan';
is $plan->index_of('you@HEAD'), 8, 'It should be at position 8';
is $plan->count, 9, 'The plan count should be 9';
# Tag and add again, to be sure we can do it multiple times.
ok $plan->tag( name => '@beta1' ), 'Tag @beta1';
ok my $rev_change2 = $plan->rework( name => 'you' ),
'Rework change "you" again';
isa_ok $rev_change2, 'App::Sqitch::Plan::Change';
is $rev_change2->name, 'you', 'New reworked change should be "you"';
ok $orig = $plan->change_at($plan->first_index_of('you')),
'Get original "you" change again';
is $orig->name, 'you', 'It should still be named "you"';
is_deeply [ map { $_->format_name } $orig->rework_tags ],
[qw(@bar)], 'And it should have the one rework tag';
ok $rev_change = $plan->get('you@beta1'), 'Get you@beta1';
is $rev_change->name, 'you', 'The second "you" should be named that';
is_deeply [ map { $_->format_name } $rev_change->rework_tags ],
[qw(@beta1)], 'And the second change should have the rework_tag "@beta1"';
is_deeply [ $rev_change2->rework_tags ],
[], 'But the new reworked change should have no rework tags';
is $rev_change2->as_string,
'you [you@beta1] ' . $rev_change2->timestamp->as_string . ' '
. $rev_change2->format_planner,
'It should require the previous "you" change';
is [$plan->lines]->[-1], $rev_change2,
'The new reworking should have been appended to the lines';
# Make sure it was appended to the plan.
ok $plan->contains('you@HEAD'), 'Should find "you@HEAD" in plan';
is $plan->index_of('you@HEAD'), 9, 'It should be at position 9';
is $plan->count, 10, 'The plan count should be 10';
# Try a nonexistent change name.
throws_ok { $plan->rework( name => 'nonexistent' ) } 'App::Sqitch::X',
'rework should die on nonexistent change';
is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"';
is $@->message, __x(
qq{Change "{change}" does not exist in {file}.\nUse "sqitch add {change}" to add it to the plan},
change => 'nonexistent',
file => $plan->file,
), 'And the error should suggest "sqitch add"';
# Try reworking without an intervening tag.
throws_ok { $plan->rework( name => 'you' ) } 'App::Sqitch::X',
'rework_stpe should die on lack of intervening tag';
is $@->ident, 'plan', 'Missing tag error ident should be "plan"';
is $@->message, __x(
qq{Cannot rework "{change}" without an intervening tag.\nUse "sqitch tag" to create a tag and try again},
change => 'you',
), 'And the error should suggest "sqitch tag"';
# Make sure it checks dependencies.
throws_ok { $plan->rework( name => 'booyah', requires => ['nonesuch' ] ) }
'App::Sqitch::X',
'rework should die on failed dependency';
is $@->ident, 'plan', 'Rework dependency error ident should be "plan"';
is $@->message, __x(
'Cannot rework change "{change}": requires unknown change "{req}"',
change => 'booyah',
req => 'nonesuch',
), 'The rework dependency error should be correct';
# Try invalid dependencies.
throws_ok { $plan->rework( name => 'booyah', requires => ['^bogus' ] ) } 'App::Sqitch::X',
'Should get failure for invalid dependency';
is $@->ident, 'plan', 'Invalid dependency error ident should be "plan"';
is $@->message, __x(
'"{dep}" is not a valid dependency specification',
dep => '^bogus',
), 'The invalid dependency error should be correct';
throws_ok { $plan->rework( name => 'booyah', conflicts => ['^bogus' ] ) } 'App::Sqitch::X',
'Should get failure for invalid conflict';
is $@->ident, 'plan', 'Invalid conflict error ident should be "plan"';
is $@->message, __x(
'"{dep}" is not a valid dependency specification',
dep => '^bogus',
), 'The invalid conflict error should be correct';
##############################################################################
# Try a plan with a duplicate change in different tag sections.
$file = file qw(t plans dupe-change-diff-tag.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target),
$CLASS, 'Plan shoud work plan with dupe change across tags';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
is $plan->project, 'dupe_change_diff_tag', 'Project name should be set';
cmp_deeply [ $plan->lines ], [
clear,
version,
prag( '', '', 'project', '', '=', '', 'dupe_change_diff_tag'),
blank,
change { name => 'whatever' },
tag { name => 'foo', ret => 1 },
blank(),
change { name => 'hi' },
tag { name => 'bar', ret => 1 },
blank(),
change { name => 'greets' },
change { name => 'whatever', rtag => [qw(hi whatever)] },
], 'Lines with dupe change should be read from file';
$vivify = 1;
cmp_deeply [ $plan->changes ], [
clear,
change { name => 'whatever' },
tag { name => 'foo' },
change { name => 'hi' },
tag { name => 'bar' },
change { name => 'greets' },
change { name => 'whatever', rtag => [qw(hi whatever)] },
], 'Noes with dupe change should be read from file';
is sorted, 3, 'Should have sorted changes three times';
# Try to find whatever.
ok $plan->contains('whatever'), 'Should find "whatever" in plan';
throws_ok { $plan->index_of('whatever') } 'App::Sqitch::X',
'Should get an error trying to find dupe key.';
is $@->ident, 'plan', 'Dupe key error ident should be "plan"';
is $@->message, __ 'Change lookup failed',
'Dupe key error message should be correct';
is_deeply +MockOutput->get_vent, [
[__x(
'Change "{change}" is ambiguous. Please specify a tag-qualified change:',
change => 'whatever',
)],
[ ' * ', 'whatever@HEAD' ],
[ ' * ', 'whatever@foo' ],
], 'Should have output listing tag-qualified changes';
is $plan->index_of('whatever@HEAD'), 3, 'Should get 3 for whatever@HEAD';
is $plan->index_of('whatever@bar'), 0, 'Should get 0 for whatever@bar';
# Make sure seek works, too.
throws_ok { $plan->seek('whatever') } 'App::Sqitch::X',
'Should get an error seeking dupe key.';
is $@->ident, 'plan', 'Dupe key error ident should be "plan"';
is $@->message, __ 'Change lookup failed',
'Dupe key error message should be correct';
is_deeply +MockOutput->get_vent, [
[__x(
'Change "{change}" is ambiguous. Please specify a tag-qualified change:',
change => 'whatever',
)],
[ ' * ', 'whatever@HEAD' ],
[ ' * ', 'whatever@foo' ],
], 'Should have output listing tag-qualified changes';
is $plan->index_of('whatever@HEAD'), 3, 'Should find whatever@HEAD at index 3';
is $plan->index_of('whatever@bar'), 0, 'Should find whatever@HEAD at index 0';
is $plan->first_index_of('whatever'), 0,
'Should find first instance of whatever at index 0';
is $plan->first_index_of('whatever', '@bar'), 3,
'Should find first instance of whatever after @bar at index 5';
ok $plan->seek('whatever@HEAD'), 'Seek whatever@HEAD';
is $plan->position, 3, 'Position should be 3';
ok $plan->seek('whatever@bar'), 'Seek whatever@bar';
is $plan->position, 0, 'Position should be 0';
is $plan->last_tagged_change->name, 'hi', 'Last tagged change should be "hi"';
##############################################################################
# Test open_script.
make_path dir(qw(sql deploy stuff))->stringify;
END { remove_tree 'sql' };
can_ok $CLASS, 'open_script';
my $change_file = file qw(sql deploy bar.sql);
$fh = $change_file->open('>') or die "Cannot open $change_file: $!\n";
$fh->say('-- This is a comment');
$fh->close;
ok $fh = $plan->open_script($change_file), 'Open bar.sql';
is $fh->getline, "-- This is a comment\n", 'It should be the right file';
$fh->close;
file(qw(sql deploy baz.sql))->touch;
ok $fh = $plan->open_script(file qw(sql deploy baz.sql)), 'Open baz.sql';
is $fh->getline, undef, 'It should be empty';
# Make sure it dies on an invalid file.
throws_ok { $plan->open_script(file 'nonexistent' ) } 'App::Sqitch::X',
'open_script() should die on nonexistent file';
is $@->ident, 'io', 'Nonexistent file error ident should be "io"';
is $@->message, __x(
'Cannot open {file}: {error}',
file => 'nonexistent',
error => $! || 'No such file or directory',
), 'Nonexistent file error message should be correct';
##############################################################################
# Test check_changes()
$mocker->unmock('check_changes');
can_ok $CLASS, 'check_changes';
my @deps;
my $i = 0;
my $j = 0;
$mock_change->mock(requires => sub {
my $reqs = caller eq 'App::Sqitch::Plan' ? $deps[$i++] : $deps[$j++];
@{ $reqs->{requires} };
});
sub changes {
clear;
$i = $j = 0;
map {
change { name => $_ };
} @_;
}
# Start with no dependencies.
$project = 'foo';
my %ddep = ( requires => [], conflicts => [] );
@deps = ({%ddep}, {%ddep}, {%ddep});
cmp_deeply [map { $_->name } $plan->check_changes({}, changes qw(this that other))],
[qw(this that other)], 'Should get original order when no dependencies';
@deps = ({%ddep}, {%ddep}, {%ddep});
cmp_deeply [map { $_->name } $plan->check_changes('foo', changes qw(this that other))],
[qw(this that other)], 'Should get original order when no prepreqs';
# Have that require this.
@deps = ({%ddep}, {%ddep, requires => [dep 'this']}, {%ddep});
cmp_deeply [map { $_->name }$plan->check_changes('foo', changes qw(this that other))],
[qw(this that other)], 'Should get original order when that requires this';
# Have other require that.
@deps = ({%ddep}, {%ddep, requires => [dep 'this']}, {%ddep, requires => [dep 'that']});
cmp_deeply [map { $_->name } $plan->check_changes('foo', changes qw(this that other))],
[qw(this that other)], 'Should get original order when other requires that';
my $deperr = sub {
join "\n ", __n(
'Dependency error detected:',
'Dependency errors detected:',
@_
), @_
};
# Have this require other.
@deps = ({%ddep, requires => [dep 'other']}, {%ddep}, {%ddep});
throws_ok {
$plan->check_changes('foo', changes qw(this that other))
} 'App::Sqitch::X', 'Should get error for out-of-order dependency';
is $@->ident, 'parse', 'Unordered dependency error ident should be "parse"';
is $@->message, $deperr->(__nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
2,
change => 'this',
required => 'other',
num => 2,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
2,
change => 'this',
num => 2,
plan => $plan->file,
)), 'And the unordered dependency error message should be correct';
# Have this require other and that.
@deps = ({%ddep, requires => [dep 'other', dep 'that']}, {%ddep}, {%ddep});
throws_ok {
$plan->check_changes('foo', changes qw(this that other));
} 'App::Sqitch::X', 'Should get error for multiple dependency errors';
is $@->ident, 'parse', 'Multiple dependency error ident should be "parse"';
is $@->message, $deperr->(
__nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
2,
change => 'this',
required => 'other',
num => 2,
), __nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
1,
change => 'this',
required => 'that',
num => 1,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
2,
change => 'this',
num => 2,
plan => $plan->file,
),
), 'And the multiple dependency error message should be correct';
# Have that require a tag.
@deps = ({%ddep}, {%ddep, requires => [dep '@howdy']}, {%ddep});
cmp_deeply [$plan->check_changes('foo', {'@howdy' => 2 }, changes qw(this that other))],
[changes qw(this that other)], 'Should get original order when requiring a tag';
# Requires a step as of a tag.
@deps = ({%ddep}, {%ddep, requires => [dep 'foo@howdy']}, {%ddep});
cmp_deeply [$plan->check_changes('foo', {'foo' => 1, '@howdy' => 2 }, changes qw(this that other))],
[changes qw(this that other)],
'Should get original order when requiring a step as-of a tag';
# Should die if the step comes *after* the specified tag.
@deps = ({%ddep}, {%ddep, requires => [dep 'foo@howdy']}, {%ddep});
throws_ok { $plan->check_changes('foo', {'foo' => 3, '@howdy' => 2 }, changes qw(this that other)) }
'App::Sqitch::X', 'Should get failure for a step after a tag';
is $@->ident, 'parse', 'Step after tag error ident should be "parse"';
is $@->message, $deperr->(__x(
'Unknown change "{required}" required by change "{change}"',
required => 'foo@howdy',
change => 'that',
)), 'And we the unknown change as-of a tag message should be correct';
# Add a cycle.
@deps = ({%ddep, requires => [dep 'that']}, {%ddep, requires => [dep 'this']}, {%ddep});
throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X',
'Should get failure for a cycle';
is $@->ident, 'parse', 'Cycle error ident should be "parse"';
is $@->message, $deperr->(
__nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
1,
change => 'this',
required => 'that',
num => 1,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
1,
change => 'this',
num => 1,
plan => $plan->file,
),
), 'The cycle error message should be correct';
# Add an extended cycle.
@deps = (
{%ddep, requires => [dep 'that']},
{%ddep, requires => [dep 'other']},
{%ddep, requires => [dep 'this']}
);
throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X',
'Should get failure for a two-hop cycle';
is $@->ident, 'parse', 'Two-hope cycle error ident should be "parse"';
is $@->message, $deperr->(
__nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
1,
change => 'this',
required => 'that',
num => 1,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
1,
change => 'this',
num => 1,
plan => $plan->file,
), __nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
1,
change => 'that',
required => 'other',
num => 1,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
1,
change => 'that',
num => 1,
plan => $plan->file,
),
), 'The two-hop cycle error message should be correct';
# Okay, now deal with depedencies from earlier change sections.
@deps = ({%ddep, requires => [dep 'foo']}, {%ddep}, {%ddep});
cmp_deeply [$plan->check_changes('foo', { foo => 1}, changes qw(this that other))],
[changes qw(this that other)], 'Should get original order with earlier dependency';
# Mix it up.
@deps = ({%ddep, requires => [dep 'other', dep 'that']}, {%ddep, requires => [dep 'sqitch']}, {%ddep});
throws_ok {
$plan->check_changes('foo', {sqitch => 1 }, changes qw(this that other))
} 'App::Sqitch::X', 'Should get error with misordered and seen dependencies';
is $@->ident, 'parse', 'Misorderd and seen error ident should be "parse"';
is $@->message, $deperr->(
__nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
2,
change => 'this',
required => 'other',
num => 2,
), __nx(
'Change "{change}" planned {num} change before required change "{required}"',
'Change "{change}" planned {num} changes before required change "{required}"',
1,
change => 'this',
required => 'that',
num => 1,
) . "\n " . __xn(
'HINT: move "{change}" down {num} line in {plan}',
'HINT: move "{change}" down {num} lines in {plan}',
2,
change => 'this',
num => 2,
plan => $plan->file,
),
), 'And the misordered and seen error message should be correct';
# Make sure it fails on unknown previous dependencies.
@deps = ({%ddep, requires => [dep 'foo']}, {%ddep}, {%ddep});
throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X',
'Should die on unknown dependency';
is $@->ident, 'parse', 'Unknown dependency error ident should be "parse"';
is $@->message, $deperr->(__x(
'Unknown change "{required}" required by change "{change}"',
required => 'foo',
change => 'this',
)), 'And the error should point to the offending change';
# Okay, now deal with depedencies from earlier change sections.
@deps = ({%ddep, requires => [dep '@foo']}, {%ddep}, {%ddep});
throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X',
'Should die on unknown tag dependency';
is $@->ident, 'parse', 'Unknown tag dependency error ident should be "parse"';
is $@->message, $deperr->(__x(
'Unknown change "{required}" required by change "{change}"',
required => '@foo',
change => 'this',
)), 'And the error should point to the offending change';
# Allow dependencies from different projects.
@deps = ({%ddep}, {%ddep, requires => [dep 'bar:bob']}, {%ddep});
cmp_deeply [$plan->check_changes('foo', changes qw(this that other))],
[changes qw(this that other)], 'Should get original order with external dependency';
$project = undef;
# Make sure that a change does not require itself
@deps = ({%ddep, requires => [dep 'this']}, {%ddep}, {%ddep});
throws_ok { $plan->check_changes('foo', changes qw(this that other)) } 'App::Sqitch::X',
'Should die on self dependency';
is $@->ident, 'parse', 'Self dependency error ident should be "parse"';
is $@->message, $deperr->(__x(
'Change "{change}" cannot require itself',
change => 'this',
)), 'And the self dependency error should be correct';
# Make sure sort ordering respects the original ordering.
@deps = (
{%ddep},
{%ddep},
{%ddep, requires => [dep 'that']},
{%ddep, requires => [dep 'that', dep 'this']},
);
cmp_deeply [$plan->check_changes('foo', changes qw(this that other thing))],
[changes qw(this that other thing)],
'Should get original order with cascading dependencies';
$project = undef;
@deps = (
{%ddep},
{%ddep},
{%ddep, requires => [dep 'that']},
{%ddep, requires => [dep 'that', dep 'this', dep 'other']},
{%ddep, requires => [dep 'that', dep 'this']},
);
cmp_deeply [$plan->check_changes('foo', changes qw(this that other thing yowza))],
[changes qw(this that other thing yowza)],
'Should get original order with multiple cascading dependencies';
$project = undef;
##############################################################################
# Test dependency testing.
can_ok $plan, '_check_dependencies';
$mock_change->unmock('requires');
for my $req (qw(hi greets whatever @foo whatever@foo ext:larry ext:greets)) {
$change = App::Sqitch::Plan::Change->new(
plan => $plan,
name => 'lazy',
requires => [dep $req],
);
my $req_proj = $req =~ /:/ ? do {
(my $p = $req) =~ s/:.+//;
$p;
} : $plan->project;
my ($dep) = $change->requires;
is $dep->project, $req_proj,
qq{Depend "$req" should be in project "$req_proj"};
ok $plan->_check_dependencies($change, 'add'),
qq{Dependency on "$req" should succeed};
}
for my $req (qw(wanker @blah greets@foo)) {
$change = App::Sqitch::Plan::Change->new(
plan => $plan,
name => 'lazy',
requires => [dep $req],
);
throws_ok { $plan->_check_dependencies($change, 'bark') } 'App::Sqitch::X',
qq{Should get error trying to depend on "$req"};
is $@->ident, 'plan', qq{Dependency "req" error ident should be "plan"};
is $@->message, __x(
'Cannot rework change "{change}": requires unknown change "{req}"',
change => 'lazy',
req => $req,
), qq{And should get unknown dependency message for "$req"};
}
##############################################################################
# Test pragma accessors.
is $plan->uri, undef, 'Should have undef URI when no pragma';
$file = file qw(t plans pragmas.plan);
$target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
isa_ok $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target),
$CLASS, 'Plan with sqitch with plan file with dependencies';
is $plan->file, $target->plan_file, 'File should be coopied from Sqitch';
is $plan->syntax_version, App::Sqitch::Plan::SYNTAX_VERSION,
'syntax_version should be set';
is $plan->project, 'pragmata', 'Project should be set';
is $plan->uri, URI->new('https://github.com/sqitchers/sqitch/'),
'Should have URI from pragma';
isa_ok $plan->uri, 'URI', 'It';
# Make sure we get an error if there is no project pragma.
$fh = IO::File->new(\"%strict\n\nfoo $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse('noproject', $fh) } 'App::Sqitch::X',
'Should die on plan with no project pragma';
is $@->ident, 'parse', 'Missing prorject error ident should be "parse"';
is $@->message, __x('Missing %project pragma in {file}', file => 'noproject'),
'The missing project error message should be correct';
# Make sure we get an error for an invalid project name.
for my $bad (@bad_names) {
my $fh = IO::File->new(\"%project=$bad\n\nfoo $tsnp", '<:utf8_strict');
throws_ok { $plan->_parse(badproj => $fh) } 'App::Sqitch::X',
qq{Should die on invalid project name "$bad"};
is $@->ident, 'parse', qq{Ident for bad proj "$bad" should be "parse"};
my $error = __x(
'invalid project name "{project}": project names must not '
. 'begin with punctuation, contain "@", ":", "#", "\\", "[", "]", or blanks, or end in '
. 'punctuation or digits following punctuation',
project => $bad);
is $@->message, __x(
'Syntax error in {file} at line {lineno}: {error}',
file => 'badproj',
lineno => 1,
error => $error
), qq{Error message for bad project "$bad" should be correct};
}
done_testing;
sqitch 100755 001751 000166 173 15004170404 15343 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/env perl -CAS
use locale;
use FindBin;
use lib "$FindBin::Bin/../lib";
use App::Sqitch;
exit App::Sqitch->go;
show.t 100644 001751 000166 16711 15004170404 15334 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use Path::Class;
use Test::Exception;
use Test::Warn;
use Locale::TextDomain qw(App-Sqitch);
use Test::MockModule;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::show';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(execute exists_only target does);
ok $CLASS->does("App::Sqitch::Role::ContextCommand"),
"$CLASS does ContextCommand";
is_deeply [$CLASS->options], [qw(
target|t=s
exists|e!
plan-file|f=s
top-dir=s
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'pg',
'core.plan_file' => file(qw(t engine sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t engine))->stringify,
'core.reworked_dir' => dir(qw(t engine reworked))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
isa_ok my $show = $CLASS->new(sqitch => $sqitch), $CLASS;
ok !$show->exists_only, 'exists_only should be false by default';
ok my $eshow = $CLASS->new(sqitch => $sqitch, exists_only => 1),
'Construct with exists_only';
ok $eshow->exists_only, 'exists_only should be set';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {_cx => []},
'Should get empty hash for no config or options';
is_deeply $CLASS->configure($config, {exists => 1}),
{ exists_only => 1, _cx => [] },
'Should get exists_only => 1 for exist in options';
##############################################################################
# Start with the change.
ok my $change = $show->default_target->plan->get('widgets'), 'Get a change';
ok $show->execute( change => $change->id ), 'Find change by id';
is_deeply +MockOutput->get_emit, [[ $change->info ]],
'The change info should have been emitted';
# Try by name.
ok $show->execute( change => $change->name ), 'Find change by name';
is_deeply +MockOutput->get_emit, [[ $change->info ]],
'The change info should have been emitted again';
# What happens for something unknown?
throws_ok { $show->execute( change => 'nonexistent' ) } 'App::Sqitch::X',
'Should get an error for an unknown change';
is $@->ident, 'show', 'Unknown change error ident should be "show"';
is $@->message, __x('Unknown change "{change}"', change => 'nonexistent'),
'Should get proper error for unknown change';
# What about with exists_only?
ok !$eshow->execute( change => 'nonexistent' ),
'Should return false for uknown change and exists_only';
is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted';
# Let's find a change by tag.
my $tag = ($show->default_target->plan->tags)[0];
$change = $tag->change;
ok $show->execute( change => $tag->id ), 'Find change by tag id';
is_deeply +MockOutput->get_emit, [[ $change->info ]],
'The change info should have been emitted';
# And the tag name.
ok $show->execute( change => $tag->format_name ), 'Find change by tag';
is_deeply +MockOutput->get_emit, [[ $change->info ]],
'The change info should have been emitted';
# Make sure it works with exists_only.
ok $eshow->execute( change => $change->id ), 'Run exists with ID';
is_deeply +MockOutput->get_emit, [],
'There should be no output';
# Great, let's look a the tag itself.
ok $show->execute( tag => $tag->id ), 'Find tag by id';
is_deeply +MockOutput->get_emit, [[ $tag->info ]],
'The tag info should have been emitted';
# Should work with exists_only, too.
ok $eshow->execute( tag => $tag->id ), 'Find tag by id with exists_only';
is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted';
ok $show->execute( tag => $tag->name ), 'Find tag by name';
is_deeply +MockOutput->get_emit, [[ $tag->info ]],
'The tag info should have been emitted';
ok $show->execute( tag => $tag->format_name ), 'Find tag by formatted name';
is_deeply +MockOutput->get_emit, [[ $tag->info ]],
'The tag info should have been emitted';
# Try an invalid tag.
throws_ok { $show->execute( tag => 'nope') } 'App::Sqitch::X',
'Should get error for non-existent tag';
is $@->ident, 'show', 'Unknown tag error ident should be "show"';
is $@->message, __x('Unknown tag "{tag}"', tag => 'nope' ),
'Should get proper error for unknown tag';
# Try invalid tag with exists_only.
ok !$eshow->execute( tag => 'nope'),
'Should return false for non-existent tag and exists_only';
is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted';
# Also an invalid sha1.
throws_ok { $show->execute( tag => '7ecba288708307ef714362c121691de02ffb364d') }
'App::Sqitch::X',
'Should get error for non-existent tag ID';
is $@->ident, 'show', 'Unknown tag ID error ident should be "show"';
is $@->message, __x('Unknown tag "{tag}"', tag => '7ecba288708307ef714362c121691de02ffb364d' ),
'Should get proper error for unknown tag ID';
# Now let's look at files.
ok $show->execute(deploy => $change->id), 'Show a deploy file';
is_deeply +MockOutput->get_emit, [[ $change->deploy_file->slurp(iomode => '<:raw') ]],
'The deploy file should have been emitted';
# With exists_only.
ok $eshow->execute(deploy => $change->id), 'Show a deploy file with exists_only';
is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted';
ok $show->execute(revert => $change->id), 'Show a revert file';
is_deeply +MockOutput->get_emit, [[ $change->revert_file->slurp(iomode => '<:raw') ]],
'The revert file should have been emitted';
# Nonexistent verify file.
throws_ok { $show->execute( verify => $change->id ) } 'App::Sqitch::X',
'Should get error for nonexistent varify file';
is $@->ident, 'show', 'Nonexistent file error ident should be "show"';
is $@->message, __x('File "{path}" does not exist', path => $change->verify_file ),
'Should get proper error for nonexistent file';
# Nonexistent with exists_only.
ok !$eshow->execute( verify => $change->id ),
'Should return false for nonexistent file';
is_deeply +MockOutput->get_emit, [], 'Nothing should have been emitted';
# Now an unknown type.
throws_ok { $show->execute(foo => 'bar') } 'App::Sqitch::X',
'Should get error for uknown type';
is $@->ident, 'show', 'Unknown type error ident should be "show"';
is $@->message, __x(
'Unknown object type "{type}',
type => 'foo',
), 'Should get proper error for unknown type';
# Try specifying a non-default target.
$config = TestConfig->from( local => file 't', 'local.conf');
$sqitch = App::Sqitch->new(config => $config);
my $file = file qw(t plans dependencies.plan);
my $target = App::Sqitch::Target->new(sqitch => $sqitch, plan_file => $file);
ok $change = $target->plan->get('add_user'), 'Get a change';
# Set it up.
isa_ok $show = $CLASS->new(sqitch => $sqitch, target => 'mydb'), $CLASS;
is $show->target, 'mydb', 'Target should be set';
ok $show->execute( change => $change->id ), 'Find change by id';
is_deeply +MockOutput->get_emit, [[ $change->info ]],
'The change info should have been emitted';
# Now try invalid args.
my $mock = Test::MockModule->new($CLASS);
my @usage;
$mock->mock(usage => sub { shift; @usage = @_; die 'USAGE' });
throws_ok { $show->execute } qr/USAGE/, 'Should get usage for missing params';
is_deeply \@usage, [], 'Nothing should have been passed to usage';
done_testing;
die.pl 100644 001751 000166 61 15004170404 15174 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t use v5.10;
say "@ARGV" if @ARGV;
die 'OMGWTF';
help.t 100644 001751 000166 4752 15004170404 15266 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 20;
#use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::Exception;
use Test::Warn;
use Config;
use File::Spec;
use Test::MockModule;
use Test::NoWarnings;
use lib 't/lib';
use TestConfig;
my $CLASS = 'App::Sqitch::Command::help';
ok my $sqitch = App::Sqitch->new, 'Load a sqitch sqitch object';
my $config = TestConfig->new;
isa_ok my $help = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'help',
config => $config,
}), $CLASS, 'Load help command';
isa_ok $help, 'App::Sqitch::Command', 'Help command';
can_ok $help, qw(
options
execute
find_and_show
);
is_deeply [$CLASS->options], [qw(
guide|g
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(_pod2usage => sub { @args = @_} );
ok $help->execute, 'Execute help';
is_deeply \@args, [
$help,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchcommands'),
'-verbose' => 2,
'-exitval' => 0,
], 'Should show sqitch app docs';
ok $help->execute('config'), 'Execute "config" help';
is_deeply \@args, [
$help,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-config'),
'-verbose' => 2,
'-exitval' => 0,
], 'Should show "config" command docs';
ok $help->execute('changes'), 'Execute "changes" help';
is_deeply \@args, [
$help,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchchanges'),
'-verbose' => 2,
'-exitval' => 0,
], 'Should show "changes" command docs';
ok $help->execute('tutorial'), 'Execute "tutorial" help';
is_deeply \@args, [
$help,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitchtutorial'),
'-verbose' => 2,
'-exitval' => 0,
], 'Should show "tutorial" command docs';
my @fail;
$mock->mock(fail => sub { @fail = @_ });
throws_ok { $help->execute('nonexistent') } 'App::Sqitch::X',
'Should get an exception for "nonexistent" help';
is $@->ident, 'help', 'Exception ident should be "help"';
is $@->message, __x(
'No manual entry for {command}',
command => 'sqitch-nonexistent',
), 'Should get failure message for nonexistent command';
is $@->exitval, 1, 'Exception exit val should be 1';
init.t 100644 001751 000166 60771 15004170404 15324 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 196;
# use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Path::Class;
use Test::Dir;
use Test::File qw(file_not_exists_ok file_exists_ok);
use Test::Exception;
use Test::Warn;
use Test::File::Contents;
use Test::NoWarnings;
use File::Path qw(remove_tree make_path);
use URI;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $exe_ext = App::Sqitch::ISWIN ? '.exe' : '';
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Command::init';
use_ok $CLASS or die;
}
isa_ok $CLASS, 'App::Sqitch::Command', $CLASS;
chdir 't';
##############################################################################
# Test options and configuration.
my $config = TestConfig->new;
my $sqitch = App::Sqitch->new( config => $config);
isa_ok my $init = $CLASS->new(
sqitch => $sqitch,
properties => {
top_dir => dir('init.mkdir'),
reworked_dir => dir('init.mkdir/reworked'),
},
), $CLASS, 'Init command';
isa_ok $init, 'App::Sqitch::Command', 'Init commmand';
can_ok $init, qw(
uri
properties
options
configure
does
);
ok $CLASS->does("App::Sqitch::Role::TargetConfigCommand"),
"$CLASS does TargetConfigCommand";
is_deeply [$init->options], [qw(
uri=s
engine=s
target=s
plan-file|f=s
registry=s
client=s
extension=s
top-dir=s
dir|d=s%
set|s=s%
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
##############################################################################
# Test configure().
is_deeply $CLASS->configure({}, {}), { properties => {}},
'Default config should contain empty properties';
is_deeply $CLASS->configure({}, { uri => 'https://example.com' }), {
uri => URI->new('https://example.com'),
properties => {},
}, 'Should accept a URI in options';
ok my $conf = $CLASS->configure({}, {
uri => 'https://example.com',
engine => 'pg',
top_dir => 'top',
plan_file => 'my.plan',
registry => 'bats',
client => 'cli',
extension => 'ddl',
target => 'db:pg:foo',
dir => {
deploy => 'dep',
revert => 'rev',
verify => 'ver',
reworked => 'wrk',
reworked_deploy => 'rdep',
reworked_revert => 'rrev',
reworked_verify => 'rver',
},
set => {
foo => 'bar',
prefix => 'x_',
},
}), 'Get full config';
isa_ok $conf->{uri}, 'URI', 'uri propertiy';
is_deeply $conf->{properties}, {
engine => 'pg',
top_dir => 'top',
plan_file => 'my.plan',
registry => 'bats',
client => 'cli',
extension => 'ddl',
target => 'db:pg:foo',
deploy_dir => 'dep',
revert_dir => 'rev',
verify_dir => 'ver',
reworked_dir => 'wrk',
reworked_deploy_dir => 'rdep',
reworked_revert_dir => 'rrev',
reworked_verify_dir => 'rver',
variables => {
foo => 'bar',
prefix => 'x_',
},
}, 'Should have properties';
isa_ok $conf->{properties}{$_}, 'Path::Class::File', "$_ file attribute" for qw(
plan_file
);
isa_ok $conf->{properties}{$_}, 'Path::Class::Dir', "$_ directory attribute" for (
'top_dir',
'reworked_dir',
map { ($_, "reworked_$_") } qw(deploy_dir revert_dir verify_dir)
);
# Make sure invalid directories are ignored.
throws_ok { $CLASS->new($CLASS->configure({}, {
dir => { foo => 'bar' },
})) } 'App::Sqitch::X', 'Should fail on invalid directory name';
is $@->ident, 'init', 'Invalid directory ident should be "init"';
is $@->message, __nx(
'Unknown directory name: {dirs}',
'Unknown directory names: {dirs}',
1,
dirs => 'foo',
), 'The invalid directory messsage should be correct';
throws_ok { $CLASS->new($CLASS->configure({}, {
dir => { foo => 'bar', cavort => 'ha' },
})) } 'App::Sqitch::X', 'Should fail on invalid directory names';
is $@->ident, 'init', 'Invalid directories ident should be "init"';
is $@->message, __nx(
'Unknown directory name: {dirs}',
'Unknown directory names: {dirs}',
2,
dirs => 'cavort, foo',
), 'The invalid properties messsage should be correct';
isa_ok my $target = $init->config_target, 'App::Sqitch::Target', 'default target';
##############################################################################
# Test make_directories_for.
can_ok $init, 'make_directories_for';
dir_not_exists_ok $target->top_dir;
dir_not_exists_ok $_ for $init->directories_for($target);
my $top_dir_string = $target->top_dir->stringify;
END { remove_tree $top_dir_string if -e $top_dir_string }
ok $init->make_directories_for($target), 'Make the directories';
dir_exists_ok $_ for $init->directories_for($target);
my $sep = dir('')->stringify;
my $dirs = $init->properties;
is_deeply +MockOutput->get_info, [
[__x "Created {file}", file => $target->deploy_dir . $sep],
[__x "Created {file}", file => $target->revert_dir . $sep],
[__x "Created {file}", file => $target->verify_dir . $sep],
[__x "Created {file}", file => $dirs->{reworked_dir}->subdir('deploy') . $sep],
[__x "Created {file}", file => $dirs->{reworked_dir}->subdir('revert') . $sep],
[__x "Created {file}", file => $dirs->{reworked_dir}->subdir('verify') . $sep],
], 'Each should have been sent to info';
# Do it again.
ok $init->make_directories_for($target), 'Make the directories again';
is_deeply +MockOutput->get_info, [], 'Nothing should have been sent to info';
# Delete one of them.
remove_tree $target->revert_dir->stringify;
ok $init->make_directories_for($target), 'Make the directories once more';
dir_exists_ok $target->revert_dir, 'revert dir exists again';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $target->revert_dir . $sep],
], 'Should have noted creation of revert dir';
remove_tree $top_dir_string;
# Handle errors.
FSERR: {
# Make mkpath to insert an error.
my $mock = Test::MockModule->new('File::Path');
$mock->mock( mkpath => sub {
my ($file, $p) = @_;
${ $p->{error} } = [{ $file => 'Permission denied yo'}];
return;
});
throws_ok { $init->make_directories_for($target) } 'App::Sqitch::X',
'Should fail on permission issue';
is $@->ident, 'init', 'Permission error should have ident "init"';
is $@->message, __x(
'Error creating {path}: {error}',
path => $target->deploy_dir,
error => 'Permission denied yo',
), 'The permission error should be formatted properly';
}
##############################################################################
# Test write_config().
$sqitch = App::Sqitch->new(config => $config);
can_ok $init, 'write_config';
my $write_dir = 'init.write';
make_path $write_dir;
END { remove_tree $write_dir }
chdir $write_dir;
END { chdir File::Spec->updir }
my $conf_file = $sqitch->config->local_file;
my $uri = URI->new('https://github.com/sqitchers/sqitch/');
ok $init = $CLASS->new(
sqitch => $sqitch,
), 'Another init object';
file_not_exists_ok $conf_file;
$target = $init->config_target;
# Write empty config.
ok $init->write_config, 'Write the config';
file_exists_ok $conf_file;
is_deeply $config->data_from($conf_file), {
}, 'The configuration file should have no variables';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info';
my $top_dir = File::Spec->curdir;
my $deploy_dir = File::Spec->catdir(qw(deploy));
my $revert_dir = File::Spec->catdir(qw(revert));
my $verify_dir = File::Spec->catdir(qw(verify));
my $plan_file = $target->top_dir->file('sqitch.plan')->cleanup->stringify;
file_contents_like $conf_file, qr{\Q[core]
# engine =
# plan_file = $plan_file
# top_dir = $top_dir
}m, 'All in core section should be commented-out';
unlink $conf_file;
# Set two options.
$sqitch = App::Sqitch->new(config => $config);
ok $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' } ),
'Another init object';
$target = $init->config_target;
ok $init->write_config, 'Write the config';
file_exists_ok $conf_file;
is_deeply $config->data_from($conf_file), {
'core.extension' => 'foo',
}, 'The configuration should have been written with the one setting';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info';
file_contents_like $conf_file, qr{
# engine =
# plan_file = $plan_file
# top_dir = $top_dir
}m, 'Other settings should be commented-out';
# Go again.
ok $init->write_config, 'Write the config again';
is_deeply $config->data_from($conf_file), {
'core.extension' => 'foo',
}, 'The configuration should be unchanged';
is_deeply +MockOutput->get_info, [
], 'Nothing should have been sent to info';
USERCONF: {
# Delete the file and write with a user config loaded.
unlink $conf_file;
my $config = TestConfig->from( user => file +File::Spec->updir, 'user.conf' );
my $sqitch = App::Sqitch->new(config => $config);
ok my $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' }),
'Make an init object with user config';
file_not_exists_ok $conf_file;
ok $init->write_config, 'Write the config with a user conf';
file_exists_ok $conf_file;
is_deeply $config->data_from($conf_file), {
'core.extension' => 'foo',
}, 'The configuration should just have core.top_dir';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info again';
file_contents_like $conf_file, qr{\Q
# engine =
# plan_file = $plan_file
# top_dir = $top_dir
}m, 'Other settings should be commented-out';
}
SYSTEMCONF: {
# Delete the file and write with a system config loaded.
unlink $conf_file;
my $config = TestConfig->from( system => file +File::Spec->updir, 'sqitch.conf' );
my $sqitch = App::Sqitch->new(config => $config);
ok my $init = $CLASS->new( sqitch => $sqitch, properties => { extension => 'foo' } ),
'Make an init object with system config';
ok $target = $init->config_target, 'Get target';
file_not_exists_ok $conf_file;
ok $init->write_config, 'Write the config with a system conf';
file_exists_ok $conf_file;
is_deeply $config->data_from($conf_file), {
'core.extension' => 'foo',
'core.engine' => 'pg',
}, 'The configuration should have local and system config' or diag $conf_file->slurp;
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info again';
my $plan_file = $target->top_dir->file('sqitch.plan')->stringify;
file_contents_like $conf_file, qr{\Q
# plan_file = $plan_file
# top_dir = migrations
}m, 'Other settings should be commented-out';
}
##############################################################################
# Now get it to write a bunch of other stuff.
unlink $conf_file;
$sqitch = App::Sqitch->new(config => $config);
ok $init = $CLASS->new(
sqitch => $sqitch,
properties => {
engine => 'sqlite',
top_dir => dir('top'),
plan_file => file('my.plan'),
registry => 'bats',
client => 'cli',
target => 'db:sqlite:foo',
extension => 'ddl',
deploy_dir => dir('dep'),
revert_dir => dir('rev'),
verify_dir => dir('tst'),
reworked_deploy_dir => dir('rdep'),
reworked_revert_dir => dir('rrev'),
reworked_verify_dir => dir('rtst'),
variables => { ay => 'first', Bee => 'second' },
}
), 'Create new init with sqitch non-default attributes';
ok $init->write_config, 'Write the config with core attrs';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info once more';
is_deeply $config->data_from($conf_file), {
'core.top_dir' => 'top',
'core.plan_file' => 'my.plan',
'core.deploy_dir' => 'dep',
'core.revert_dir' => 'rev',
'core.verify_dir' => 'tst',
'core.reworked_deploy_dir' => 'rdep',
'core.reworked_revert_dir' => 'rrev',
'core.reworked_verify_dir' => 'rtst',
'core.extension' => 'ddl',
'core.engine' => 'sqlite',
'core.variables.ay' => 'first',
'core.variables.bee' => 'second',
'engine.sqlite.registry' => 'bats',
'engine.sqlite.client' => 'cli',
'engine.sqlite.target' => 'db:sqlite:foo',
}, 'The configuration should have been written with core and engine values';
##############################################################################
# Try it with no options.
unlink $conf_file;
$sqitch = App::Sqitch->new(config => $config);
ok $init = $CLASS->new( sqitch => $sqitch, properties => { engine => 'sqlite' } ),
'Create new init with sqitch with default engine attributes';
ok $init->write_config, 'Write the config with engine attrs';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info again again';
is_deeply $config->data_from($conf_file), {
'core.engine' => 'sqlite',
}, 'The configuration should have been written with only the engine var';
file_contents_like $conf_file, qr{^\Q# [engine "sqlite"]
# target = db:sqlite:
# registry = sqitch
# client = sqlite3$exe_ext
}m, 'Engine section should be present but commented-out';
# Now build it with other config.
USERCONF: {
# Delete the file and write with a user config loaded.
unlink $conf_file;
my $config = TestConfig->from( user => file +File::Spec->updir, 'user.conf' );
$config->update('core.engine' => 'sqlite');
my $sqitch = App::Sqitch->new(config => $config);
ok my $init = $CLASS->new( sqitch => $sqitch ),
'Make an init with sqlite and user config';
file_not_exists_ok $conf_file;
ok $init->write_config, 'Write the config with sqlite config';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info once more';
is_deeply $config->data_from($conf_file), {
'core.engine' => 'sqlite',
}, 'New config should have been written with sqlite values';
file_contents_like $conf_file, qr{^\t\Q# client = /opt/local/bin/sqlite3\E\n}m,
'Configured client should be included in a comment';
file_contents_like $conf_file, qr/^\t# target = db:sqlite:my\.db\n/m,
'Configured target should be included in a comment';
file_contents_like $conf_file, qr/^\t# registry = meta\n/m,
'Configured registry should be included in a comment';
}
##############################################################################
# Now get it to write engine.pg stuff.
unlink $conf_file;
$config->replace;
$sqitch = App::Sqitch->new(config => $config);
ok $init = $CLASS->new(
sqitch => $sqitch,
properties => { engine => 'pg', client => '/to/psql' },
), 'Create new init with sqitch with more non-default engine attributes';
ok $init->write_config, 'Write the config with more engine attrs';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info one more time';
is_deeply $config->data_from($conf_file), {
'core.engine' => 'pg',
'engine.pg.client' => '/to/psql',
}, 'The configuration should have been written with client values' or diag $conf_file->slurp;
file_contents_like $conf_file, qr/^\t# registry = sqitch\n/m,
'registry should be included in a comment';
# Try it with no config or options.
unlink $conf_file;
$sqitch = App::Sqitch->new(config => $config);
ok $init = $CLASS->new( sqitch => $sqitch, properties => { engine => 'pg' } ),
'Create new init with sqitch with default engine attributes';
ok $init->write_config, 'Write the config with engine attrs';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The creation should be sent to info again again again';
is_deeply $config->data_from($conf_file), {
'core.engine' => 'pg',
}, 'The configuration should have been written with only the engine var' or diag $conf_file->slurp;
file_contents_like $conf_file, qr{^\Q# [engine "pg"]
# target = db:pg:
# registry = sqitch
# client = psql$exe_ext
}m, 'Engine section should be present but commented-out' or diag $conf_file->slurp;
USERCONF: {
# Delete the file and write with a user config loaded.
unlink $conf_file;
my $config = TestConfig->from( user => file +File::Spec->updir, 'user.conf' );
$config->update('core.engine' => 'pg');
my $sqitch = App::Sqitch->new(config => $config);
ok my $init = $CLASS->new( sqitch => $sqitch ),
'Make an init with pg and user config';
file_not_exists_ok $conf_file;
ok $init->write_config, 'Write the config with pg config';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file]
], 'The pg config creation should be sent to info';
is_deeply $config->data_from($conf_file), {
'core.engine' => 'pg',
}, 'The configuration should have been written with pg options' or diag $conf_file->slurp;
file_contents_like $conf_file, qr/^\t# registry = meta\n/m,
'Configured registry should be in a comment';
file_contents_like $conf_file,
qr{^\t# target = db:pg://postgres\@localhost/thingies\n}m,
'Configured target should be in a comment';
}
##############################################################################
# Test write_plan().
can_ok $init, 'write_plan';
$target = $init->config_target;
$plan_file = $target->plan_file;
file_not_exists_ok $plan_file, 'Plan file should not yet exist';
ok $init->write_plan( project => 'nada' ), 'Write the plan file';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $plan_file]
], 'The plan creation should be sent to info';
file_exists_ok $plan_file, 'Plan file should now exist';
file_contents_is $plan_file,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" .
'%project=nada' . "\n\n",
'The contents should be correct';
# Make sure we don't overwrite the file when initializing again.
ok $init->write_plan( project => 'nada' ), 'Write the plan file again';
file_exists_ok $plan_file, 'Plan file should still exist';
file_contents_is $plan_file,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" .
'%project=nada' . "\n\n",
'The contents should be identical';
# Make sure we get an error trying to initalize a different plan.
throws_ok { $init->write_plan( project => 'oopsie' ) } 'App::Sqitch::X',
'Should get an error initialing a different project';
is $@->ident, 'init', 'Initialization error ident should be "init"';
is $@->message, __x(
'Cannot initialize because project "{project}" already initialized in {file}',
project => 'nada',
file => $plan_file,
), 'Initialzation error message should be correct';
# Write a different file.
my $fh = $plan_file->open('>:utf8_strict') or die "Cannot open $plan_file: $!\n";
$fh->say('# testing 1, 2, 3');
$fh->close;
# Try writing again.
throws_ok { $init->write_plan( project => 'foofoo' ) } 'App::Sqitch::X',
'Should get an error initialzing a non-plan file';
is $@->ident, 'init', 'Non-plan file error ident should be "init"';
is $@->message, __x(
'Cannot initialize because {file} already exists and is not a valid plan file',
file => $plan_file,
), 'Non-plan file error message should be correct';
file_contents_like $plan_file, qr/testing 1, 2, 3/,
'The file should not be overwritten';
# Make sure a URI gets written, if present.
$plan_file->remove;
$sqitch = App::Sqitch->new(config => $config);
END { remove_tree dir('plan.dir')->stringify };
ok $init = $CLASS->new(
sqitch => $sqitch,
uri => $uri,
properties => { top_dir => dir('plan.dir') },
), 'Create new init with sqitch with project and URI';
$target = $init->config_target;
$plan_file = $target->plan_file;
ok $init->write_plan( project => 'howdy', uri => $init->uri ), 'Write the plan file again';
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $plan_file->dir . $sep],
[__x 'Created {file}', file => $plan_file]
], 'The plan creation should be sent to info againq';
file_exists_ok $plan_file, 'Plan file should again exist';
file_contents_is $plan_file,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" .
'%project=howdy' . "\n" .
'%uri=' . $uri->canonical . "\n\n",
'The plan should include the project and uri pragmas';
##############################################################################
# Test _validate_project().
can_ok $init, '_validate_project';
NOPROJ: {
# Test handling of no command.
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(usage => sub { @args = @_; die 'USAGE' });
throws_ok { $CLASS->_validate_project }
qr/USAGE/, 'No project should yield usage';
is_deeply \@args, [$CLASS], 'No args should be passed to usage';
}
# Test invalid project names.
my @bad_names = (
'^foo', # No leading punctuation
'foo^', # No trailing punctuation
'foo^6', # No trailing punctuation+digit
'foo^666', # No trailing punctuation+digits
'%hi', # No leading punctuation
'hi!', # No trailing punctuation
'foo@bar', # No @ allowed at all
'foo:bar', # No : allowed at all
'+foo', # No leading +
'-foo', # No leading -
'@foo', # No leading @
);
for my $bad (@bad_names) {
throws_ok { $init->_validate_project($bad) } 'App::Sqitch::X',
qq{Should get error for invalid project name "$bad"};
is $@->ident, 'init', qq{Bad project "$bad" ident should be "init"};
is $@->message, __x(
qq{invalid project name "{project}": project names must not }
. 'begin with punctuation, contain "@", ":", "#", "[", "]", or blanks, or end in '
. 'punctuation or digits following punctuation',
project => $bad
), qq{Bad project "$bad" error message should be correct};
}
# Make sure that config_target will add the URI if passed (even though it's not
# clear what it's used for, if at all).
isa_ok $target = $init->config_target(
name => 'custom',
uri => URI->new('db:pg:actually'),
), 'App::Sqitch::Target', 'Custom URI target';
is $target->uri, URI->new('db:pg:actually'), 'Shoudl have the custom URI';
is $target->name, 'custom', 'Should have the custom name';
# Handle errors.
FSERR: {
# Make mkpath to insert an error.
my $mock = Test::MockModule->new('File::Path');
$mock->mock( mkpath => sub {
my ($file, $p) = @_;
${ $p->{error} } = [{ $file => 'Permission denied yo'}];
return;
});
throws_ok { $init->mkdirs('foo') } 'App::Sqitch::X',
'Should fail on permission issue';
is $@->ident, 'init', 'Permission error should have ident "init"';
is $@->message, __x(
'Error creating {path}: {error}',
path => 'foo',
error => 'Permission denied yo',
), 'The permission error should be formatted properly';
# Try an error with no path.
throws_ok { $init->mkdirs('') } 'App::Sqitch::X',
'Should fail on nonexistent dir name';
is $@->ident, 'init', 'Nonexistant path error should have ident "init"';
is $@->message, 'Permission denied yo',
'Nonexistant path error should be the message';
}
##############################################################################
# Bring it all together, yo.
$conf_file->remove;
$plan_file->remove;
ok $init->execute('foofoo'), 'Execute!';
# Should have directories.
for my $attr (map { "$_\_dir"} qw(top deploy revert verify)) {
dir_exists_ok $target->$attr;
}
# Should have config and plan.
file_exists_ok $conf_file;
file_exists_ok $plan_file;
# Should have the output.
my @dir_messages = map {
[__x 'Created {file}', file => $target->$_ . $sep]
} map { "$_\_dir" } qw(deploy revert verify);
is_deeply +MockOutput->get_info, [
[__x 'Created {file}', file => $conf_file],
[__x 'Created {file}', file => $plan_file],
@dir_messages,
], 'Should have status messages';
file_contents_is $plan_file,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION() . "\n" .
'%project=foofoo' . "\n" .
'%uri=' . $uri->canonical . "\n\n",
'The plan should have the --project name';
base.t 100644 001751 000166 71141 15004170404 15264 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 224;
# use Test::More 'no_plan';
use Test::MockModule 0.17;
use Path::Class;
use Test::Exception;
use Test::NoWarnings;
use Test::Exit;
use Capture::Tiny 0.12 qw(:all);
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::X 'hurl';
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch';
use_ok $CLASS or die;
}
can_ok $CLASS, qw(
go
new
options
user_name
user_email
verbosity
prompt
ask_yes_no
ask_y_n
);
##############################################################################
# Overrides.
my $config = TestConfig->new;
$config->data({'core.verbosity' => 2});
isa_ok my $sqitch = $CLASS->new({ config => $config, options => {} }),
$CLASS, 'A configured object';
is $sqitch->verbosity, 2, 'Configured verbosity should override default';
isa_ok $sqitch = $CLASS->new({ config => $config, options => {verbosity => 3} }),
$CLASS, 'A configured object';
is $sqitch->verbosity, 3, 'Verbosity option should override configuration';
##############################################################################
# Defaults.
$config->replace;
isa_ok $sqitch = $CLASS->new(config => $config), $CLASS, 'A new object';
is $sqitch->verbosity, 1, 'Default verbosity should be 1';
ok $sqitch->sysuser, 'Should have default sysuser from system';
ok $sqitch->user_name, 'Default user_name should be set from system';
is $sqitch->user_email, do {
require Sys::Hostname;
$sqitch->sysuser . '@' . Sys::Hostname::hostname();
}, 'Default user_email should be set from system';
##############################################################################
# User environment variables.
ENV: {
# Try originating host variables.
local $ENV{SQITCH_ORIG_SYSUSER} = "__kamala__";
local $ENV{SQITCH_ORIG_FULLNAME} = 'Kamala Harris';
local $ENV{SQITCH_ORIG_EMAIL} = 'kamala@whitehouse.gov';
isa_ok $sqitch = $CLASS->new(config => $config), $CLASS, 'Another new object';
is $sqitch->sysuser, $ENV{SQITCH_ORIG_SYSUSER},
"SQITCH_ORIG_SYSUER should override system username";
is $sqitch->user_name, $ENV{SQITCH_ORIG_FULLNAME},
"SQITCH_ORIG_FULLNAME should override system user full name";
is $sqitch->user_email, $ENV{SQITCH_ORIG_EMAIL},
"SQITCH_ORIG_EMAIL should override system-derived email";
# Local variables take precedence over originating host variables.
local $ENV{SQITCH_FULLNAME} = 'Barack Obama';
local $ENV{SQITCH_EMAIL} = 'barack@whitehouse.gov';
isa_ok $sqitch = $CLASS->new, $CLASS, 'Another new object';
is $sqitch->user_name, $ENV{SQITCH_FULLNAME},
"SQITCH_FULLNAME should override originating host user full name";
is $sqitch->user_email, $ENV{SQITCH_EMAIL},
"SQITCH_EMAIL should override originating host email";
}
##############################################################################
# Test go().
GO: {
local $ENV{SQITCH_ORIG_SYSUSER} = "__barack__";
local $ENV{SQITCH_ORIG_FULLNAME} = 'Barack Obama';
local $ENV{SQITCH_ORIG_EMAIL} = 'barack@whitehouse.gov';
my $mock = Test::MockModule->new('App::Sqitch::Command::help');
my ($cmd, @params);
my $ret = 1;
$mock->mock(execute => sub { ($cmd, @params) = @_; $ret });
chdir 't';
my $config = TestConfig->from(
local => 'sqitch.conf',
user => 'user.conf',
);
my $mocker = Test::MockModule->new('App::Sqitch::Config');
$mocker->mock(new => $config);
local @ARGV = qw(help config);
is +App::Sqitch->go, 0, 'Should get 0 from go()';
isa_ok $cmd, 'App::Sqitch::Command::help', 'Command';
is_deeply \@params, ['config'], 'Extra args should be passed to execute';
isa_ok my $sqitch = $cmd->sqitch, 'App::Sqitch';
ok $config = $sqitch->config, 'Get the Sqitch config';
is $config->get(key => 'engine.pg.client'), '/usr/local/pgsql/bin/psql',
'Should have local config overriding user';
is $config->get(key => 'engine.pg.registry'), 'meta',
'Should fall back on user config';
is $sqitch->user_name, 'Michael Stonebraker',
'Should have read user name from configuration';
is $sqitch->user_email, 'michael@example.com',
'Should have read user email from configuration';
is_deeply $sqitch->options, { }, 'Should have no options';
# Make sure USER_NAME and USER_EMAIL take precedence over configuration.
local $ENV{SQITCH_FULLNAME} = 'Michelle Obama';
local $ENV{SQITCH_EMAIL} = 'michelle@whitehouse.gov';
is +App::Sqitch->go, 0, 'Should get 0 from go() again';
isa_ok $sqitch = $cmd->sqitch, 'App::Sqitch';
is $sqitch->user_name, 'Michelle Obama',
'Should have read user name from environment';
is $sqitch->user_email, 'michelle@whitehouse.gov',
'Should have read user email from environment';
# Mock outputs.
my $sqitch_mock = Test::MockModule->new($CLASS);
my @vented;
$sqitch_mock->mock(vent => sub { shift; push @vented => @_ });
my @traced;
$sqitch_mock->mock(trace => sub { shift; push @traced => @_ });
my @infoed;
$sqitch_mock->mock(info => sub { shift; push @infoed => @_ });
my @emitted;
$sqitch_mock->mock(emit => sub { shift; push @emitted => @_ });
# Now make it die.
sub puke { App::Sqitch::X->new(@_) } # Ensures we have trace frames.
my $ex = puke(ident => 'ohai', message => 'OMGWTF!');
$mock->mock(execute => sub { die $ex });
is $sqitch->go, 2, 'Go should return 2 on Sqitch exception';
is_deeply \@vented, ['OMGWTF!'], 'The error should have been vented';
is_deeply \@infoed, [], 'Should have no info output';
is_deeply \@emitted, [], 'Should have no emitted output';
is_deeply \@traced, [$ex->stack_trace->as_string],
'The stack trace should have been sent to trace';
# Make it die with a previous exception.
$ex = puke(ident => 'yikes', message => 'Yikes!', previous_exception => 'Invalid snicker');
@vented = @traced = ();
is $sqitch->go, 2, 'Go should return 2 on next Sqitch exception';
is_deeply \@vented, ['Yikes!'], 'The next error should have been vented';
is_deeply \@infoed, [], 'Should have no info output';
is_deeply \@emitted, [], 'Should have no emitted output';
is_deeply \@traced, ["Invalid snicker\n" . $ex->stack_trace->as_string],
'The previous exceptin and stack trace should have been sent to trace';
# Make it die with a developer exception.
@vented = @traced = ();
$ex = puke( message => 'OUCH!', exitval => 4 );
is $sqitch->go, 4, 'Go should return exitval on another exception';
is_deeply \@vented, ["OUCH!\n" . $ex->stack_trace->as_string],
'Both the message and the trace should have been vented';
is_deeply \@infoed, [], 'Should still have no info output';
is_deeply \@emitted, [], 'Should still have no emitted output';
is_deeply \@traced, [], 'Nothing should have been traced';
# Make it die with a developer previous exception.
@vented = @traced = ();
$ex = puke( message => 'OOOF!', exitval => 3, previous_exception => 'Cannot open file' );
is $sqitch->go, 3, 'Go should return exitval on wrapped exception';
is_deeply \@vented, ["OOOF!\nCannot open file\n" . $ex->stack_trace->as_string],
'Should have vented the message, previous exception, and trace';
is_deeply \@infoed, [], 'Should still have no info output';
is_deeply \@emitted, [], 'Should still have no emitted output';
is_deeply \@traced, [], 'Nothing should have been traced';
# Make it die with a non-fatal exception (error code 1)
@vented = ();
$ex = puke( message => 'OOPS!', exitval => 1 );
is $sqitch->go, 1, 'Go should return exitval on non-fatal exception';
is_deeply \@vented, [], 'Should not have vented';
is_deeply \@infoed, ['OOPS!'], 'Should have sent the message to message';
is_deeply \@emitted, [], 'Should still have no emitted output';
is_deeply \@traced, [], 'Nothing should have been traced';
# Make it die without an exception object.
$ex = 'LOLZ';
@vented = @infoed = ();
is $sqitch->go, 2, 'Go should return 2 on a third Sqitch exception';
is @vented, 1, 'Should have one thing vented';
like $vented[0], qr/^LOLZ\b/, 'And it should include our message';
is_deeply \@infoed, [], 'Should again have no info output';
is_deeply \@emitted, [], 'Should still have no emitted output';
is_deeply \@traced, [], 'Nothing should have been traced';
}
##############################################################################
# Test the editor.
EDITOR: {
local $ENV{SQITCH_EDITOR};
local $ENV{VISUAL};
local $ENV{EDITOR} = 'edd';
my $sqitch = App::Sqitch->new(config => $config);
is $sqitch->editor, 'edd', 'editor should use $EDITOR';
local $ENV{VISUAL} = 'gvim';
$sqitch = App::Sqitch->new(config => $config);
is $sqitch->editor, 'gvim', 'editor should prefer $VISUAL over $EDITOR';
my $config = TestConfig->from(local => 'editor.conf');
$sqitch = App::Sqitch->new(config => $config);
is $sqitch->editor, 'config_specified_editor', 'editor should prefer core.editor over $VISUAL';
local $ENV{SQITCH_EDITOR} = 'vimz';
$sqitch = App::Sqitch->new(config => $config);
is $sqitch->editor, 'vimz', 'editor should prefer $SQITCH_EDITOR over $VISUAL';
$sqitch = App::Sqitch->new({editor => 'emacz' });
is $sqitch->editor, 'emacz', 'editor should use use parameter regardless of environment';
delete $ENV{SQITCH_EDITOR};
delete $ENV{VISUAL};
delete $ENV{EDITOR};
$config->replace;
$sqitch = App::Sqitch->new(config => $config);
if (App::Sqitch::ISWIN) {
is $sqitch->editor, 'notepad.exe', 'editor fall back on notepad on Windows';
} else {
is $sqitch->editor, 'vi', 'editor fall back on vi when not Windows';
}
}
##############################################################################
# Test the pager program config. We want to pick up from one of the following
# places, earlier in the list more preferred.
# - SQITCH_PAGER environment variable.
# - core.pager configuration prop.
# - PAGER environment variable.
#
PAGER_PROGRAM: {
# Ignore warnings while loading IO::Pager.
{ local $SIG{__WARN__} = sub {}; require IO::Pager }
# No pager if no TTY.
my $pager_class = -t *STDOUT ? 'IO::Pager' : 'IO::Handle';
# Mock the IO::Pager constructor.
my $mock_pager = Test::MockModule->new($pager_class);
$mock_pager->mock(new => sub { return bless => {} => $pager_class });
my (@said, @printed);
$mock_pager->mock(say => sub { shift; @said = @_ });
$mock_pager->mock(print => sub { shift; @printed = @_ });
{
local $ENV{SQITCH_PAGER};
local $ENV{PAGER} = "morez";
my $sqitch = App::Sqitch->new(config => $config);
is $sqitch->pager_program, "morez",
"pager program should be picked up from PAGER when SQITCH_PAGER and core.pager are not set";
isa_ok $sqitch->pager, $pager_class, 'morez pager';
lives_ok { $sqitch->page(qw(foo bar)) } 'Should be able to page';
is_deeply \@said, [qw(foo bar)], 'Should have paged with say()';
lives_ok { $sqitch->page_literal(qw(foo bar)) } 'Should be able to page literal';
is_deeply \@printed, [qw(foo bar)], 'Should have paged with print()';
}
{
local $ENV{SQITCH_PAGER} = "less -myway";
local $ENV{PAGER} = "morezz";
my $sqitch = App::Sqitch->new;
is $sqitch->pager_program, "less -myway", "SQITCH_PAGER should take precedence over PAGER";
isa_ok $sqitch->pager, $pager_class, 'less -myway';
}
{
local $ENV{SQITCH_PAGER};
local $ENV{PAGER} = "morezz";
my $config = TestConfig->from(local => 'sqitch.conf');
my $sqitch = App::Sqitch->new(config => $config);
is $sqitch->pager_program, "less -r",
"`core.pager' setting should take precedence over PAGER when SQITCH_PAGER is not set.";
isa_ok $sqitch->pager, $pager_class, 'morezz pager';
}
{
local $ENV{SQITCH_PAGER} = "less -rules";
local $ENV{PAGER} = "more -dontcare";
# Should always get IO::Handle with --no-pager.
my $config = TestConfig->from(local => 'sqitch.conf');
my $sqitch = App::Sqitch->new(config => $config, options => {no_pager => 1});
is $sqitch->pager_program, "less -rules",
"SQITCH_PAGER should take precedence over both PAGER and the `core.pager' setting.";
isa_ok $sqitch->pager, 'IO::Handle', 'less -rules';
}
}
##############################################################################
# Test message levels. Start with trace.
$sqitch = $CLASS->new(verbosity => 3);
is capture_stdout { $sqitch->trace('This ', "that\n", 'and the other') },
"trace: This that\ntrace: and the other\n",
'trace should work';
$sqitch = $CLASS->new(verbosity => 2);
is capture_stdout { $sqitch->trace('This ', "that\n", 'and the other') },
'', 'Should get no trace output for verbosity 2';
# Trace literal
$sqitch = $CLASS->new(verbosity => 3);
is capture_stdout { $sqitch->trace_literal('This ', "that\n", 'and the other') },
"trace: This that\ntrace: and the other",
'trace_literal should work';
$sqitch = $CLASS->new(verbosity => 2);
is capture_stdout { $sqitch->trace_literal('This ', "that\n", 'and the other') },
'', 'Should get no trace_literal output for verbosity 2';
# Debug.
$sqitch = $CLASS->new(verbosity => 2);
is capture_stdout { $sqitch->debug('This ', "that\n", 'and the other') },
"debug: This that\ndebug: and the other\n",
'debug should work';
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->debug('This ', "that\n", 'and the other') },
'', 'Should get no debug output for verbosity 1';
# Debug literal.
$sqitch = $CLASS->new(verbosity => 2);
is capture_stdout { $sqitch->debug_literal('This ', "that\n", 'and the other') },
"debug: This that\ndebug: and the other",
'debug_literal should work';
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->debug_literal('This ', "that\n", 'and the other') },
'', 'Should get no debug_literal output for verbosity 1';
# Info.
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->info('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'info should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->info('This ', "that\n", 'and the other') },
'', 'Should get no info output for verbosity 0';
# Info literal.
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->info_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'info_literal should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->info_literal('This ', "that\n", 'and the other') },
'', 'Should get no info_literal output for verbosity 0';
# Comment.
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') },
"# This that\n# and the other\n",
'comment should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') },
"# This that\n# and the other\n",
'comment should work with verbosity 0';
# Comment literal.
$sqitch = $CLASS->new(verbosity => 1);
is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') },
"# This that\n# and the other",
'comment_literal should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') },
"# This that\n# and the other",
'comment_literal should work with verbosity 0';
# Emit.
is capture_stdout { $sqitch->emit('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'emit should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->emit('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'emit should work even with verbosity 0';
# Emit literal.
is capture_stdout { $sqitch->emit_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'emit_literal should work';
$sqitch = $CLASS->new(verbosity => 0);
is capture_stdout { $sqitch->emit_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'emit_literal should work even with verbosity 0';
# Warn.
is capture_stderr { $sqitch->warn('This ', "that\n", 'and the other') },
"warning: This that\nwarning: and the other\n",
'warn should work';
# Warn_Literal.
is capture_stderr { $sqitch->warn_literal('This ', "that\n", 'and the other') },
"warning: This that\nwarning: and the other",
'warn_literal should work';
# Vent.
is capture_stderr { $sqitch->vent('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'vent should work';
# Vent literal.
is capture_stderr { $sqitch->vent_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'vent_literal should work';
##############################################################################
# Test run().
can_ok $CLASS, 'run';
my ($stdout, $stderr) = capture {
ok $sqitch->run(
$^X, 'echo.pl', qw(hi there)
), 'Should get success back from run echo';
};
is $stdout, "hi there\n", 'The echo script should have run';
is $stderr, '', 'Nothing should have gone to STDERR';
($stdout, $stderr) = capture {
throws_ok {
$sqitch->run( $^X, 'die.pl', qw(hi there))
} 'App::Sqitch::X', 'run die should, well, die';
is $@->ident, 'ipc', 'Error ident should be "ipc"';
like $@->message,
qr/unexpectedly returned/,
'The error message should be from the exit error';
};
is $stdout, "hi there\n", 'The die script should have its STDOUT ummolested';
like $stderr, qr/OMGWTF/, 'The die script should have its STDERR unmolested';
##############################################################################
# Test shell().
can_ok $CLASS, 'shell';
my $pl = $sqitch->quote_shell($^X);
($stdout, $stderr) = capture {
ok $sqitch->shell(
"$pl echo.pl hi there"
), 'Should get success back from shell echo';
};
is $stdout, "hi there\n", 'The echo script should have shell';
is $stderr, '', 'Nothing should have gone to STDERR';
($stdout, $stderr) = capture {
throws_ok {
$sqitch->shell( "$pl die.pl hi there" )
} 'App::Sqitch::X', 'shell die should, well, die';
is $@->ident, 'ipc', 'Error ident should be "ipc"';
like $@->message,
qr/unexpectedly returned/,
'The error message should be from the exit error';
};
is $stdout, "hi there\n", 'The die script should have its STDOUT ummolested';
like $stderr, qr/OMGWTF/, 'The die script should have its STDERR unmolested';
##############################################################################
# Test quote_shell().
my $quoter = do {
if (App::Sqitch::ISWIN) {
require Win32::ShellQuote;
\&Win32::ShellQuote::quote_native;
} else {
require String::ShellQuote;
\&String::ShellQuote::shell_quote;
}
};
is $sqitch->quote_shell(qw(foo bar baz), 'hi there'),
$quoter->(qw(foo bar baz), 'hi there'), 'quote_shell should work';
##############################################################################
# Test capture().
can_ok $CLASS, 'capture';
is $sqitch->capture($^X, 'echo.pl', qw(hi there)),
"hi there\n", 'The echo script output should have been returned';
like capture_stderr {
throws_ok { $sqitch->capture($^X, 'die.pl', qw(hi there)) }
'App::Sqitch::X',
'Should get an error if the command errors out';
is $@->ident, 'ipc', 'Error ident should be "ipc"';
like $@->message,
qr/unexpectedly returned/,
'The error message should be from the exit error';
}, qr/OMGWTF/m, 'The die script STDERR should have passed through';
##############################################################################
# Test probe().
can_ok $CLASS, 'probe';
is $sqitch->probe($^X, 'echo.pl', qw(hi there), "\nyo"),
"hi there ", 'Should have just chomped first line of output';
##############################################################################
# Test spool().
can_ok $CLASS, 'spool';
my $data = "hi\nthere\n";
open my $fh, '<', \$data;
is capture_stdout {
ok $sqitch->spool($fh, $^X, 'read.pl'), 'Spool to read.pl';
}, $data, 'Data should have been sent to STDOUT by read.pl';
seek $fh, 0, 0;
open my $fh2, '<', \$CLASS;
is capture_stdout {
ok $sqitch->spool([$fh, $fh2], $^X, 'read.pl'), 'Spool to read.pl';
}, $data . $CLASS, 'All data should have been sent to STDOUT by read.pl';
like capture_stderr {
local $ENV{LANGUAGE} = 'en';
throws_ok { $sqitch->spool($fh, $^X, 'die.pl') }
'App::Sqitch::X', 'Should get error when die.pl dies';
is $@->ident, 'io', 'Error ident should be "io"';
like $@->message,
qr/\Q$^X\E unexpectedly returned exit value |\QError closing pipe to/,
'The error message should be one of the I/O messages';
}, qr/OMGWTF/, 'The die script STDERR should have passed through';
throws_ok {
local $ENV{LANGUAGE} = 'en';
$sqitch->spool($fh, '--nosuchscript.ply--')
} 'App::Sqitch::X', 'Should get an error for a bad command';
is $@->ident, 'io', 'Error ident should be "io"';
like $@->message,
qr/\QCannot exec --nosuchscript.ply--:\E|\QError closing pipe to --nosuchscript.ply--:/,
'Error message should be about inability to exec';
##############################################################################
# Test prompt().
throws_ok { $sqitch->prompt } 'App::Sqitch::X',
'Should get error for no prompt message';
is $@->ident, 'DEV', 'No prompt ident should be "DEV"';
is $@->message, 'prompt() called without a prompt message',
'No prompt error message should be correct';
my $sqitch_mock = Test::MockModule->new($CLASS);
my $input = 'hey';
$sqitch_mock->mock(_readline => sub { $input });
my $unattended = 0;
$sqitch_mock->mock(_is_unattended => sub { $unattended });
is capture_stdout {
is $sqitch->prompt('hi'), 'hey', 'Prompt should return input';
}, 'hi ', 'Prompt should prompt';
$input = 'how';
is capture_stdout {
is $sqitch->prompt('hi', 'blah'), 'how',
'Prompt with default should return input';
}, 'hi [blah] ', 'Prompt should prompt with default';
$input = 'hi';
is capture_stdout {
is $sqitch->prompt('hi', undef), 'hi',
'Prompt with undef default should return input';
}, 'hi [] ', 'Prompt should prompt with bracket for undef default';
$input = undef;
is capture_stdout {
is $sqitch->prompt('hi', 'yo'), 'yo',
'Prompt should return default for undef input';
}, 'hi [yo] ', 'Prompt should show default when undef input';
$input = '';
is capture_stdout {
is $sqitch->prompt('hi', 'yo'), 'yo',
'Prompt should return input for empty input';
}, 'hi [yo] ', 'Prompt should show default when empty input';
$unattended = 1;
throws_ok {
is capture_stdout { $sqitch->prompt('yo') }, "yo \n",
'Unattended message should be emitted';
} 'App::Sqitch::X', 'Should get error when uattended and no default';
is $@->ident, 'io', 'Unattended error ident should be "io"';
is $@->message, __(
'Sqitch seems to be unattended and there is no default value for this question'
), 'Unattended error message should be correct';
is capture_stdout {
is $sqitch->prompt('hi', 'yo'), 'yo', 'Prompt should return input';
}, "hi [yo] yo\n", 'Prompt should show default as selected when unattended';
##############################################################################
# Test ask_yes_no().
throws_ok { $sqitch->ask_yes_no } 'App::Sqitch::X',
'Should get error for no ask_yes_no message';
is $@->ident, 'DEV', 'No ask_yes_no ident should be "DEV"';
is $@->message, 'ask_yes_no() called without a prompt message',
'No ask_yes_no error message should be correct';
my $yes = __p 'Confirm prompt answer yes', 'Yes';
my $no = __p 'Confirm prompt answer no', 'No';
# Test affirmation.
for my $variant ($yes, lc $yes, uc $yes, lc substr($yes, 0, 1), substr($yes, 0, 2)) {
$input = $variant;
$unattended = 0;
is capture_stdout {
ok $sqitch->ask_yes_no('hi'),
qq{ask_yes_no() should return true for "$variant" input};
}, 'hi ', qq{ask_yes_no() should prompt for "$variant"};
}
# Test negation.
for my $variant ($no, lc $no, uc $no, lc substr($no, 0, 1), substr($no, 0, 2)) {
$input = $variant;
$unattended = 0;
is capture_stdout {
ok !$sqitch->ask_yes_no('hi'),
qq{ask_yes_no() should return false for "$variant" input};
}, 'hi ', qq{ask_yes_no() should prompt for "$variant"};
}
# Test defaults.
$input = '';
is capture_stdout {
ok $sqitch->ask_yes_no('whu?', 1),
'ask_yes_no() should return true for true default'
}, "whu? [$yes] ", 'ask_yes_no() should prompt and show default "Yes"';
is capture_stdout {
ok !$sqitch->ask_yes_no('whu?', 0),
'ask_yes_no() should return false for false default'
}, "whu? [$no] ", 'ask_yes_no() should prompt and show default "No"';
my $please = __ 'Please answer "y" or "n".';
$input = 'ha!';
throws_ok {
is capture_stdout { $sqitch->ask_yes_no('hi') },
"hi \n$please\nhi \n$please\nhi \n",
'Should get prompts for repeated bad answers';
} 'App::Sqitch::X', 'Should get error for bad answers';
is $@->ident, 'io', 'Bad answers ident should be "IO"';
is $@->message, __ 'No valid answer after 3 attempts; aborting',
'Bad answers message should be correct';
##############################################################################
# Test ask_y_n().
my $warning;
$sqitch_mock->mock(warn => sub { shift; $warning = "@_" });
throws_ok { $sqitch->ask_y_n } 'App::Sqitch::X',
'Should get error for no ask_y_n message';
is $@->ident, 'DEV', 'No ask_y_n ident should be "DEV"';
is $@->message, 'ask_yes_no() called without a prompt message',
'No ask_y_n error message should be correct';
is $warning, 'The ask_y_n() method has been deprecated. Use ask_yes_no() instead.',
'Should get a deprecation warning from ask_y_n';
throws_ok { $sqitch->ask_y_n('hi', 'b') } 'App::Sqitch::X',
'Should get error for invalid ask_y_n default';
is $@->ident, 'DEV', 'Invalid ask_y_n default ident should be "DEV"';
is $@->message, 'Invalid default value: ask_y_n() default must be "y" or "n"',
'Invalid ask_y_n default error message should be correct';
$input = lc substr $yes, 0, 1;
$unattended = 0;
is capture_stdout {
ok $sqitch->ask_y_n('hi'),
qq{ask_y_n should return true for "$input" input}
}, 'hi ', 'ask_y_n() should prompt';
$input = lc substr $no, 0, 1;
is capture_stdout {
ok !$sqitch->ask_y_n('howdy'),
qq{ask_y_n should return false for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for no';
$input = uc substr $no, 0, 1;
is capture_stdout {
ok !$sqitch->ask_y_n('howdy'),
qq{ask_y_n should return false for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for no';
$input = uc substr $yes, 0, 2;
is capture_stdout {
ok $sqitch->ask_y_n('howdy'),
qq{ask_y_n should return true for "$input" input}
}, 'howdy ', 'ask_y_n() should prompt for yes';
$input = '';
is capture_stdout {
ok $sqitch->ask_y_n('whu?', 'y'),
qq{ask_y_n should return true default "$yes"}
}, "whu? [$yes] ", 'ask_y_n() should prompt and show default "Yes"';
is capture_stdout {
ok !$sqitch->ask_y_n('whu?', 'n'),
qq{ask_y_n should return false default "$no"};
}, "whu? [$no] ", 'ask_y_n() should prompt and show default "No"';
$input = 'ha!';
throws_ok {
is capture_stdout { $sqitch->ask_y_n('hi') },
"hi \n$please\nhi \n$please\nhi \n",
'Should get prompts for repeated bad answers';
} 'App::Sqitch::X', 'Should get error for bad answers';
is $@->ident, 'io', 'Bad answers ident should be "IO"';
is $@->message, __ 'No valid answer after 3 attempts; aborting',
'Bad answers message should be correct';
##############################################################################
# Test _readline.
$sqitch_mock->unmock('_readline');
$input = 'hep';
open my $stdin, '<', \$input;
*STDIN = $stdin;
is $sqitch->_readline, $input, '_readline should work';
$unattended = 1;
is $sqitch->_readline, undef, '_readline should return undef when unattended';
$sqitch_mock->unmock_all;
##############################################################################
# Make sure Test::LocaleDomain gives us decoded strings.
for my $lang (qw(en fr)) {
local $ENV{LANGUAGE} = $lang;
my $text = __x 'On database {db}', db => 'foo';
ok utf8::valid($text), 'Localied string should be valid UTF-8';
ok utf8::is_utf8($text), 'Localied string should be decoded';
}
##############################################################################
# Test interactivity.
lives_ok { $CLASS->_is_interactive } '_is_interactive should not die';
lives_ok { $CLASS->_is_unattended } '_is_unattended should not die';
# Test utilities.
is $CLASS->_bn(__FILE__), 'base.t', '_bn should work';
META.yml 100644 001751 000166 7043 15004170404 15153 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 ---
abstract: 'Sensible database change management'
author:
- '"iovation Inc., David E. Wheeler"'
build_requires:
Capture::Tiny: '0.12'
Carp: '0'
DBD::Mem: '0'
File::Find: '0'
File::Spec: '0'
File::Spec::Functions: '0'
FindBin: '0'
IO::Pager: '0.34'
Module::Build: '0.35'
Module::Runtime: '0'
Path::Class: '0.33'
Test::Deep: '0'
Test::Dir: '0'
Test::Exception: '0'
Test::Exit: '0'
Test::File: '0'
Test::File::Contents: '0.20'
Test::MockModule: '0.17'
Test::MockObject::Extends: '0'
Test::More: '0.94'
Test::NoWarnings: '0.083'
Test::Warn: '0.31'
base: '0'
lib: '0'
configure_requires:
Module::Build: '0.35'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010'
license: mit
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: App-Sqitch
no_index:
directory:
- priv
optional_features:
exasol:
description: 'Support for managing Exasol databases'
requires:
DBD::ODBC: '1.59'
firebird:
description: 'Support for managing Firebird databases'
requires:
DBD::Firebird: '1.11'
Time::HiRes: '0'
Time::Local: '0'
mysql:
description: 'Support for managing MySQL databases'
requires:
DBD::MariaDB: '1.0'
MySQL::Config: '0'
odbc:
description: 'Include the ODBC driver.'
requires:
DBD::ODBC: '1.59'
oracle:
description: 'Support for managing Oracle databases'
requires:
DBD::Oracle: '1.23'
postgres:
description: 'Support for managing Postgres, Yugabyte, and Cockroch databases'
requires:
DBD::Pg: '2.0'
snowflake:
description: 'Support for managing Snowflake databases'
requires:
DBD::ODBC: '1.59'
sqlite:
description: 'Support for managing SQLite databases'
requires:
DBD::SQLite: '1.37'
vertica:
description: 'Support for managing Vertica databases'
requires:
DBD::ODBC: '1.59'
recommends:
Class::XSAccessor: '1.18'
Pod::Simple: '1.41'
Template: '0'
Type::Tiny::XS: '0.010'
requires:
Algorithm::Backoff::Exponential: '0.006'
Clone: '0'
Config::GitLike: '1.15'
DBI: '1.631'
DateTime: '1.04'
DateTime::TimeZone: '0'
Devel::StackTrace: '1.30'
Digest::SHA: '0'
Encode: '0'
Encode::Locale: '0'
File::Basename: '0'
File::Copy: '0'
File::Path: '0'
File::Temp: '0'
Getopt::Long: '0'
Hash::Merge: '0'
IO::Handle: '0'
IO::Pager: '0.34'
IPC::Run3: '0'
IPC::System::Simple: '1.17'
List::MoreUtils: '0'
List::Util: '0'
Locale::Messages: '0'
Locale::TextDomain: '1.20'
Moo: '1.002000'
Moo::Role: '0'
POSIX: '0'
Path::Class: '0.33'
PerlIO::utf8_strict: '0'
Pod::Escapes: '1.04'
Pod::Find: '0'
Pod::Usage: '0'
Scalar::Util: '0'
StackTrace::Auto: '0'
String::Formatter: '0'
String::ShellQuote: '0'
Sub::Exporter: '0'
Sub::Exporter::Util: '0'
Sys::Hostname: '0'
Template::Tiny: '0.11'
Term::ANSIColor: '2.02'
Throwable: '0.200009'
Time::HiRes: '0'
Time::Local: '0'
Try::Tiny: '0'
Type::Library: '0.040'
Type::Utils: '0'
Types::Standard: '0'
URI: '0'
URI::QueryParam: '0'
URI::db: '0.20'
User::pwent: '0'
constant: '0'
locale: '0'
namespace::autoclean: '0.16'
overload: '0'
parent: '0'
perl: '5.010'
strict: '0'
utf8: '0'
warnings: '0'
resources:
bugtracker: https://github.com/sqitchers/sqitch/issues/
homepage: https://sqitch.org/
repository: https://github.com/sqitchers/sqitch/
version: v1.5.2
x_generated_by_perl: v5.40.2
x_serialization_backend: 'YAML::Tiny version 1.76'
x_spdx_expression: MIT
MANIFEST 100644 001751 000166 17440 15004170404 15055 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032.
Build.PL
Changes
LICENSE
LICENSE.md
MANIFEST
META.json
META.yml
README
README.md
bin/sqitch
dist/cpanfile
dist/sqitch.spec
etc/templates/deploy/cockroach.tmpl
etc/templates/deploy/exasol.tmpl
etc/templates/deploy/firebird.tmpl
etc/templates/deploy/mysql.tmpl
etc/templates/deploy/oracle.tmpl
etc/templates/deploy/pg.tmpl
etc/templates/deploy/snowflake.tmpl
etc/templates/deploy/sqlite.tmpl
etc/templates/deploy/vertica.tmpl
etc/templates/revert/cockroach.tmpl
etc/templates/revert/exasol.tmpl
etc/templates/revert/firebird.tmpl
etc/templates/revert/mysql.tmpl
etc/templates/revert/oracle.tmpl
etc/templates/revert/pg.tmpl
etc/templates/revert/snowflake.tmpl
etc/templates/revert/sqlite.tmpl
etc/templates/revert/vertica.tmpl
etc/templates/verify/cockroach.tmpl
etc/templates/verify/exasol.tmpl
etc/templates/verify/firebird.tmpl
etc/templates/verify/mysql.tmpl
etc/templates/verify/oracle.tmpl
etc/templates/verify/pg.tmpl
etc/templates/verify/snowflake.tmpl
etc/templates/verify/sqlite.tmpl
etc/templates/verify/vertica.tmpl
etc/tools/upgrade-registry-to-mysql-5.5.0.sql
etc/tools/upgrade-registry-to-mysql-5.6.4.sql
inc/Menlo/Sqitch.pm
inc/Module/Build/Sqitch.pm
lib/App/Sqitch.pm
lib/App/Sqitch/Command.pm
lib/App/Sqitch/Command/add.pm
lib/App/Sqitch/Command/bundle.pm
lib/App/Sqitch/Command/check.pm
lib/App/Sqitch/Command/checkout.pm
lib/App/Sqitch/Command/config.pm
lib/App/Sqitch/Command/deploy.pm
lib/App/Sqitch/Command/engine.pm
lib/App/Sqitch/Command/help.pm
lib/App/Sqitch/Command/init.pm
lib/App/Sqitch/Command/log.pm
lib/App/Sqitch/Command/plan.pm
lib/App/Sqitch/Command/rebase.pm
lib/App/Sqitch/Command/revert.pm
lib/App/Sqitch/Command/rework.pm
lib/App/Sqitch/Command/show.pm
lib/App/Sqitch/Command/status.pm
lib/App/Sqitch/Command/tag.pm
lib/App/Sqitch/Command/target.pm
lib/App/Sqitch/Command/upgrade.pm
lib/App/Sqitch/Command/verify.pm
lib/App/Sqitch/Config.pm
lib/App/Sqitch/DateTime.pm
lib/App/Sqitch/Engine.pm
lib/App/Sqitch/Engine/Upgrade/cockroach-1.0.sql
lib/App/Sqitch/Engine/Upgrade/cockroach-1.1.sql
lib/App/Sqitch/Engine/Upgrade/exasol-1.0.sql
lib/App/Sqitch/Engine/Upgrade/exasol-1.1.sql
lib/App/Sqitch/Engine/Upgrade/firebird-1.0.sql
lib/App/Sqitch/Engine/Upgrade/firebird-1.1.sql
lib/App/Sqitch/Engine/Upgrade/mysql-1.0.sql
lib/App/Sqitch/Engine/Upgrade/mysql-1.1.sql
lib/App/Sqitch/Engine/Upgrade/oracle-1.0.sql
lib/App/Sqitch/Engine/Upgrade/oracle-1.1.sql
lib/App/Sqitch/Engine/Upgrade/pg-1.0.sql
lib/App/Sqitch/Engine/Upgrade/pg-1.1.sql
lib/App/Sqitch/Engine/Upgrade/snowflake-1.0.sql
lib/App/Sqitch/Engine/Upgrade/snowflake-1.1.sql
lib/App/Sqitch/Engine/Upgrade/sqlite-1.0.sql
lib/App/Sqitch/Engine/Upgrade/sqlite-1.1.sql
lib/App/Sqitch/Engine/Upgrade/vertica-1.0.sql
lib/App/Sqitch/Engine/Upgrade/vertica-1.1.sql
lib/App/Sqitch/Engine/cockroach.pm
lib/App/Sqitch/Engine/cockroach.sql
lib/App/Sqitch/Engine/exasol.pm
lib/App/Sqitch/Engine/exasol.sql
lib/App/Sqitch/Engine/firebird.pm
lib/App/Sqitch/Engine/firebird.sql
lib/App/Sqitch/Engine/mysql.pm
lib/App/Sqitch/Engine/mysql.sql
lib/App/Sqitch/Engine/oracle.pm
lib/App/Sqitch/Engine/oracle.sql
lib/App/Sqitch/Engine/pg.pm
lib/App/Sqitch/Engine/pg.sql
lib/App/Sqitch/Engine/snowflake.pm
lib/App/Sqitch/Engine/snowflake.sql
lib/App/Sqitch/Engine/sqlite.pm
lib/App/Sqitch/Engine/sqlite.sql
lib/App/Sqitch/Engine/vertica.pm
lib/App/Sqitch/Engine/vertica.sql
lib/App/Sqitch/ItemFormatter.pm
lib/App/Sqitch/Plan.pm
lib/App/Sqitch/Plan/Blank.pm
lib/App/Sqitch/Plan/Change.pm
lib/App/Sqitch/Plan/ChangeList.pm
lib/App/Sqitch/Plan/Depend.pm
lib/App/Sqitch/Plan/Line.pm
lib/App/Sqitch/Plan/LineList.pm
lib/App/Sqitch/Plan/Pragma.pm
lib/App/Sqitch/Plan/Tag.pm
lib/App/Sqitch/Role/ConnectingCommand.pm
lib/App/Sqitch/Role/ContextCommand.pm
lib/App/Sqitch/Role/DBIEngine.pm
lib/App/Sqitch/Role/RevertDeployCommand.pm
lib/App/Sqitch/Role/TargetConfigCommand.pm
lib/App/Sqitch/Target.pm
lib/App/Sqitch/Types.pm
lib/App/Sqitch/X.pm
lib/LocaleData/de_DE/LC_MESSAGES/App-Sqitch.mo
lib/LocaleData/fr_FR/LC_MESSAGES/App-Sqitch.mo
lib/LocaleData/it_IT/LC_MESSAGES/App-Sqitch.mo
lib/sqitch-add-usage.pod
lib/sqitch-add.pod
lib/sqitch-authentication.pod
lib/sqitch-bundle-usage.pod
lib/sqitch-bundle.pod
lib/sqitch-check-usage.pod
lib/sqitch-check.pod
lib/sqitch-checkout-usage.pod
lib/sqitch-checkout.pod
lib/sqitch-config-usage.pod
lib/sqitch-config.pod
lib/sqitch-configuration.pod
lib/sqitch-deploy-usage.pod
lib/sqitch-deploy.pod
lib/sqitch-engine-usage.pod
lib/sqitch-engine.pod
lib/sqitch-environment.pod
lib/sqitch-help-usage.pod
lib/sqitch-help.pod
lib/sqitch-init-usage.pod
lib/sqitch-init.pod
lib/sqitch-log-usage.pod
lib/sqitch-log.pod
lib/sqitch-passwords.pod
lib/sqitch-plan-usage.pod
lib/sqitch-plan.pod
lib/sqitch-rebase-usage.pod
lib/sqitch-rebase.pod
lib/sqitch-revert-usage.pod
lib/sqitch-revert.pod
lib/sqitch-rework-usage.pod
lib/sqitch-rework.pod
lib/sqitch-show-usage.pod
lib/sqitch-show.pod
lib/sqitch-status-usage.pod
lib/sqitch-status.pod
lib/sqitch-tag-usage.pod
lib/sqitch-tag.pod
lib/sqitch-target-usage.pod
lib/sqitch-target.pod
lib/sqitch-upgrade-usage.pod
lib/sqitch-upgrade.pod
lib/sqitch-verify-usage.pod
lib/sqitch-verify.pod
lib/sqitch.pod
lib/sqitchchanges.pod
lib/sqitchcommands.pod
lib/sqitchguides.pod
lib/sqitchtutorial-exasol.pod
lib/sqitchtutorial-firebird.pod
lib/sqitchtutorial-mysql.pod
lib/sqitchtutorial-oracle.pod
lib/sqitchtutorial-snowflake.pod
lib/sqitchtutorial-sqlite.pod
lib/sqitchtutorial-vertica.pod
lib/sqitchtutorial.pod
lib/sqitchusage.pod
t/add.t
t/add_change.conf
t/base.t
t/blank.t
t/bundle.t
t/change.t
t/changelist.t
t/check.t
t/checkout.t
t/cockroach.t
t/command.t
t/config.t
t/configuration.t
t/conn_cmd_role.t
t/core.conf
t/core_target.conf
t/cx_cmd_role.t
t/datetime.t
t/dbiengine_role.t
t/depend.t
t/deploy.t
t/die.pl
t/echo.pl
t/editor.conf
t/engine.conf
t/engine.t
t/engine/deploy/func/add_user.sql
t/engine/deploy/users.sql
t/engine/deploy/widgets.sql
t/engine/revert/func/add_user.sql
t/engine/revert/users.sql
t/engine/revert/widgets.sql
t/engine/reworked/deploy/users@alpha.sql
t/engine/reworked/revert/users@alpha.sql
t/engine/sqitch.plan
t/engine_cmd.t
t/exasol.t
t/firebird.t
t/help.t
t/init.t
t/item_formatter.t
t/lib/App/Sqitch/Command/bad.pm
t/lib/App/Sqitch/Command/good.pm
t/lib/App/Sqitch/Engine/bad.pm
t/lib/App/Sqitch/Engine/good.pm
t/lib/DBIEngineTest.pm
t/lib/LC.pm
t/lib/MockOutput.pm
t/lib/TestConfig.pm
t/lib/upgradable_registries/cockroach.sql
t/lib/upgradable_registries/exasol.sql
t/lib/upgradable_registries/firebird.sql
t/lib/upgradable_registries/mysql.sql
t/lib/upgradable_registries/oracle.sql
t/lib/upgradable_registries/pg.sql
t/lib/upgradable_registries/snowflake.sql
t/lib/upgradable_registries/sqlite.sql
t/lib/upgradable_registries/vertica.sql
t/linelist.t
t/local.conf
t/log.t
t/mooseless.t
t/multiplan.conf
t/mysql.t
t/odbc/odbcinst.ini
t/odbc/snowflake.ini
t/odbc/vertica.ini
t/options.t
t/oracle.t
t/pg.t
t/plan.t
t/plan_cmd.t
t/plans/bad-change.plan
t/plans/changes-only.plan
t/plans/dependencies.plan
t/plans/deploy-and-revert.plan
t/plans/dos.plan
t/plans/dupe-change-diff-tag.plan
t/plans/dupe-change.plan
t/plans/dupe-tag.plan
t/plans/multi.plan
t/plans/pragmas.plan
t/plans/project_deps.plan
t/plans/reserved-tag.plan
t/plans/widgets.plan
t/pragma.t
t/read.pl
t/rebase.t
t/revert.t
t/rework.conf
t/rework.t
t/show.t
t/snowflake.t
t/sqitch
t/sqitch.conf
t/sql/deploy/curry.sql
t/sql/deploy/dr_evil.sql
t/sql/deploy/lolz.sql
t/sql/deploy/oops.sql
t/sql/deploy/roles.sql
t/sql/deploy/tacos.sql
t/sql/deploy/users.sql
t/sql/deploy/widgets.sql
t/sql/revert/curry.sql
t/sql/revert/dr_evil.sql
t/sql/revert/lolz.sql
t/sql/revert/roles.sql
t/sql/revert/tacos.sql
t/sql/revert/users.sql
t/sql/revert/widgets.sql
t/sql/sqitch.plan
t/sql/verify/users.sql
t/sqlite.t
t/status.t
t/tag.t
t/tag_cmd.t
t/target.conf
t/target.t
t/target_cmd.t
t/templates.conf
t/upgrade.t
t/user.conf
t/verify.t
t/vertica.t
t/win32.t
t/x.t
Build.PL 100644 001751 000166 7530 15004170404 15177 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2
# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.032.
use strict;
use warnings;
use Module::Build 0.35;
use lib qw{inc}; use Module::Build::Sqitch;
my %module_build_args = (
"build_requires" => {
"Module::Build" => "0.35"
},
"configure_requires" => {
"Module::Build" => "0.35"
},
"dist_abstract" => "Sensible database change management",
"dist_author" => [
"\"iovation Inc., David E. Wheeler\""
],
"dist_name" => "App-Sqitch",
"dist_version" => "v1.5.2",
"license" => "mit",
"module_name" => "App::Sqitch",
"recommends" => {
"Class::XSAccessor" => "1.18",
"Pod::Simple" => "1.41",
"Template" => 0,
"Type::Tiny::XS" => "0.010"
},
"recursive_test_files" => 1,
"requires" => {
"Algorithm::Backoff::Exponential" => "0.006",
"Clone" => 0,
"Config::GitLike" => "1.15",
"DBI" => "1.631",
"DateTime" => "1.04",
"DateTime::TimeZone" => 0,
"Devel::StackTrace" => "1.30",
"Digest::SHA" => 0,
"Encode" => 0,
"Encode::Locale" => 0,
"File::Basename" => 0,
"File::Copy" => 0,
"File::Path" => 0,
"File::Temp" => 0,
"Getopt::Long" => 0,
"Hash::Merge" => 0,
"IO::Handle" => 0,
"IO::Pager" => "0.34",
"IPC::Run3" => 0,
"IPC::System::Simple" => "1.17",
"List::MoreUtils" => 0,
"List::Util" => 0,
"Locale::Messages" => 0,
"Locale::TextDomain" => "1.20",
"Moo" => "1.002000",
"Moo::Role" => 0,
"POSIX" => 0,
"Path::Class" => "0.33",
"PerlIO::utf8_strict" => 0,
"Pod::Escapes" => "1.04",
"Pod::Find" => 0,
"Pod::Usage" => 0,
"Scalar::Util" => 0,
"StackTrace::Auto" => 0,
"String::Formatter" => 0,
"String::ShellQuote" => 0,
"Sub::Exporter" => 0,
"Sub::Exporter::Util" => 0,
"Sys::Hostname" => 0,
"Template::Tiny" => "0.11",
"Term::ANSIColor" => "2.02",
"Throwable" => "0.200009",
"Time::HiRes" => 0,
"Time::Local" => 0,
"Try::Tiny" => 0,
"Type::Library" => "0.040",
"Type::Utils" => 0,
"Types::Standard" => 0,
"URI" => 0,
"URI::QueryParam" => 0,
"URI::db" => "0.20",
"User::pwent" => 0,
"constant" => 0,
"locale" => 0,
"namespace::autoclean" => "0.16",
"overload" => 0,
"parent" => 0,
"perl" => "5.010",
"strict" => 0,
"utf8" => 0,
"warnings" => 0
},
"script_files" => [
"bin/sqitch"
],
"test_requires" => {
"Capture::Tiny" => "0.12",
"Carp" => 0,
"DBD::Mem" => 0,
"File::Find" => 0,
"File::Spec" => 0,
"File::Spec::Functions" => 0,
"FindBin" => 0,
"IO::Pager" => "0.34",
"Module::Runtime" => 0,
"Path::Class" => "0.33",
"Test::Deep" => 0,
"Test::Dir" => 0,
"Test::Exception" => 0,
"Test::Exit" => 0,
"Test::File" => 0,
"Test::File::Contents" => "0.20",
"Test::MockModule" => "0.17",
"Test::MockObject::Extends" => 0,
"Test::More" => "0.94",
"Test::NoWarnings" => "0.083",
"Test::Warn" => "0.31",
"base" => 0,
"lib" => 0
}
);
my %fallback_build_requires = (
"Capture::Tiny" => "0.12",
"Carp" => 0,
"DBD::Mem" => 0,
"File::Find" => 0,
"File::Spec" => 0,
"File::Spec::Functions" => 0,
"FindBin" => 0,
"IO::Pager" => "0.34",
"Module::Build" => "0.35",
"Module::Runtime" => 0,
"Path::Class" => "0.33",
"Test::Deep" => 0,
"Test::Dir" => 0,
"Test::Exception" => 0,
"Test::Exit" => 0,
"Test::File" => 0,
"Test::File::Contents" => "0.20",
"Test::MockModule" => "0.17",
"Test::MockObject::Extends" => 0,
"Test::More" => "0.94",
"Test::NoWarnings" => "0.083",
"Test::Warn" => "0.31",
"base" => 0,
"lib" => 0
);
unless ( eval { Module::Build->VERSION(0.4004) } ) {
delete $module_build_args{test_requires};
$module_build_args{build_requires} = \%fallback_build_requires;
}
my $build = Module::Build::Sqitch->new(%module_build_args);
$build->create_build_script;
README.md 100644 001751 000166 26713 15004170404 15206 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 App/Sqitch version v1.5.2
=========================
| Release | Coverage | Database ||
|-------------------|-------------------|-------------------|--------------------|
| [![CPAN]][📚] | [![OSes]][💿] | [![Exasol]][☀️] | [![Oracle]][🔮] |
| [![Docker]][🐳] | [![Perl]][🧅] | [![Firebird]][🔥] | [![Snowflake]][❄️] |
| [![Homebrew]][🍺] | [![Coverage]][📈] | [![MySQL]][🐬] | [![SQLite]][💡] |
| [![Debian]][🍥] | | [![Postgres]][🐘] | [![Vertica]][🔺] |
| | | [![Yugabyte]][💫] | [![Cockroach]][🪳] |
[Sqitch] is a database change management application. It currently supports:
* [PostgreSQL] 8.4+
* [YugabyteDB] 2.6+
* [CockroachDB] 21+
* [SQLite][lite] 3.8.6+
* [MySQL][my] 5.1+
* [MariaDB] 10.0+
* [Oracle][orcl] 10g+,
* [Firebird][bird] 2.0+
* [Vertica][vert] 7.2+
* [Exasol][exa] 6.0+
* [Snowflake][flake]
What makes it different from your typical migration approaches? A few things:
* No opinions
Sqitch is not tied to any framework, ORM, or platform. Rather, it is a
standalone change management system with no opinions about your database
engine, application framework, or development environment.
* Native scripting
Changes are implemented as scripts native to your selected database engine.
Writing a [PostgreSQL] application? Write SQL scripts for [`psql`]. Writing
an [Oracle][orcl]-backed app? Write SQL scripts for [SQL\*Plus].
* Dependency resolution
Database changes may declare dependencies on other changes -- even on
changes from other Sqitch projects. This ensures proper order of
execution, even when you've committed changes to your VCS out-of-order.
* Deployment integrity
Sqitch manages changes and dependencies via a plan file, employing a
[Merkle tree] pattern similar to [Git][gitmerkle] and [Blockchain] to ensure
deployment integrity. As such, there is no need to number your changes,
although you can if you want. Sqitch doesn't much care how you name your
changes.
* Iterative Development
Up until you [tag] and [release] your project, you can modify your change
deployment scripts as often as you like. They're not locked in just because
they've been committed to your VCS. This allows you to take an iterative or
test-driven approach to developing your database schema.
Want to learn more? The best place to start is in the tutorials:
* [Introduction to Sqitch on PostgreSQL, YugabyteDB, and CockroachDB](lib/sqitchtutorial.pod)
* [Introduction to Sqitch on SQLite](lib/sqitchtutorial-sqlite.pod)
* [Introduction to Sqitch on Oracle](lib/sqitchtutorial-oracle.pod)
* [Introduction to Sqitch on MySQL](lib/sqitchtutorial-mysql.pod)
* [Introduction to Sqitch on Firebird](lib/sqitchtutorial-firebird.pod)
* [Introduction to Sqitch on Vertica](lib/sqitchtutorial-vertica.pod)
* [Introduction to Sqitch on Exasol](lib/sqitchtutorial-exasol.pod)
* [Introduction to Sqitch on Snowflake](lib/sqitchtutorial-snowflake.pod)
There have also been a number of presentations on Sqitch:
* [PDX.pm Presentation]: Slides from "Sane Database Management with Sqitch",
presented to the Portland Perl Mongers in January, 2013.
* [PDXPUG Presentation]: Movie of "Sane Database Management with Sqitch",
presented to the Portland PostgreSQL Users Group in September, 2012.
* [Agile Database Development]: Slides from a three-hour tutorial session on
using [Git], test-driven development with [pgTAP], and change management with
Sqitch, updated in January, 2014.
Installation
------------
To install Sqitch from a distribution download, type the following:
perl Build.PL
./Build installdeps
./Build
./Build test
./Build install
To install Sqitch and all of its dependencies into a single directory named
`sqitch_bundle`, install the Menlo CPAN client and build the bundle:
cpanm Menlo::CLI::Compat
./Build bundle --install_base sqitch_bundle
After which, Sqitch can be run from `./sqitch_bundle/bin/sqitch`. By default,
no modules that are included in the core Perl distribution are included. To
require that dual-life modules also be bundled, pass `--dual_life 1`:
./Build bundle --install_base sqitch_bundle --dual_life 1
To include support for a feature in the bundle, pass the `--with` option
naming the feature:
./Build bundle --install_base sqitch_bundle --with postgres --with sqlite
The feature names generally correspond to the supported engines. The currently
supported features are:
* `--with postgres`: Support for managing Postgres, Yugabyte, and Cockroach databases
* `--with sqlite`: Support for managing SQLite databases
* `--with mysql`: Support for managing MySQL databases
* `--with firebird`: Support for managing Firebird databases
* `--with oracle`: Support for managing Oracle databases
* `--with vertica`: Support for managing Vertica databases
* `--with exasol`: Support for managing Exasol databases
* `--with snowflake`: Support for managing Snowflake databases
* `--with odbc`: Include the ODBC driver
To build from a Git clone, first install [Dist::Zilla], then use it to install
Sqitch and all dependencies:
cpanm Dist::Zilla
dzil authordeps --missing | cpanm
dzil listdeps --missing | cpanm
dzil install
To run Sqitch directly from the Git clone, execute `t/sqitch`.
To install Sqitch on a specific platform, including Debian- and RedHat-derived
Linux distributions and Windows, see the [Installation documentation].
License
-------
Copyright (c) 2012-2025 David E. Wheeler, 2012-2021 iovation Inc.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
[CPAN]: https://img.shields.io/cpan/v/App-Sqitch?label=%F0%9F%93%9A%20CPAN
[📚]: https://metacpan.org/dist/App-Sqitch "Latest version on CPAN"
[OSes]: https://github.com/sqitchers/sqitch/actions/workflows/os.yml/badge.svg
[💿]: https://github.com/sqitchers/sqitch/actions/workflows/os.yml "Tested on Linux, macOS, and Windows"
[Exasol]: https://github.com/sqitchers/sqitch/actions/workflows/exasol.yml/badge.svg
[☀️]: https://github.com/sqitchers/sqitch/actions/workflows/exasol.yml "Tested with Exasol 7.0–8.32"
[Oracle]: https://github.com/sqitchers/sqitch/actions/workflows/oracle.yml/badge.svg
[🔮]: https://github.com/sqitchers/sqitch/actions/workflows/oracle.yml "Tested with Oracle 11, 18, and 21"
[Docker]: https://img.shields.io/docker/v/sqitch/sqitch?label=%F0%9F%90%B3%20Docker&sort=semver
[🐳]: https://hub.docker.com/r/sqitch/sqitch "Latest version on Docker Hub"
[Perl]: https://github.com/sqitchers/sqitch/actions/workflows/perl.yml/badge.svg
[🧅]: https://github.com/sqitchers/sqitch/actions/workflows/perl.yml "Tested with Perl 5.12–5.40"
[Firebird]: https://github.com/sqitchers/sqitch/actions/workflows/firebird.yml/badge.svg
[🔥]: https://github.com/sqitchers/sqitch/actions/workflows/firebird.yml "Tested with Firebird 2.5–5.0"
[Snowflake]: https://github.com/sqitchers/sqitch/actions/workflows/snowflake.yml/badge.svg
[❄️]: https://github.com/sqitchers/sqitch/actions/workflows/snowflake.yml "Tested with Snowflake"
[Homebrew]: https://img.shields.io/github/v/tag/sqitchers/homebrew-sqitch?label=%F0%9F%8D%BA%20Homebrew&sort=semver
[🍺]: https://github.com/sqitchers/homebrew-sqitch#readme "Latest Homebrew Tap version"
[Coverage]: https://img.shields.io/coveralls/github/sqitchers/sqitch?label=%F0%9F%93%88%20Coverage
[📈]: https://coveralls.io/r/sqitchers/sqitch "Test Coverage"
[MySQL]: https://github.com/sqitchers/sqitch/actions/workflows/mysql.yml/badge.svg
[🐬]: https://github.com/sqitchers/sqitch/actions/workflows/mysql.yml "Tested with MySQL 5.5–9.1 and MariaDB 10.0–11.6"
[SQLite]: https://github.com/sqitchers/sqitch/actions/workflows/sqlite.yml/badge.svg
[💡]: https://github.com/sqitchers/sqitch/actions/workflows/sqlite.yml "Tested with SQLite 3.8–3.47"
[Debian]: https://img.shields.io/debian/v/sqitch?label=%F0%9F%8D%A5%20Debian
[🍥]: https://packages.debian.org/stable/sqitch "Latest version on Debian"
[Postgres]: https://github.com/sqitchers/sqitch/actions/workflows/pg.yml/badge.svg
[🐘]: https://github.com/sqitchers/sqitch/actions/workflows/pg.yml "Tested with PostgreSQL 8.4–17"
[Yugabyte]: https://github.com/sqitchers/sqitch/actions/workflows/yugabyte.yml/badge.svg
[💫]: https://github.com/sqitchers/sqitch/actions/workflows/yugabyte.yml "Tested with YugabyteDB 2.6–2024.2"
[Vertica]: https://github.com/sqitchers/sqitch/actions/workflows/vertica.yml/badge.svg
[🔺]: https://github.com/sqitchers/sqitch/actions/workflows/vertica.yml "Tested with Vertica 7.2–12.0"
[Cockroach]: https://github.com/sqitchers/sqitch/actions/workflows/cockroach.yml/badge.svg
[🪳]: https://github.com/sqitchers/sqitch/actions/workflows/cockroach.yml "Tested with CockroachDB v21-23"
[Sqitch]: https://sqitch.org/
[PostgreSQL]: https://postgresql.org/
[YugabyteDB]: https://www.yugabyte.com/yugabytedb/
[CockroachDB]: https://www.cockroachlabs.com/product/
[lite]: https://sqlite.org/
[my]: https://dev.mysql.com/
[MariaDB]: https://mariadb.org
[`psql`]: https://www.postgresql.org/docs/current/static/app-psql.html
[orcl]: https://www.oracle.com/database/
[bird]: https://www.firebirdsql.org/
[vert]: https://www.vertica.com/
[exa]: https://www.exasol.com/
[flake]: https://www.snowflake.net/
[SQL\*Plus]: https://www.orafaq.com/wiki/SQL*Plus
[Merkle tree]: https://en.wikipedia.org/wiki/Merkle_tree "Wikipedia: “Merkle tree”"
[gitmerkle]: https://stackoverflow.com/a/18589734/
"Stack Overflow: “What is the mathematical structure that represents a Git repo”"
[Blockchain]: https://medium.com/byzantine-studio/blockchain-fundamentals-what-is-a-merkle-tree-d44c529391d7
"Medium: “Blockchain Fundamentals #1: What is a Merkle Tree?”"
[tag]: https://sqitch.org/docs/manual/sqitch-tag/
[release]: https://sqitch.org/docs/manual/sqitch-tag/
[PDX.pm Presentation]: https://speakerdeck.com/theory/sane-database-change-management-with-sqitch
[PDXPUG Presentation]: https://vimeo.com/50104469
[Agile Database Development]: https://speakerdeck.com/theory/agile-database-development-2ed
[Git]: https://git-scm.org
[pgTAP]: https://pgtap.org
[Dist::Zilla]: https://metacpan.org/module/Dist::Zilla
[Installation documentation]: https://sqitch.org/download/
read.pl 100644 001751 000166 41 15004170404 15344 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t use 5.010;
print while ;
win32.t 100644 001751 000166 542 15004170404 15251 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# local *main::^O;
BEGIN {
$^O = 'MSWin32';
}
use strict;
use warnings;
use Test::More tests => 2;
use Try::Tiny;
use App::Sqitch::ItemFormatter;
is $^O, 'MSWin32', 'Should have "MSWin32"';
is App::Sqitch::ItemFormatter::CAN_OUTPUT_COLOR,
try { require Win32::Console::ANSI },
'CAN_OUTPUT_COLOR should be set properly';
check.t 100644 001751 000166 23640 15004170404 15430 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Path::Class qw(dir file);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::check';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
new
from_change
to_change
variables
does
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(ContextCommand ConnectingCommand);
is_deeply [$CLASS->options], [qw(
target|t=s
from-change|from=s
to-change|to=s
set|s=s%
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
_params => [],
_cx => [],
}, 'Should have default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
from_change => 'foo',
to_change => 'bar',
set => { foo => 'bar' },
}), {
from_change => 'foo',
to_change => 'bar',
variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have changes and variables from options';
CONFIG: {
my $config = TestConfig->new(
'check.variables' => { foo => 'bar', hi => 21 },
);
is_deeply $CLASS->configure($config, {}), { _params => [], _cx => [] },
'Should have no config if no options';
}
##############################################################################
# Test construction.
isa_ok my $check = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
), $CLASS, 'new status with target';
is $check->target, 'foo', 'Should have target "foo"';
isa_ok $check = $CLASS->new(sqitch => $sqitch), $CLASS;
is $check->target, undef, 'Default target should be undef';
is $check->from_change, undef, 'from_change should be undef';
is $check->to_change, undef, 'to_change should be undef';
##############################################################################
# Test _collect_vars.
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $check->_collect_vars($target) }, {}, 'Should collect no variables';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core vars';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars';
# Add check variables.
$config->update('check.variables' => { dance => 'disco', lunch => 'pizza' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with check vars';
# Add engine variables.
$config->update('engine.pg.variables' => { lunch => 'burrito', drink => 'whiskey' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override check vars with engine vars';
# Add target variables.
$config->update('target.foo.variables' => { drink => 'scotch', status => 'winning' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with target vars';
# Add --set variables.
$check = $CLASS->new(
sqitch => $sqitch,
variables => { status => 'tired', herb => 'oregano' },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $check->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set variables';
$config->replace(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
$check = $CLASS->new( sqitch => $sqitch, no_prompt => 1);
##############################################################################
# Test execution.
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my @args;
$mock_engine->mock(check => sub { shift; @args = @_ });
my @vars;
$mock_engine->mock(set_variables => sub { shift; @vars = @_ });
ok $check->execute, 'Execute with nothing.';
is_deeply \@args, [undef, undef],
'Two undefs should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
ok $check->execute('@alpha'), 'Execute from "@alpha"';
is_deeply \@args, ['@alpha', undef],
'"@alpha" and undef should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should again have no warnings';
ok $check->execute('@alpha', '@beta'), 'Execute from "@alpha" to "@beta"';
is_deeply \@args, ['@alpha', '@beta'],
'"@alpha" and "@beat" should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should still have no warnings';
isa_ok $check = $CLASS->new(
sqitch => $sqitch,
from_change => 'foo',
to_change => 'bar',
variables => { foo => 'bar', one => 1 },
), $CLASS, 'Object with from, to, and variables';
ok $check->execute, 'Execute again';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Still should have no warnings';
# Pass and specify changes.
ok $check->execute('roles', 'widgets'), 'Execute with command-line args';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many changes specified; checking from "{from}" to "{to}"',
from => 'foo',
to => 'bar',
)]], 'Should have warning about which roles are used';
# Pass a target.
$target = 'db:pg:';
my $mock_cmd = Test::MockModule->new(ref $check);
my ($target_name_arg, $orig_meth);
$mock_cmd->mock(parse_args => sub {
my $self = shift;
my %p = @_;
my @ret = $self->$orig_meth(@_);
$target_name_arg = $ret[0][0]->name;
$ret[0][0] = $self->default_target;
return @ret;
});
$orig_meth = $mock_cmd->original('parse_args');
ok $check->execute($target), 'Execute with target arg';
is $target_name_arg, $target, 'The target should have been passed to the engine';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings';
# Pass a --target option.
isa_ok $check = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS, 'Object with target';
$target_name_arg = undef;
@vars = ();
ok $check->execute, 'Execute with no args';
is $target_name_arg, $target, 'The target option should have been passed to the engine';
is_deeply \@args, [undef, undef], 'Undefs should be passed to the engine';
is_deeply {@vars}, {}, 'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings';
# Pass a target, get a warning.
ok $check->execute('db:sqlite:', 'roles', 'widgets'),
'Execute with two targegs and two changes';
is $target_name_arg, $target, 'The target option should have been passed to the engine';
is_deeply \@args, ['roles', 'widgets'],
'The two changes should be passed to the engine';
is_deeply {@vars}, {}, 'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => $check->default_target->name,
)]], 'Should have warning about too many targets';
# Make sure we get an exception for unknown args.
throws_ok { $check->execute(qw(greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'check', 'Unknown arg ident should be "check"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exeption for two unknown arg';
throws_ok { $check->execute(qw(greg jon)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'check', 'Unknown args ident should be "check"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, jon',
), 'Should get an exeption for two unknown args';
done_testing;
mysql.t 100644 001751 000166 65015 15004170404 15522 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# To test against a live MySQL database, you must set the SQITCH_TEST_MYSQL_URI
# environment variable. this is a standard URI::db URI, and should look
# something like this:
#
# export SQITCH_TEST_MYSQL_URI=db:mysql://root:password@localhost:3306/information_schema
#
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Test::File::Contents;
use Test::MockModule;
use Path::Class;
use Try::Tiny;
use Test::Exception;
use List::MoreUtils qw(firstidx);
use Locale::TextDomain qw(App-Sqitch);
use File::Temp 'tempdir';
use DBD::Mem;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
my $mm = eval { Test::MockModule->new('MySQL::Config') };
$mm->mock(parse_defaults => {}) if $mm;
BEGIN {
$CLASS = 'App::Sqitch::Engine::mysql';
require_ok $CLASS or die;
delete $ENV{$_} for qw(MYSQL_PWD MYSQL_HOST MYSQL_TCP_PORT);
}
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $uri = URI::db->new('db:mysql:mydb');
my $config = TestConfig->new(
'core.engine' => 'mysql',
'engine.mysql.target' => $uri->as_string,
);
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
isa_ok my $mysql = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $mysql->key, 'mysql', 'Key should be "mysql"';
is $mysql->name, 'MySQL', 'Name should be "MySQL"';
my $client = 'mysql' . (App::Sqitch::ISWIN ? '.exe' : '');
is $mysql->client, $client, 'client should default to mysql';
is $mysql->registry, 'sqitch', 'registry default should be "sqitch"';
my $sqitch_uri = $uri->clone;
$sqitch_uri->dbname('sqitch');
is $mysql->registry_uri, $sqitch_uri, 'registry_uri should be correct';
is $mysql->uri, $uri, qq{uri should be "$uri"};
is $mysql->_dsn, 'dbi:MariaDB:database=sqitch', 'DSN should use MariaDB';
is $mysql->registry_destination, 'db:mysql:sqitch',
'registry_destination should be the same as registry_uri';
is $mysql->_lock_name, 'sqitch working on ' . $uri->dbname,
'_lock_name should be correct';
my @std_opts = (
(App::Sqitch::ISWIN ? () : '--skip-pager' ),
'--silent',
'--skip-column-names',
'--skip-line-numbers',
);
my $vinfo = try { $sqitch->probe($mysql->client, '--version') } || '';
if ($vinfo =~ /mariadb/i) {
my ($version) = $vinfo =~ /(?:Ver|client)\s+(\S+)/;
my ($maj, undef, $pat) = split /[.]/ => $version;
push @std_opts => '--abort-source-on-error'
if $maj > 5 || ($maj == 5 && $pat >= 66);
}
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my $warning;
$mock_sqitch->mock(warn => sub { shift; $warning = [@_] });
$mysql->uri->dbname('');
is_deeply [$mysql->mysql], [$client, '--user', $sqitch->sysuser, @std_opts],
'mysql command should be user and std opts-only';
is_deeply $warning, [__x
'Database name missing in URI "{uri}"',
uri => $mysql->uri
], 'Should have emitted a warning for no database name';
$mock_sqitch->unmock_all;
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:mysql:foo'),
);
isa_ok $mysql = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
##############################################################################
# Make sure environment variables are read.
ENV: {
local $ENV{MYSQL_PWD} = '__KAMALA';
local $ENV{MYSQL_HOST} = 'sqitch.sql';
local $ENV{MYSQL_TCP_PORT} = 11238;
ok my $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create engine with MYSQL_PWD set';
is $mysql->password, $ENV{MYSQL_PWD},
'Password should be set from environment';
is $mysql->uri->host, $ENV{MYSQL_HOST}, 'URI should reflect MYSQL_HOST';
is $mysql->uri->port, $ENV{MYSQL_TCP_PORT}, 'URI should reflect MYSQL_TCP_PORT';
}
##############################################################################
# Make sure config settings override defaults and the password is set or removed
# as appropriate.
$config->update(
'engine.mysql.client' => '/path/to/mysql',
'engine.mysql.target' => 'db:mysql://me:pwd@foo.com/widgets',
'engine.mysql.registry' => 'meta',
);
my $mysql_version = 'mysql Ver 15.1 Distrib 10.0.15-MariaDB';
$mock_sqitch->mock(probe => sub { $mysql_version });
push @std_opts => '--abort-source-on-error'
unless $std_opts[-1] eq '--abort-source-on-error';
$target = App::Sqitch::Target->new(sqitch => $sqitch);
ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another mysql';
is $mysql->client, '/path/to/mysql', 'client should be as configured';
is $mysql->uri->as_string, 'db:mysql://me:pwd@foo.com/widgets',
'URI should be as configured';
like $mysql->target->name, qr{^db:mysql://me:?\@foo\.com/widgets$},
'target name should be the URI without the password';
like $mysql->destination, qr{^db:mysql://me:?\@foo\.com/widgets$},
'destination should be the URI without the password';
is $mysql->registry, 'meta', 'registry should be as configured';
is $mysql->registry_uri->as_string, 'db:mysql://me:pwd@foo.com/meta',
'Sqitch DB URI should be the same as uri but with DB name "meta"';
like $mysql->registry_destination, qr{^db:mysql://me:?\@foo\.com/meta$},
'registry_destination should be the sqitch DB URL without the password';
is_deeply [$mysql->mysql], [
'/path/to/mysql',
'--user', 'me',
'--database', 'widgets',
'--host', 'foo.com',
'--password=pwd',
@std_opts
], 'mysql command should be configured';
##############################################################################
# Make sure URI params get passed through to the client.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new('db:mysql://foo.com/widgets?' . join(
'&',
'mysql_compression=1',
'mysql_ssl=1',
'mysql_connect_timeout=20',
'mysql_init_command=BEGIN',
'mysql_socket=/dev/null',
'mysql_ssl_client_key=/foo/key',
'mysql_ssl_client_cert=/foo/cert',
'mysql_ssl_ca_file=/foo/cafile',
'mysql_ssl_ca_path=/foo/capath',
'mysql_ssl_cipher=blowfeld',
'mysql_client_found_rows=20',
'mysql_foo=bar',
),
));
ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a mysql with query params';
is_deeply [$mysql->mysql], [qw(
/path/to/mysql
), '--user', $sqitch->sysuser, qw(
--database widgets
--host foo.com
), @std_opts, qw(
--compress
--ssl
--connect_timeout 20
--init-command BEGIN
--socket /dev/null
--ssl-key /foo/key
--ssl-cert /foo/cert
--ssl-ca /foo/cafile
--ssl-capath /foo/capath
--ssl-cipher blowfeld
)], 'mysql command should be configured with query vals';
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new('db:mysql://foo.com/widgets?' . join(
'&',
'mysql_compression=0',
'mysql_ssl=0',
'mysql_connect_timeout=20',
'mysql_client_found_rows=20',
'mysql_foo=bar',
),
));
ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a mysql with disabled query params';
is_deeply [$mysql->mysql], [qw(
/path/to/mysql
), '--user', $sqitch->sysuser, qw(
--database widgets
--host foo.com
), @std_opts, qw(
--connect_timeout 20
)], 'mysql command should not have disabled param options';
##############################################################################
# Test _run(), _capture(), and _spool().
can_ok $mysql, qw(_run _capture _spool);
my (@run, $exp_pass);
$mock_sqitch->mock(run => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@run = @_;
if (defined $exp_pass) {
is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist';
}
});
my @capture;
$mock_sqitch->mock(capture => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@capture = @_;
if (defined $exp_pass) {
is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist';
}
});
my @spool;
$mock_sqitch->mock(spool => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@spool = @_;
if (defined $exp_pass) {
is $ENV{MYSQL_PWD}, $exp_pass, qq{MYSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{MYSQL_PWD}, 'MYSQL_PWD should not exist';
}
});
$target = App::Sqitch::Target->new(sqitch => $sqitch);
ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a mysql with sqitch with options';
$exp_pass = 's3cr3t';
$target->uri->password($exp_pass);
ok $mysql->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@run, [$mysql->mysql, qw(foo bar baz)],
'Command should be passed to run()';
ok $mysql->_spool('FH'), 'Call _spool';
is_deeply \@spool, [['FH'], $mysql->mysql],
'Command should be passed to spool()';
$mysql->set_variables(foo => 'bar', '"that"' => "'this'");
ok $mysql->_spool('FH'), 'Call _spool with variables';
ok my $fh = shift @{ $spool[0] }, 'Get variables file handle';
is_deeply \@spool, [['FH'], $mysql->mysql],
'Command should be passed to spool() after variables handle';
is join("\n", <$fh>), qq{SET \@"""that""" = '''this''', \@"foo" = 'bar';\n},
'Variables should have been escaped and set';
$mysql->clear_variables;
ok $mysql->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [$mysql->mysql, qw(foo bar baz)],
'Command should be passed to capture()';
# Without password.
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $mysql = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a mysql with sqitch with no pw';
$exp_pass = undef;
$target->uri->password($exp_pass);
ok $mysql->_run(qw(foo bar baz)), 'Call _run again';
is_deeply \@run, [$mysql->mysql, qw(foo bar baz)],
'Command should be passed to run() again';
ok $mysql->_spool('FH'), 'Call _spool again';
is_deeply \@spool, [['FH'], $mysql->mysql],
'Command should be passed to spool() again';
ok $mysql->_capture(qw(foo bar baz)), 'Call _capture again';
is_deeply \@capture, [$mysql->mysql, qw(foo bar baz)],
'Command should be passed to capture() again';
##############################################################################
# Test file and handle running.
ok $mysql->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, [$mysql->mysql, '--execute', 'source foo/bar.sql'],
'File should be passed to run()';
@run = ();
ok $mysql->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, [['FH'], $mysql->mysql],
'Handle should be passed to spool()';
@spool = ();
# Verify should go to capture unless verosity is > 1.
ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
is_deeply \@capture, [$mysql->mysql, '--execute', 'source foo/bar.sql'],
'Verify file should be passed to capture()';
@capture = ();
$mock_sqitch->mock(verbosity => 2);
ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, [$mysql->mysql, '--execute', 'source foo/bar.sql'],
'Verifile file should be passed to run() for high verbosity';
@run = ();
# Try with variables.
$mysql->set_variables(foo => 'bar', '"that"' => "'this'");
my $set = qq{SET \@"""that""" = '''this''', \@"foo" = 'bar';\n};
ok $mysql->run_file('foo/bar.sql'), 'Run foo/bar.sql with vars';
is_deeply \@run, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"],
'Variabls and file should be passed to run()';
@run = ();
ok $mysql->run_handle('FH'), 'Spool a "file handle"';
ok $fh = shift @{ $spool[0] }, 'Get variables file handle';
is_deeply \@spool, [['FH'], $mysql->mysql],
'File handle should be passed to spool() after variables handle';
is join("\n", <$fh>), $set, 'Variables should have been escaped and set';
@spool = ();
ok $mysql->run_verify('foo/bar.sql'), 'Verbosely verify foo/bar.sql with vars';
is_deeply \@run, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"],
'Variables and verify file should be passed to run()';
@run = ();
# Reset verbosity to send verify to spool.
$mock_sqitch->unmock('verbosity');
ok $mysql->run_verify('foo/bar.sql'), 'Verify foo/bar.sql with vars';
is_deeply \@capture, [$mysql->mysql, '--execute', "${set}source foo/bar.sql"],
'Verify file should be passed to capture()';
@capture = ();
$mysql->clear_variables;
$mock_sqitch->unmock_all;
##############################################################################
# Test DateTime formatting stuff.
can_ok $CLASS, '_ts2char_format';
is sprintf($CLASS->_ts2char_format, 'foo'),
q{date_format(foo, 'year:%Y:month:%m:day:%d:hour:%H:minute:%i:second:%S: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';
##############################################################################
# Test SQL helpers.
is $mysql->_listagg_format, q{GROUP_CONCAT(%1$s ORDER BY %1$s SEPARATOR ' ')},
'Should have _listagg_format';
is $mysql->_regex_op, 'REGEXP', 'Should have _regex_op';
is $mysql->_simple_from, '', 'Should have _simple_from';
is $mysql->_limit_default, '18446744073709551615', 'Should have _limit_default';
SECS: {
my $mock = Test::MockModule->new($CLASS);
my $dbh = {mariadb_serverinfo => 'foo', mariadb_serverversion => 50604};
$mock->mock(dbh => $dbh);
is $mysql->_ts_default, 'utc_timestamp(6)',
'Should have _ts_default with fractional seconds';
$dbh->{mariadb_serverversion} = 50101;
my $my51 = $CLASS->new(sqitch => $sqitch, target => $target);
is $my51->_ts_default, 'utc_timestamp',
'Should have _ts_default without fractional seconds on 5.1';
$dbh->{mariadb_serverversion} = 50304;
$dbh->{mariadb_serverinfo} = 'Something about MariaDB man';
my $maria = $CLASS->new(sqitch => $sqitch, target => $target);
is $maria->_ts_default, 'utc_timestamp',
'Should have _ts_default without fractional seconds on early mariadb';
$dbh->{mariadb_serverversion} = 50305;
is $mysql->_ts_default, 'utc_timestamp(6)',
'Should have _ts_default with fractional secondson mariadb 5.03.05';
}
DBI: {
local *DBI::state;
local *DBI::err;
ok !$mysql->_no_table_error, 'Should have no table error';
ok !$mysql->_no_column_error, 'Should have no column error';
$DBI::state = '42S02';
ok $mysql->_no_table_error, 'Should now have table error';
ok !$mysql->_no_column_error, 'Still should have no column error';
$DBI::state = '42000';
$DBI::err = '1049';
ok $mysql->_no_table_error, 'Should again have table error';
ok !$mysql->_no_column_error, 'Still should have no column error';
$DBI::state = '42S22';
$DBI::err = '1054';
ok !$mysql->_no_table_error, 'Should again have no table error';
ok $mysql->_no_column_error, 'Should now have no column error';
}
is_deeply [$mysql->_limit_offset(8, 4)],
[['LIMIT ?', 'OFFSET ?'], [8, 4]],
'Should get limit and offset';
is_deeply [$mysql->_limit_offset(0, 2)],
[['LIMIT ?', 'OFFSET ?'], ['18446744073709551615', 2]],
'Should get limit and offset when offset only';
is_deeply [$mysql->_limit_offset(12, 0)], [['LIMIT ?'], [12]],
'Should get only limit with 0 offset';
is_deeply [$mysql->_limit_offset(12)], [['LIMIT ?'], [12]],
'Should get only limit with noa offset';
is_deeply [$mysql->_limit_offset(0, 0)], [[], []],
'Should get no limit or offset for 0s';
is_deeply [$mysql->_limit_offset()], [[], []],
'Should get no limit or offset for no args';
is_deeply [$mysql->_regex_expr('corn', 'Obama$')],
['corn REGEXP ?', 'Obama$'],
'Should use REGEXP for regex expr';
##############################################################################
# Test unexpected database error in initialized() and _cid().
MOCKDBH: {
my $mock = Test::MockModule->new($CLASS);
$mock->mock(dbh => sub { die 'OW' });
throws_ok { $mysql->initialized } qr/OW/,
'initialized() should rethrow unexpected DB error';
throws_ok { $mysql->_cid } qr/OW/,
'_cid should rethrow unexpected DB error';
}
##############################################################################
# Test _prepare_to_log().
PREPLOG: {
my $mock = Test::MockModule->new($CLASS);
my $fracsec;
$mock->mock(_fractional_seconds => sub { $fracsec });
# Start with fractional seconds detected.
$fracsec = 1;
is $mysql, $mysql->_prepare_to_log('atable', undef),
'Should just get self when fractional seconds supported';
# Now try with fractional seconds unsupported by the database.
$fracsec = 0;
# Need to mock the database handle.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
$mock->mock(dbh => $dbh);
my $mock_dbh = Test::MockModule->new(ref $dbh, no_auto => 1);
my @prepared;
$mock_dbh->mock(prepare => sub { shift; @prepared = @_ });
my @results = ([1], [0]);
$mock_dbh->mock(selectcol_arrayref => sub { shift @results });
# Mock sleep, too.
my $mock_thr = Test::MockModule->new('Time::HiRes');
my @slept;
$mock_thr->mock(sleep => sub { push @slept, shift } );
# We need to pass in a real change.
my $plan = App::Sqitch::Plan->new(
sqitch => $sqitch,
target => $target,
'project' => 'mysql',
);
my $change = App::Sqitch::Plan::Change->new(
name => 'mysql_test',
plan => $plan,
);
# Make sure it sleeps once.
lives_ok { $mysql->_prepare_to_log('atable', $change) }
'Should get no error from _prepare_to_log';
# Check the stuff that was passed.
is_deeply \@prepared, [qq{
SELECT UNIX_TIMESTAMP(committed_at) >= UNIX_TIMESTAMP()
FROM atable
WHERE project = ?
ORDER BY committed_at DESC
LIMIT 1
}], 'Should have prepared the statement comparing times';
is_deeply \@results, [], 'Results should have been returned';
is_deeply \@slept, [0.1], 'Should have slept once';
}
##############################################################################
# Test run_upgrade().
UPGRADE: {
my $mock = Test::MockModule->new($CLASS);
my $fracsec;
my $version = 50500;
$mock->mock(_fractional_seconds => sub { $fracsec });
$mock->mock(dbh => sub { { mariadb_serverversion => $version } });
$mock->mock(_create_check_function => 1);
# Mock run.
my @run;
$mock_sqitch->mock(run => sub { shift; @run = @_ });
# Mock File::Temp so we hang on to the file.
my $mock_ft = Test::MockModule->new('File::Temp');
my $tmp_fh;
my $ft_new;
$mock_ft->mock(new => sub { $tmp_fh = 'File::Temp'->$ft_new() });
$ft_new = $mock_ft->original('new');
# Assemble the expected command.
my @cmd = $mysql->mysql;
my $db_opt_idx = firstidx { $_ eq '--database' } @cmd;
$cmd[$db_opt_idx + 1] = $mysql->registry;
my $fn = file($INC{'App/Sqitch/Engine/mysql.pm'})->dir->file('mysql.sql');
# Test with fractional seconds supported.
$fracsec = 1;
ok $mysql->run_upgrade($fn), 'Run the upgrade';
is $tmp_fh, undef, 'Should not have created a temp file';
is_deeply \@run, [@cmd, $mysql->_source($fn)],
'It should have run the unchanged file';
# Now disable fractional seconds and no --database param.
my @db_opt = splice @cmd, $db_opt_idx, 2;
$mock->mock(mysql => sub { @cmd });
$fracsec = 0;
ok $mysql->run_upgrade($fn), 'Run the upgrade again';
ok $tmp_fh, 'Should have created a temp file';
is_deeply \@run, [@cmd, @db_opt, $mysql->_source($tmp_fh)],
'It should have appended the registry and run the temp file';
# Make sure the file was changed to remove precision from datetimes.
file_contents_unlike $tmp_fh, qr/DATETIME\(\d+\)/,
'Should have removed datetime precision';
file_contents_like $tmp_fh, qr/-- ## BEGIN 5\.5/,
'Should not have removed MySQL 5.5-requiring block BEGIN';
file_contents_like $tmp_fh, qr/-- ## END 5\.5/,
'Should not have removed MySQL 5.5-requiring block END';
# Now try MySQL 5.4.
$version = 50400;
$tmp_fh = undef;
ok $mysql->run_upgrade($fn), 'Run the upgrade on 5.4';
ok $tmp_fh, 'Should have created another temp file';
is_deeply \@run, [@cmd, @db_opt, $mysql->_source($tmp_fh)],
'It should have appended the registry and run the new temp file';
file_contents_unlike $tmp_fh, qr/-- ## BEGIN 5\.5/,
'Should have removed MySQL 5.5-requiring block BEGIN';
file_contents_unlike $tmp_fh, qr/-- ## END 5\.5/,
'Should have removed MySQL 5.5-requiring block END';
$mock_sqitch->unmock_all;
}
##############################################################################
# Test _create_check_function
CHECKIT: {
{
package Test::Mock::Driver;
sub do {
my $self = shift;
$self->{query} = shift;
die $self->{err} if $self->{err};
}
}
my $dbh = bless {mariadb_serverversion => 50400}, 'Test::Mock::Driver';
my $mock = Test::MockModule->new($CLASS);
my $warning;
$mock_sqitch->mock(warn => sub { shift; $warning = [@_] });
$mock->mock(dbh => $dbh);
$mysql->_create_check_function;
is $dbh->{query}, undef, 'Should have no query';
is $warning, undef, 'Should have no warning';
$dbh->{mariadb_serverversion} = 50500;
$mysql->_create_check_function;
like delete $dbh->{query}, qr/CREATE FUNCTION checkit/,
'Should have executed query';
is $warning, undef, 'Should have no warning';
$dbh->{err} = 'oops';
throws_ok { $mysql->_create_check_function } qr/oops/,
'_create_check_function() should rethrow unexpected DB error';
is $warning, undef, 'Should have no warning';
local *DBI::err;
$DBI::err = 1419;
lives_ok {$mysql->_create_check_function } 'Error 1419 should not be thrown';
like delete $dbh->{query}, qr/CREATE FUNCTION checkit/,
'Should have executed query';
is_deeply $warning, [__
'Insufficient permissions to create the checkit() function; skipping.',
], 'Should have emitted a warning about checkit';
$warning = undef;
$mock_sqitch->unmock_all;
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($mysql->key);
##############################################################################
# Can we do live tests?
my $dbh;
my $id = DBIEngineTest->randstr;
my ($db, $reg1, $reg2) = map { $_ . $id } qw(__sqitchtest__ __metasqitch __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;
});
return unless $dbh->{Active};
$dbh->do("DROP DATABASE IF EXISTS $_") for ($db, $reg1, $reg2);
}
$uri = URI->new(
$ENV{SQITCH_TEST_MYSQL_URI} ||
$ENV{MYSQL_URI} ||
'db:mariadb://root@/information_schema'
);
$uri->dbname('information_schema') unless $uri->dbname;
my $err = try {
$mysql->use_driver;
(my $dsn = $uri->dbi_dsn) =~ s/\Adbi:mysql/dbi:MariaDB/;
$dbh = DBI->connect($dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $mysql->error_handler,
});
# Make sure we have a version we can use.
if ($dbh->{mariadb_serverinfo} =~ /mariadb/i) {
die "MariaDB >= 50300 required; this is $dbh->{mariadb_serverversion}\n"
unless $dbh->{mariadb_serverversion} >= 50300;
}
else {
die "MySQL >= 50100 required; this is $dbh->{mariadb_serverversion}\n"
unless $dbh->{mariadb_serverversion} >= 50100;
}
$dbh->do("CREATE DATABASE $db");
$uri->dbname($db);
undef;
} catch {
$_
};
DBIEngineTest->run(
class => $CLASS,
target_params => [ registry => $reg1, uri => $uri ],
alt_target_params => [ registry => $reg2, uri => $uri ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have mysql and can connect to the database.
my $version = $self->sqitch->capture( $self->client, '--version' );
say "# Detected CLI $version";
say '# Connected to MySQL ' . $self->_capture('--execute' => 'SELECT version()');
1;
},
engine_err_regex => qr/^You have an error /,
init_error => __x(
'Sqitch database {database} already initialized',
database => $reg2,
),
add_second_format => q{date_add(%s, interval 1 second)},
test_dbh => sub {
my $dbh = shift;
# Check the session configuration.
for my $spec (
[character_set_client => qr/^utf8/],
[character_set_server => qr/^utf8/],
($dbh->{mariadb_serverversion} < 50500 ? () : ([default_storage_engine => qr/^InnoDB$/])),
[time_zone => qr/^\+00:00$/],
[group_concat_max_len => qr/^32768$/],
) {
like $dbh->selectcol_arrayref('SELECT @@SESSION.' . $spec->[0])->[0],
$spec->[1], "Setting $spec->[0] should match $spec->[1]";
}
# Special-case sql_mode.
my $sql_mode = $dbh->selectcol_arrayref('SELECT @@SESSION.sql_mode')->[0];
for my $mode (qw(
ansi
strict_trans_tables
no_auto_value_on_zero
no_zero_date
no_zero_in_date
only_full_group_by
error_for_division_by_zero
)) {
like $sql_mode, qr/\b\Q$mode\E\b/i, "sql_mode should include $mode";
}
},
lock_sql => sub {
my $lock_name = shift->_lock_name; return {
is_locked => "SELECT is_used_lock('$lock_name')",
try_lock => "SELECT get_lock('$lock_name', 0)",
wait_time => 1, # get_lock() does not support sub-second precision, apparently.
async_free => 1,
free_lock => 'SELECT ' . ($dbh ? do {
# MySQL 5.5-5.6 and Maria 10.0-10.4 prefer release_lock(), while
# 5.7+ and 10.5+ prefer release_all_locks().
$dbh->selectrow_arrayref('SELECT version()')->[0] =~ /^(?:5\.[56]|10\.[0-4])/
? "release_lock('$lock_name')"
: 'release_all_locks()'
} : ''),
} },
);
done_testing;
echo.pl 100644 001751 000166 31 15004170404 15346 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t use 5.010;
say "@ARGV";
blank.t 100644 001751 000166 10137 15004170404 15437 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 34;
#use Test::More 'no_plan';
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use Test::MockModule;
use Test::File;
use Test::File::Contents 0.20;
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan::Blank';
require_ok $CLASS or die;
}
can_ok $CLASS, qw(
name
lspace
rspace
note
plan
request_note
note_prompt
);
my $config = TestConfig->new('core.engine' => 'sqlite');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
isa_ok my $blank = $CLASS->new(
name => 'foo',
plan => $plan,
), $CLASS;
isa_ok $blank, 'App::Sqitch::Plan::Line';
is $blank->format_name, '', 'Name should format as ""';
is $blank->as_string, '', 'should stringify to ""';
ok $blank = $CLASS->new(
name => 'howdy',
plan => $plan,
lspace => ' ',
rspace => "\t",
note => 'blah blah blah',
), 'Create tag with more stuff';
is $blank->as_string, " \t# blah blah blah",
'It should stringify correctly';
ok $blank = $CLASS->new(plan => $plan, note => "foo\nbar\nbaz\\\n"),
'Create a blank with newlines and backslashes in the note';
is $blank->note, "foo\nbar\nbaz\\",
'The newlines and backslashe should not be escaped';
is $blank->format_note, '# foo\\nbar\\nbaz\\\\',
'The newlines and backslahs should be escaped by format_note';
ok $blank = $CLASS->new(plan => $plan, note => "foo\\nbar\\nbaz\\\\\\n"),
'Create a blank with escapes';
is $blank->note, "foo\nbar\nbaz\\\n", 'Note shoud be unescaped';
for my $spec (
["\n\n\nfoo" => 'foo', 'Leading newlines' ],
["\r\r\rfoo" => 'foo', 'Leading line feeds' ],
["foo\n\n\n" => 'foo', 'Trailing newlines' ],
["foo\r\r\r" => 'foo', 'trailing line feeds' ],
["\r\n\r\n\r\nfoo\n\nbar\r" => "foo\n\nbar", 'Leading and trailing vertical space' ],
["\n\n\n foo \n" => 'foo', 'Leading and trailing newlines and spaces' ],
) {
is $CLASS->new(
plan => $plan,
note => $spec->[0]
)->note, $spec->[1], "Should trim $spec->[2] from note";
}
##############################################################################
# Test note requirement.
is $blank->note_prompt(for => 'add'), __x(
"Write a {command} note.\nLines starting with '#' will be ignored.",
command => 'add'
), 'Should have localized not prompt';
my $sqitch_mocker = Test::MockModule->new('App::Sqitch');
my $note = '';
my $for = 'add';
$sqitch_mocker->mock(shell => sub {
my ( $self, $cmd ) = @_;
my $editor = $sqitch->editor;
ok $cmd =~ s/^\Q$editor\E //, 'Shell command should start with editor';
my $fn = $cmd;
file_exists_ok $fn, 'Temp file should exist';
( my $prompt = $CLASS->note_prompt(for => $for) ) =~ s/^/# /gms;
file_contents_eq $fn, "\n$prompt\n", 'Temp file contents should include prompt',
{ encoding => ':raw:utf8_strict' };
if ($note) {
open my $fh, '>:utf8_strict', $fn or die "Cannot open $fn: $!";
print $fh $note, $prompt, "\n";
close $fh or die "Error closing $fn: $!";
}
});
# Do no actual shell quoting.
$sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ });
throws_ok { $CLASS->new(plan => $plan )->request_note(for => $for) }
'App::Sqitch::X',
'Should get exception for no note text';
is $@->ident, 'plan', 'No note error ident should be "plan"';
is $@->message, __ 'Aborting due to empty note',
'No note error message should be correct';
is $@->exitval, 1, 'Exit val should be 1';
# Now write a note.
$for = 'rework';
$note = "This is my awesome note.\n";
$blank = $CLASS->new(plan => $plan );
is $blank->request_note(for => $for), 'This is my awesome note.', 'Request note';
$note = '';
is $blank->note, 'This is my awesome note.', 'Should have the edited note';
is $blank->request_note(for => $for), 'This is my awesome note.',
'The request should not prompt again';
META.json 100644 001751 000166 22672 15004170404 15350 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 {
"abstract" : "Sensible database change management",
"author" : [
"\"iovation Inc., David E. Wheeler\""
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010",
"license" : [
"mit"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "App-Sqitch",
"no_index" : {
"directory" : [
"priv"
]
},
"optional_features" : {
"exasol" : {
"description" : "Support for managing Exasol databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::ODBC" : "1.59"
}
}
}
},
"firebird" : {
"description" : "Support for managing Firebird databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::Firebird" : "1.11",
"Time::HiRes" : "0",
"Time::Local" : "0"
}
}
}
},
"mysql" : {
"description" : "Support for managing MySQL databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::MariaDB" : "1.0",
"MySQL::Config" : "0"
}
}
}
},
"odbc" : {
"description" : "Include the ODBC driver.",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::ODBC" : "1.59"
}
}
}
},
"oracle" : {
"description" : "Support for managing Oracle databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::Oracle" : "1.23"
}
}
}
},
"postgres" : {
"description" : "Support for managing Postgres, Yugabyte, and Cockroch databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::Pg" : "2.0"
}
}
}
},
"snowflake" : {
"description" : "Support for managing Snowflake databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::ODBC" : "1.59"
}
}
}
},
"sqlite" : {
"description" : "Support for managing SQLite databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::SQLite" : "1.37"
}
}
}
},
"vertica" : {
"description" : "Support for managing Vertica databases",
"prereqs" : {
"runtime" : {
"requires" : {
"DBD::ODBC" : "1.59"
}
}
}
}
},
"prereqs" : {
"build" : {
"recommends" : {
"Menlo::CLI::Compat" : "0"
},
"requires" : {
"Module::Build" : "0.35"
}
},
"configure" : {
"requires" : {
"Module::Build" : "0.35"
}
},
"develop" : {
"recommends" : {
"DBD::Firebird" : "1.11",
"DBD::MariaDB" : "1.0",
"DBD::ODBC" : "1.59",
"DBD::Pg" : "2.0",
"DBD::SQLite" : "1.37",
"Dist::Zilla" : "5",
"Dist::Zilla::Plugin::AutoPrereqs" : "0",
"Dist::Zilla::Plugin::CPANFile" : "0",
"Dist::Zilla::Plugin::ConfirmRelease" : "0",
"Dist::Zilla::Plugin::CopyFilesFromBuild" : "0",
"Dist::Zilla::Plugin::ExecDir" : "0",
"Dist::Zilla::Plugin::GatherDir" : "0",
"Dist::Zilla::Plugin::Git::Check" : "0",
"Dist::Zilla::Plugin::License" : "0",
"Dist::Zilla::Plugin::LocaleTextDomain" : "0",
"Dist::Zilla::Plugin::Manifest" : "0",
"Dist::Zilla::Plugin::ManifestSkip" : "0",
"Dist::Zilla::Plugin::MetaJSON" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::MetaResources" : "0",
"Dist::Zilla::Plugin::MetaYAML" : "0",
"Dist::Zilla::Plugin::ModuleBuild" : "0",
"Dist::Zilla::Plugin::OptionalFeature" : "0",
"Dist::Zilla::Plugin::OurPkgVersion" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::Prereqs::AuthorDeps" : "0",
"Dist::Zilla::Plugin::PruneCruft" : "0",
"Dist::Zilla::Plugin::Readme" : "0",
"Dist::Zilla::Plugin::RunExtraTests" : "0",
"Dist::Zilla::Plugin::ShareDir" : "0",
"Dist::Zilla::Plugin::TestRelease" : "0",
"Dist::Zilla::Plugin::UploadToCPAN" : "0",
"MySQL::Config" : "0",
"Software::License::MIT" : "0",
"Test::MockObject::Extends" : "1.20180705",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Spelling" : "0",
"Time::HiRes" : "0",
"Time::Local" : "0"
},
"requires" : {
"DBD::Firebird" : "1.11",
"DBD::MariaDB" : "1.0",
"DBD::ODBC" : "1.59",
"DBD::Oracle" : "1.23",
"DBD::Pg" : "2.0",
"DBD::SQLite" : "1.37",
"MySQL::Config" : "0",
"Time::HiRes" : "0",
"Time::Local" : "0"
},
"suggests" : {
"DBD::Oracle" : "1.23"
}
},
"runtime" : {
"recommends" : {
"Class::XSAccessor" : "1.18",
"Pod::Simple" : "1.41",
"Template" : "0",
"Type::Tiny::XS" : "0.010"
},
"requires" : {
"Algorithm::Backoff::Exponential" : "0.006",
"Clone" : "0",
"Config::GitLike" : "1.15",
"DBI" : "1.631",
"DateTime" : "1.04",
"DateTime::TimeZone" : "0",
"Devel::StackTrace" : "1.30",
"Digest::SHA" : "0",
"Encode" : "0",
"Encode::Locale" : "0",
"File::Basename" : "0",
"File::Copy" : "0",
"File::Path" : "0",
"File::Temp" : "0",
"Getopt::Long" : "0",
"Hash::Merge" : "0",
"IO::Handle" : "0",
"IO::Pager" : "0.34",
"IPC::Run3" : "0",
"IPC::System::Simple" : "1.17",
"List::MoreUtils" : "0",
"List::Util" : "0",
"Locale::Messages" : "0",
"Locale::TextDomain" : "1.20",
"Moo" : "1.002000",
"Moo::Role" : "0",
"POSIX" : "0",
"Path::Class" : "0.33",
"PerlIO::utf8_strict" : "0",
"Pod::Escapes" : "1.04",
"Pod::Find" : "0",
"Pod::Usage" : "0",
"Scalar::Util" : "0",
"StackTrace::Auto" : "0",
"String::Formatter" : "0",
"String::ShellQuote" : "0",
"Sub::Exporter" : "0",
"Sub::Exporter::Util" : "0",
"Sys::Hostname" : "0",
"Template::Tiny" : "0.11",
"Term::ANSIColor" : "2.02",
"Throwable" : "0.200009",
"Time::HiRes" : "0",
"Time::Local" : "0",
"Try::Tiny" : "0",
"Type::Library" : "0.040",
"Type::Utils" : "0",
"Types::Standard" : "0",
"URI" : "0",
"URI::QueryParam" : "0",
"URI::db" : "0.20",
"User::pwent" : "0",
"constant" : "0",
"locale" : "0",
"namespace::autoclean" : "0.16",
"overload" : "0",
"parent" : "0",
"perl" : "5.010",
"strict" : "0",
"utf8" : "0",
"warnings" : "0"
},
"suggests" : {
"DBD::Firebird" : "1.11",
"DBD::MariaDB" : "1.0",
"DBD::ODBC" : "1.59",
"DBD::Oracle" : "1.23",
"DBD::Pg" : "2.0",
"DBD::SQLite" : "1.37",
"MySQL::Config" : "0",
"Time::HiRes" : "0",
"Time::Local" : "0"
}
},
"test" : {
"requires" : {
"Capture::Tiny" : "0.12",
"Carp" : "0",
"DBD::Mem" : "0",
"File::Find" : "0",
"File::Spec" : "0",
"File::Spec::Functions" : "0",
"FindBin" : "0",
"IO::Pager" : "0.34",
"Module::Runtime" : "0",
"Path::Class" : "0.33",
"Test::Deep" : "0",
"Test::Dir" : "0",
"Test::Exception" : "0",
"Test::Exit" : "0",
"Test::File" : "0",
"Test::File::Contents" : "0.20",
"Test::MockModule" : "0.17",
"Test::MockObject::Extends" : "0",
"Test::More" : "0.94",
"Test::NoWarnings" : "0.083",
"Test::Warn" : "0.31",
"base" : "0",
"lib" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/sqitchers/sqitch/issues/"
},
"homepage" : "https://sqitch.org/",
"repository" : {
"url" : "https://github.com/sqitchers/sqitch/"
}
},
"version" : "v1.5.2",
"x_generated_by_perl" : "v5.40.2",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.39",
"x_spdx_expression" : "MIT"
}
LICENSE.md 100644 001751 000166 2131 15004170404 15277 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 The MIT License (MIT)
Copyright (c) 2012-2025 David E. Wheeler, 2012-2021 iovation Inc.
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
bin 000755 001751 000166 0 15004170404 14306 5 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 sqitch 100755 001751 000166 146 15004170404 15650 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/bin #!perl -w -CAS
our $VERSION = 'v1.5.2'; # VERSION
use locale;
use App::Sqitch;
exit App::Sqitch->go;
deploy.t 100644 001751 000166 26257 15004170404 15656 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Path::Class qw(dir file);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::deploy';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
new
to_change
mode
log_only
lock_timeout
execute
variables
does
_collect_vars
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(ContextCommand ConnectingCommand);
is_deeply [$CLASS->options], [qw(
target|t=s
to-change|to|change=s
mode=s
set|s=s%
log-only
lock-timeout=i
verify!
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
mode => 'all',
verify => 0,
log_only => 0,
_params => [],
_cx => [],
}, 'Should have default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
mode => 'tag',
verify => 1,
log_only => 1,
lock_timeout => 30,
set => { foo => 'bar' },
_params => [],
_cx => [],
}), {
mode => 'tag',
verify => 1,
log_only => 1,
lock_timeout => 30,
variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have mode, verify, set, log-only, & lock-timeout options';
CONFIG: {
my $config = TestConfig->new(
'deploy.mode' => 'change',
'deploy.verify' => 1,
'deploy.variables' => { foo => 'bar', hi => 21 },
);
is_deeply $CLASS->configure($config, {}), {
mode => 'change',
verify => 1,
log_only => 0,
_params => [],
_cx => [],
}, 'Should have mode and verify configuration';
}
##############################################################################
# Test construction.
isa_ok my $deploy = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
), $CLASS, 'new deploy with target';
is $deploy->target, 'foo', 'Should have target "foo"';
isa_ok $deploy = $CLASS->new(sqitch => $sqitch), $CLASS;
is $deploy->target, undef, 'Should have undef default target';
is $deploy->to_change, undef, 'to_change should be undef';
is $deploy->mode, 'all', 'mode should be "all"';
##############################################################################
# Test _collect_vars.
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $deploy->_collect_vars($target) }, {}, 'Should collect no variables';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $deploy->_collect_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core vars';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $deploy->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars';
# Add engine variables.
$config->update('engine.pg.variables' => { dance => 'disco', lunch => 'pizza' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $deploy->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with engine vars';
# Add target variables.
$config->update('target.foo.variables' => { lunch => 'burrito', drink => 'whiskey' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $deploy->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override engine vars with target vars';
# Add --set variables.
$deploy = $CLASS->new(
sqitch => $sqitch,
variables => { drink => 'scotch', status => 'winning' },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $deploy->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override target vars with --set variables';
##############################################################################
# Test execution.
# Mock parse_args() so that we can grab the target it returns.
my $mock_cmd = Test::MockModule->new($CLASS);
my $parser;
$mock_cmd->mock(parse_args => sub {
my @ret = $parser->(@_);
$target = $ret[0][0];
return @ret;
});
$parser = $mock_cmd->original('parse_args');
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine');
my @args;
$mock_engine->mock(deploy => sub { shift; @args = @_ });
my @vars;
$mock_engine->mock(set_variables => sub { shift; @vars = @_ });
ok $deploy->execute('@alpha'), 'Execute to "@alpha"';
is_deeply \@args, ['@alpha', 'all'],
'"@alpha" "all", and 0 should be passed to the engine';
ok $target, 'Should have a target';
ok !$target->engine->log_only, 'The engine should not be set log_only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The engine should have the default lock_timeout';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
@args = ();
ok $deploy->execute, 'Execute';
is_deeply \@args, [undef, 'all'],
'undef and "all" should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Try passing the change.
ok $deploy->execute('widgets'), 'Execute with change';
is_deeply \@args, ['widgets', 'all'],
'"widgets" and "all" should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Try passing the target.
ok $deploy->execute('db:pg:foo'), 'Execute with target';
is_deeply \@args, [undef, 'all'],
'undef and "all" should be passed to the engine';
is $target->name, 'db:pg:foo', 'The target should be as specified';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass both!
ok $deploy->execute('db:pg:blah', 'widgets'), 'Execute with change and target';
is_deeply \@args, ['widgets', 'all'],
'"widgets" and "all" should be passed to the engine';
is $target->name, 'db:pg:blah', 'The target should be as specified';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Reverse them!
ok $deploy->execute('db:pg:blah', 'widgets'), 'Execute with target and change';
is_deeply \@args, ['widgets', 'all'],
'"widgets" and "all" should be passed to the engine';
is $target->name, 'db:pg:blah', 'The target should be as specified';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Now pass a bunch of options.
$config->replace(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
isa_ok $deploy = $CLASS->new(
sqitch => $sqitch,
to_change => 'foo',
target => 'db:pg:hi',
mode => 'tag',
log_only => 1,
lock_timeout => 30,
verify => 1,
variables => { foo => 'bar', one => 1 },
), $CLASS, 'Object with to, mode, log_only, and variables';
@args = ();
ok $deploy->execute, 'Execute again';
ok $target->engine->with_verify, 'Engine should verify';
ok $target->engine->log_only, 'The engine should be set log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is_deeply \@args, ['foo', 'tag'],
'"foo", "tag", and 1 should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is $target->name, 'db:pg:hi', 'The target name should be from the target option';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Try passing the change.
ok $deploy->execute('widgets'), 'Execute with change';
ok $target->engine->with_verify, 'Engine should verify';
ok $target->engine->log_only, 'The engine should be set log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is_deeply \@args, ['foo', 'tag'],
'"foo", "tag", and 1 should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many changes specified; deploying to "{change}"',
change => 'foo',
)]], 'Should have too many changes warning';
# Pass the target.
ok $deploy->execute('db:pg:bye'), 'Execute with target again';
ok $target->engine->with_verify, 'Engine should verify';
ok $target->engine->log_only, 'The engine should be set log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is_deeply \@args, ['foo', 'tag'],
'"foo", "tag", and 1 should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is $target->name, 'db:pg:hi', 'The target should be from the target option';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => 'db:pg:hi',
)]], 'Should have warning about too many targets';
# Make sure the mode enum works.
for my $mode (qw(all tag change)) {
ok $CLASS->new( sqitch => $sqitch, mode => $mode ),
qq{"$mode" should be a valid mode};
}
for my $bad (qw(foo bad gar)) {
throws_ok {
$CLASS->new( sqitch => $sqitch, mode => $bad )
} qr/\QValue "$bad" did not pass type constraint "Enum[all,change,tag]/,
qq{"$bad" should not be a valid mode};
}
# Make sure we get an exception for unknown args.
throws_ok { $deploy->execute(qw(greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'deploy', 'Unknown arg ident should be "deploy"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exeption for two unknown arg';
throws_ok { $deploy->execute(qw(greg jon)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'deploy', 'Unknown args ident should be "deploy"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, jon',
), 'Should get an exeption for two unknown args';
done_testing;
exasol.t 100644 001751 000166 40276 15004170404 15652 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# To test against a live Exasol database, you must set the
# SQITCH_TEST_EXASOL_URI environment variable. this is a stanard URI::db URI,
# and should look something like this:
#
# export SQITCH_TEST_EXASOL_URI=db:exasol://dbadmin:password@localhost:5433/dbadmin?Driver=Exasol
#
# Note that it must include the `?Driver=$driver` bit so that DBD::ODBC loads
# the proper driver.
use strict;
use warnings;
use 5.010;
use Test::More;
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::Target;
use App::Sqitch::Plan;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
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';
##############################################################################
# Make sure the URI query properly affect the client options.
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('');
##############################################################################
# Test other configs for the target.
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';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.exasol.client' => '/path/to/exaplus',
'engine.exasol.target' => 'db:exasol://me:myself@localhost:4444',
'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';
is $exa->uri->as_string, 'db:exasol://me:myself@localhost:4444',
'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';
##############################################################################
# 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 verosity 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';
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';
# Make sure we have templates.
DBIEngineTest->test_templates_for($exa->key);
##############################################################################
# Can we do live tests?
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:exasol://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 {
$_;
};
# Sleep if it failed but Exasol is still starting up.
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;
# Make sure we have exaplus and can connect to the database.
$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;
# Make sure the sqitch schema is the first in the search path.
is $dbh->selectcol_arrayref('SELECT current_schema')->[0],
uc($reg2), 'The Sqitch schema should be the current schema';
},
no_unique => 1,
);
done_testing;
verify.t 100644 001751 000166 23711 15004170404 15656 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Path::Class qw(dir file);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::verify';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
new
from_change
to_change
variables
does
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(ContextCommand ConnectingCommand);
is_deeply [$CLASS->options], [qw(
target|t=s
from-change|from=s
to-change|to=s
set|s=s%
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
_params => [],
_cx => [],
}, 'Should have default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
from_change => 'foo',
to_change => 'bar',
set => { foo => 'bar' },
}), {
from_change => 'foo',
to_change => 'bar',
variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have changes and variables from options';
CONFIG: {
my $config = TestConfig->new(
'verify.variables' => { foo => 'bar', hi => 21 },
);
is_deeply $CLASS->configure($config, {}), { _params => [], _cx => [] },
'Should have no config if no options';
}
##############################################################################
# Test construction.
isa_ok my $verify = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
), $CLASS, 'new status with target';
is $verify->target, 'foo', 'Should have target "foo"';
isa_ok $verify = $CLASS->new(sqitch => $sqitch), $CLASS;
is $verify->target, undef, 'Default target should be undef';
is $verify->from_change, undef, 'from_change should be undef';
is $verify->to_change, undef, 'to_change should be undef';
##############################################################################
# Test _collect_vars.
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $verify->_collect_vars($target) }, {}, 'Should collect no variables';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core vars';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars';
# Add verify variables.
$config->update('verify.variables' => { dance => 'disco', lunch => 'pizza' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with verify vars';
# Add engine variables.
$config->update('engine.pg.variables' => { lunch => 'burrito', drink => 'whiskey' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override verify vars with engine vars';
# Add target variables.
$config->update('target.foo.variables' => { drink => 'scotch', status => 'winning' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with target vars';
# Add --set variables.
$verify = $CLASS->new(
sqitch => $sqitch,
variables => { status => 'tired', herb => 'oregano' },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $verify->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set variables';
$config->replace(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
$verify = $CLASS->new( sqitch => $sqitch, no_prompt => 1);
##############################################################################
# Test execution.
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my @args;
$mock_engine->mock(verify => sub { shift; @args = @_ });
my @vars;
$mock_engine->mock(set_variables => sub { shift; @vars = @_ });
ok $verify->execute, 'Execute with nothing.';
is_deeply \@args, [undef, undef],
'Two undefs should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
ok $verify->execute('@alpha'), 'Execute from "@alpha"';
is_deeply \@args, ['@alpha', undef],
'"@alpha" and undef should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should again have no warnings';
ok $verify->execute('@alpha', '@beta'), 'Execute from "@alpha" to "@beta"';
is_deeply \@args, ['@alpha', '@beta'],
'"@alpha" and "@beat" should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should still have no warnings';
isa_ok $verify = $CLASS->new(
sqitch => $sqitch,
from_change => 'foo',
to_change => 'bar',
variables => { foo => 'bar', one => 1 },
), $CLASS, 'Object with from, to, and variables';
ok $verify->execute, 'Execute again';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Still should have no warnings';
# Pass and specify changes.
ok $verify->execute('roles', 'widgets'), 'Execute with command-line args';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many changes specified; verifying from "{from}" to "{to}"',
from => 'foo',
to => 'bar',
)]], 'Should have warning about which roles are used';
# Pass a target.
$target = 'db:pg:';
my $mock_cmd = Test::MockModule->new(ref $verify);
my ($target_name_arg, $orig_meth);
$mock_cmd->mock(parse_args => sub {
my $self = shift;
my %p = @_;
my @ret = $self->$orig_meth(@_);
$target_name_arg = $ret[0][0]->name;
$ret[0][0] = $self->default_target;
return @ret;
});
$orig_meth = $mock_cmd->original('parse_args');
ok $verify->execute($target), 'Execute with target arg';
is $target_name_arg, $target, 'The target should have been passed to the engine';
is_deeply \@args, ['foo', 'bar'],
'"foo" and "bar" should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings';
# Pass a --target option.
isa_ok $verify = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS, 'Object with target';
$target_name_arg = undef;
@vars = ();
ok $verify->execute, 'Execute with no args';
is $target_name_arg, $target, 'The target option should have been passed to the engine';
is_deeply \@args, [undef, undef], 'Undefs should be passed to the engine';
is_deeply {@vars}, {}, 'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should once again have no warnings';
# Pass a target, get a warning.
ok $verify->execute('db:sqlite:', 'roles', 'widgets'),
'Execute with two targegs and two changes';
is $target_name_arg, $target, 'The target option should have been passed to the engine';
is_deeply \@args, ['roles', 'widgets'],
'The two changes should be passed to the engine';
is_deeply {@vars}, {}, 'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => $verify->default_target->name,
)]], 'Should have warning about too many targets';
# Make sure we get an exception for unknown args.
throws_ok { $verify->execute(qw(greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'verify', 'Unknown arg ident should be "verify"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exeption for two unknown arg';
throws_ok { $verify->execute(qw(greg jon)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'verify', 'Unknown args ident should be "verify"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, jon',
), 'Should get an exeption for two unknown args';
done_testing;
target.t 100644 001751 000166 100464 15004170404 15661 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More;
use App::Sqitch;
use Path::Class qw(dir file);
use Test::Exception;
use Locale::TextDomain qw(App-Sqitch);
use List::Util qw(first);
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Target';
use_ok $CLASS or die;
}
##############################################################################
# Load a target and test the basics.
my $config = TestConfig->new('core.engine' => 'sqlite');
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS;
can_ok $target, qw(
new
name
target
uri
sqitch
engine
registry
client
plan_file
plan
top_dir
deploy_dir
revert_dir
verify_dir
reworked_dir
reworked_deploy_dir
reworked_revert_dir
reworked_verify_dir
extension
variables
);
# Look at default values.
is $target->name, 'db:sqlite:', 'Name should be "db:sqlite:"';
is $target->target, $target->name, 'Target should be alias for name';
is $target->uri, URI::db->new('db:sqlite:'), 'URI should be "db:sqlite:"';
is $target->sqitch, $sqitch, 'Sqitch should be as passed';
is $target->engine_key, 'sqlite', 'Engine key should be "sqlite"';
isa_ok $target->engine, 'App::Sqitch::Engine::sqlite', 'Engine';
is $target->registry, $target->engine->default_registry,
'Should have default registry';
my $client = $target->engine->default_client;
$client .= '.exe' if App::Sqitch::ISWIN && $client !~ /[.](?:exe|bat)$/;
is $target->client, $client, 'Should have default client';
is $target->top_dir, dir, 'Should have default top_dir';
is $target->deploy_dir, $target->top_dir->subdir('deploy'),
'Should have default deploy_dir';
is $target->revert_dir, $target->top_dir->subdir('revert'),
'Should have default revert_dir';
is $target->verify_dir, $target->top_dir->subdir('verify'),
'Should have default verify_dir';
is $target->reworked_dir, $target->top_dir, 'Should have default reworked_dir';
is $target->reworked_deploy_dir, $target->reworked_dir->subdir('deploy'),
'Should have default reworked_deploy_dir';
is $target->reworked_revert_dir, $target->reworked_dir->subdir('revert'),
'Should have default reworked_revert_dir';
is $target->reworked_verify_dir, $target->reworked_dir->subdir('verify'),
'Should have default reworked_verify_dir';
is $target->extension, 'sql', 'Should have default extension';
is $target->plan_file, $target->top_dir->file('sqitch.plan')->cleanup,
'Should have default plan file';
isa_ok $target->plan, 'App::Sqitch::Plan', 'Should get plan';
is $target->plan->file, $target->plan_file,
'Plan file should be copied from Target';
my $uri = $target->uri;
is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI';
is $target->username, $uri->user, 'Username should be from URI';
is $target->password, $uri->password, 'Password should be from URI';
is_deeply $target->variables, {}, 'Variables should be empty';
do {
isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS;
local $ENV{SQITCH_USERNAME} = 'kamala';
local $ENV{SQITCH_PASSWORD} = 'S3cre7s';
is $target->username, $ENV{SQITCH_USERNAME},
'Username should be from environment variable';
is $target->password, $ENV{SQITCH_PASSWORD},
'Password should be from environment variable';
};
##############################################################################
# Let's look at how the object is created based on the params to new().
# First try no params.
throws_ok { $CLASS->new } qr/^Missing required arguments:/,
'Should get error for missing params';
# Pass both name and URI.
$uri = URI::db->new('db:pg://hi:there@localhost/blah'),
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => $uri,
variables => {a => 1},
), $CLASS, 'Target with name and URI';
is $target->name, 'foo', 'Name should be "foo"';
is $target->target, $target->name, 'Target should be alias for name';
is $target->uri, $uri, 'URI should be set as passed';
is $target->sqitch, $sqitch, 'Sqitch should be as passed';
is $target->engine_key, 'pg', 'Engine key should be "pg"';
isa_ok $target->engine, 'App::Sqitch::Engine::pg', 'Engine';
is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI';
is $target->username, 'hi', 'Username should be from URI';
do {
local $ENV{SQITCH_PASSWORD} = 'lolz';
is $target->password, 'lolz', 'Password should be from environment';
};
is_deeply $target->variables, {a => 1}, 'Variables should be set';
# Pass a URI but no name.
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
uri => $uri,
), $CLASS, 'Target with URI';
like $target->name, qr{db:pg://hi:?\@localhost/blah},
'Name should be URI without password';
is $target->target, $target->name, 'Target should be alias for name';
is $target->engine_key, 'pg', 'Engine key should be "pg"';
isa_ok $target->engine, 'App::Sqitch::Engine::pg', 'Engine';
is $target->dsn, $uri->dbi_dsn, 'DSN should be from URI';
is $target->username, $uri->user, 'Username should be from URI';
is $target->password, $uri->password, 'Password should be from URI';
# Set the URI via SQITCH_TARGET.
ENV: {
local $ENV{SQITCH_TARGET} = 'db:pg:';
isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS,
'Target from environment';
is $target->name, 'db:pg:', 'Name should be set';
is $target->uri, 'db:pg:', 'URI should be set';
is $target->engine_key, 'pg', 'Engine key should be "pg"';
isa_ok $target->engine, 'App::Sqitch::Engine::pg', 'Engine';
}
# Set up a config.
CONSTRUCTOR: {
my (@get_params, $orig_get);
my $mock = TestConfig->mock(
get => sub { my $c = shift; push @get_params => \@_; $orig_get->($c, @_); }
);
$orig_get = $mock->original('get');
$config->replace('core.engine' => 'sqlite');
# Pass neither, but rely on the engine in the Sqitch object.
my $sqitch = App::Sqitch->new(config => $config);
isa_ok my $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Default target';
is $target->name, 'db:sqlite:', 'Name should be "db:sqlite:"';
is $target->uri, URI::db->new('db:sqlite:'), 'URI should be "db:sqlite:"';
is_deeply \@get_params, [
[key => 'core.target'],
[key => 'core.engine'],
[key => 'engine.sqlite.target'],
], 'Should have tried to get engine target';
# Try with just core.engine.
delete $sqitch->options->{engine};
$config->update('core.engine' => 'mysql');
@get_params = ();
isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Default target';
is $target->name, 'db:mysql:', 'Name should be "db:mysql:"';
is $target->uri, URI::db->new('db:mysql:'), 'URI should be "db:mysql"';
is_deeply \@get_params, [
[key => 'core.target'],
[key => 'core.engine'],
[key => 'engine.mysql.target'],
], 'Should have tried to get core.target, core.engine and then the target';
# Try with no engine option but a name that looks like a URI.
@get_params = ();
delete $sqitch->options->{engine};
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
name => 'db:pg:',
), $CLASS, 'Target with URI in name';
is $target->name, 'db:pg:', 'Name should be "db:pg:"';
is $target->uri, URI::db->new('db:pg:'), 'URI should be "db:pg"';
is_deeply \@get_params, [], 'Should have fetched no config';
# Try it with a name with no engine.
throws_ok { $CLASS->new(sqitch => $sqitch, name => 'db:') } 'App::Sqitch::X',
'Should have error for no engine in URI';
is $@->ident, 'target', 'Should have target ident';
is $@->message, __x(
'No engine specified by URI {uri}; URI must start with "db:$engine:"',
uri => 'db:',
), 'Should have message about no engine-less URI';
# Try it with no configured core engine or target.
$config->replace;
throws_ok { $CLASS->new(sqitch => $sqitch) } 'App::Sqitch::X',
'Should have error for no engine or target';
is $@->ident, 'target', 'Should have target ident';
is $@->message, __(
'No project configuration found. Run the "init" command to initialize a project',
), 'Should have message about no configuration';
# Try it with a config file but no engine config.
MOCK: {
my $mock_init = TestConfig->mock(initialized => 1);
throws_ok { $CLASS->new(sqitch => $sqitch) } 'App::Sqitch::X',
'Should again have error for no engine or target';
is $@->ident, 'target', 'Should have target ident again';
is $@->message, __(
'No engine specified; specify via target or core.engine',
), 'Should have message about no specified engine';
}
# Try with engine-less URI.
@get_params = ();
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
uri => URI::db->new('db:'),
), $CLASS, 'Engineless target';
is $target->name, 'db:', 'Name should be "db:"';
is $target->uri, URI::db->new('db:'), 'URI should be "db:"';
is_deeply \@get_params, [], 'Should not have tried to get engine target';
is $target->sqitch, $sqitch, 'Sqitch should be as passed';
is $target->engine_key, undef, 'Engine key should be undef';
throws_ok { $target->engine } 'App::Sqitch::X',
'Should get exception for no engine';
is $@->ident, 'engine', 'Should have engine ident';
is $@->message, __(
'No engine specified; specify via target or core.engine',
), 'Should have message about no engine';
is $target->top_dir, dir, 'Should have default top_dir';
is $target->deploy_dir, $target->top_dir->subdir('deploy'),
'Should have default deploy_dir';
is $target->revert_dir, $target->top_dir->subdir('revert'),
'Should have default revert_dir';
is $target->verify_dir, $target->top_dir->subdir('verify'),
'Should have default verify_dir';
is $target->reworked_dir, $target->top_dir, 'Should have default reworked_dir';
is $target->reworked_deploy_dir, $target->reworked_dir->subdir('deploy'),
'Should have default reworked_deploy_dir';
is $target->reworked_revert_dir, $target->reworked_dir->subdir('revert'),
'Should have default reworked_revert_dir';
is $target->reworked_verify_dir, $target->reworked_dir->subdir('verify'),
'Should have default reworked_verify_dir';
is $target->extension, 'sql', 'Should have default extension';
is $target->plan_file, $target->top_dir->file('sqitch.plan')->cleanup,
'Should have default plan file';
isa_ok $target->plan, 'App::Sqitch::Plan', 'Should get plan';
is $target->plan->file, $target->plan_file,
'Plan file should be copied from Target';
is $target->dsn, '', 'DSN should be empty';
is $target->username, undef, 'Username should be undef';
is $target->password, undef, 'Password should be undef';
# Try passing a proper URI via the name.
@get_params = ();
isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'db:pg://a:b@foo/scat'), $CLASS,
'Engine URI target';
like $target->name, qr{db:pg://a:?\@foo/scat}, 'Name should be "db:pg://a@foo/scat"';
is $target->uri, URI::db->new('db:pg://a:b@foo/scat'),
'URI should be "db:pg://a:b@foo/scat"';
is_deeply \@get_params, [], 'Nothing should have been fetched from config';
# Pass nothing, but let a URI be in core.target.
@get_params = ();
$config->update('core.target' => 'db:pg://s:b@ack/shi');
isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS,
'Engine URI core.target';
like $target->name, qr{db:pg://s:?\@ack/shi}, 'Name should be "db:pg://s@ack/shi"';
is $target->uri, URI::db->new('db:pg://s:b@ack/shi'),
'URI should be "db:pg://s:b@ack/shi"';
is_deeply \@get_params, [[key => 'core.target']],
'Should have fetched core.target from config';
# Pass nothing, but let a target name be in core.target.
@get_params = ();
$config->update(
'core.target' => 'shout',
'target.shout.uri' => 'db:pg:w:e@we/bar',
);
isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS,
'Engine name core.target';
is $target->name, 'shout', 'Name should be "shout"';
is $target->uri, URI::db->new('db:pg:w:e@we/bar'),
'URI should be "db:pg:w:e@we/bar"';
is_deeply \@get_params, [
[key => 'core.target'],
[key => 'target.shout.uri']
], 'Should have fetched target.shout.uri from config';
# Mock get_section.
my (@sect_params, $orig_sect);
$mock->mock(get_section => sub {
my $c = shift; push @sect_params => \@_; $orig_sect->($c, @_);
});
$orig_sect = $mock->original('get_section');
# Try it with a name.
$sqitch->options->{engine} = 'sqlite';
@get_params = ();
throws_ok { $CLASS->new(sqitch => $sqitch, name => 'foo') } 'App::Sqitch::X',
'Should have exception for unknown named target';
is $@->ident, 'target', 'Unknown target error ident should be "target"';
is $@->message, __x(
'Cannot find target "{target}"',
target => 'foo',
), 'Unknown target error message should be correct';
is_deeply \@get_params, [[key => 'target.foo.uri']],
'Should have requested target URI from config';
is_deeply \@sect_params, [[section => 'target.foo']],
'Should have requested target.foo section';
# Let the name section exist, but without a URI.
@get_params = @sect_params = ();
$config->replace('target.foo.bar' => 1);
throws_ok { $CLASS->new(sqitch => $sqitch, name => 'foo') } 'App::Sqitch::X',
'Should have exception for URL-less named target';
is $@->ident, 'target', 'URL-less target error ident should be "target"';
is $@->message, __x(
'No URI associated with target "{target}"',
target => 'foo',
), 'URL-less target error message should be correct';
is_deeply \@get_params, [[key => 'target.foo.uri']],
'Should have requested target URI from config';
is_deeply \@sect_params, [[section => 'target.foo']],
'Should have requested target.foo section';
# Now give it a URI.
@get_params = @sect_params = ();
$config->replace( 'target.foo.uri' => 'db:pg:foo');
$sqitch = App::Sqitch->new(config => $config);
isa_ok $target = $CLASS->new(sqitch => $sqitch, name => 'foo'), $CLASS,
'Named target';
is $target->name, 'foo', 'Name should be "foo"';
is $target->uri, URI::db->new('db:pg:foo'), 'URI should be "db:pg:foo"';
is_deeply \@get_params, [[key => 'target.foo.uri']],
'Should have requested target URI from config';
is_deeply \@sect_params, [],
'Should not have requested deprecated pg section';
# Let the name be looked up by the engine.
@get_params = @sect_params = ();
$config->update(
'core.target' => 'foo',
'target.foo.uri' => 'db:sqlite:foo',
);
isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Engine named target';
is $target->name, 'foo', 'Name should be "foo"';
is $target->uri, URI::db->new('db:sqlite:foo'), 'URI should be "db:sqlite:foo"';
is_deeply \@get_params, [
[key => 'core.target'],
[key => 'target.foo.uri']
], 'Should have requested engine target and target URI from config';
is_deeply \@sect_params, [], 'Should have requested no section';
# Let the name come from the environment.
ENV: {
@get_params = @sect_params = ();
$config->replace('target.bar.uri' => 'db:sqlite:bar');
local $ENV{SQITCH_TARGET} = 'bar';
isa_ok $target = $CLASS->new(sqitch => $sqitch), $CLASS, 'Environment-named target';
is $target->name, 'bar', 'Name should be "bar"';
is $target->uri, URI::db->new('db:sqlite:bar'), 'URI should be "db:sqlite:bar"';
is_deeply \@get_params, [[key => 'target.bar.uri']],
'Should have requested target URI from config';
is_deeply \@sect_params, [], 'Should have requested no sections';
}
# Make sure uri params work.
@get_params = @sect_params = ();
$config->replace('core.engine' => 'pg');
$uri = URI::db->new('db:pg://fred@foo.com:12245/widget');
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
host => 'foo.com',
port => 12245,
user => 'fred',
dbname => 'widget',
), $CLASS, 'URI-munged target';
is_deeply \@sect_params, [], 'Should have requested no section';
like $target->name, qr{db:pg://fred:?\@foo.com:12245/widget},
'Name should be passwordless stringified URI';
is $target->uri, $uri, 'URI should be tweaked by URI params';
# URI params should work when URI read from target config.
$uri = URI::db->new('db:pg://foo.com/widget');
@get_params = @sect_params = ();
$sqitch->options->{db_host} = 'foo.com';
$sqitch->options->{db_name} = 'widget';
$config->update('target.foo.uri' => 'db:pg:');
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
host => 'foo.com',
dbname => 'widget',
), $CLASS, 'Foo target';
is_deeply \@get_params, [ [key => 'target.foo.uri' ]],
'Should have requested target URI';
is_deeply \@sect_params, [], 'Should have fetched no section';
is $target->name, 'foo', 'Name should be as passed';
is $target->uri, $uri, 'URI should be tweaked by URI params';
# URI params should work when URI passsed.
$uri = URI::db->new('db:pg://:1919/');
@get_params = @sect_params = ();
$sqitch->options->{db_host} = 'foo.com';
$sqitch->options->{db_name} = 'widget';
isa_ok $target = $CLASS->new(
sqitch => $sqitch,
name => 'db:pg:widget',
host => '',
dbname => '',
port => 1919,
), $CLASS, 'URI target';
is_deeply \@get_params, [], 'Should have requested no config';
is_deeply \@sect_params, [], 'Should have fetched no section';
is $target->name, $uri, 'Name should tweaked by URI params';
is $target->uri, $uri, 'URI should be tweaked by URI params';
}
CONFIG: {
# Look at how attributes are populated from options, config.
my $opts = {};
$config->replace(
'core.engine' => 'pg',
'core.registry' => 'myreg',
'core.client' => 'pgsql',
'core.plan_file' => 'my.plan',
'core.top_dir' => 'top',
'core.deploy_dir' => 'dep',
'core.revert_dir' => 'rev',
'core.verify_dir' => 'ver',
'core.reworked_dir' => 'wrk',
'core.reworked_deploy_dir' => 'rdep',
'core.reworked_revert_dir' => 'rrev',
'core.reworked_verify_dir' => 'rver',
'core.extension' => 'ddl',
);
my $sqitch = App::Sqitch->new(options => $opts, config => $config);
my $target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => URI::db->new('db:pg:foo'),
);
is $target->registry, 'myreg', 'Registry should be "myreg"';
is $target->client, 'pgsql', 'Client should be "pgsql"';
is $target->plan_file, 'my.plan', 'Plan file should be "my.plan"';
isa_ok $target->plan_file, 'Path::Class::File', 'Plan file';
isa_ok my $plan = $target->plan, 'App::Sqitch::Plan', 'Plan';
is $plan->file, $target->plan_file, 'Plan should use target plan file';
is $target->top_dir, 'top', 'Top dir should be "top"';
isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir';
is $target->deploy_dir, 'dep', 'Deploy dir should be "dep"';
isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir';
is $target->revert_dir, 'rev', 'Revert dir should be "rev"';
isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir';
is $target->verify_dir, 'ver', 'Verify dir should be "ver"';
isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir';
is $target->reworked_dir, 'wrk', 'Reworked dir should be "wrk"';
isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir';
is $target->reworked_deploy_dir, 'rdep', 'Reworked deploy dir should be "rdep"';
isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir';
is $target->reworked_revert_dir, 'rrev', 'Reworked revert dir should be "rrev"';
isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir';
is $target->reworked_verify_dir, 'rver', 'Reworked verify dir should be "rver"';
isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir';
is $target->extension, 'ddl', 'Extension should be "ddl"';
is_deeply $target->variables, {}, 'Should have no variables';
# Add engine config.
$config->update(
'engine.pg.registry' => 'yoreg',
'engine.pg.client' => 'mycli',
'engine.pg.plan_file' => 'pg.plan',
'engine.pg.top_dir' => 'pg',
'engine.pg.deploy_dir' => 'pgdep',
'engine.pg.revert_dir' => 'pgrev',
'engine.pg.verify_dir' => 'pgver',
'engine.pg.reworked_dir' => 'pg/r',
'engine.pg.reworked_deploy_dir' => 'pgrdep',
'engine.pg.reworked_revert_dir' => 'pgrrev',
'engine.pg.reworked_verify_dir' => 'pgrver',
'engine.pg.extension' => 'pgddl',
'engine.pg.variables' => { x => 'ex', y => 'why', z => 'zee' },
);
$target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => URI::db->new('db:pg:foo'),
);
is $target->registry, 'yoreg', 'Registry should be "yoreg"';
is $target->client, 'mycli', 'Client should be "mycli"';
is $target->plan_file, 'pg.plan', 'Plan file should be "pg.plan"';
isa_ok $target->plan_file, 'Path::Class::File', 'Plan file';
isa_ok $plan = $target->plan, 'App::Sqitch::Plan', 'Plan';
is $plan->file, $target->plan_file, 'Plan should use target plan file';
is $target->top_dir, 'pg', 'Top dir should be "pg"';
isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir';
is $target->deploy_dir, 'pgdep', 'Deploy dir should be "pgdep"';
isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir';
is $target->revert_dir, 'pgrev', 'Revert dir should be "pgrev"';
isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir';
is $target->verify_dir, 'pgver', 'Verify dir should be "pgver"';
isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir';
is $target->reworked_dir, dir('pg/r'), 'Reworked dir should be "pg/r"';
isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir';
is $target->reworked_deploy_dir, 'pgrdep', 'Reworked deploy dir should be "pgrdep"';
isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir';
is $target->reworked_revert_dir, 'pgrrev', 'Reworked revert dir should be "pgrrev"';
isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir';
is $target->reworked_verify_dir, 'pgrver', 'Reworked verify dir should be "pgrver"';
isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir';
is $target->extension, 'pgddl', 'Extension should be "pgddl"';
is_deeply $target->variables, {x => 'ex', y => 'why', z => 'zee'},
'Variables should be read from engine.variables';
# Add target config.
$config->update(
'target.foo.registry' => 'fooreg',
'target.foo.client' => 'foocli',
'target.foo.plan_file' => 'foo.plan',
'target.foo.top_dir' => 'foo',
'target.foo.deploy_dir' => 'foodep',
'target.foo.revert_dir' => 'foorev',
'target.foo.verify_dir' => 'foover',
'target.foo.reworked_dir' => 'foo/r',
'target.foo.reworked_deploy_dir' => 'foodepr',
'target.foo.reworked_revert_dir' => 'foorevr',
'target.foo.reworked_verify_dir' => 'fooverr',
'target.foo.extension' => 'fooddl',
'engine.pg.variables' => { z => 'zie', a => 'ay' },
);
$target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => URI::db->new('db:pg:foo'),
);
is $target->registry, 'fooreg', 'Registry should be "fooreg"';
is $target->client, 'foocli', 'Client should be "foocli"';
is $target->plan_file, 'foo.plan', 'Plan file should be "foo.plan"';
isa_ok $target->plan_file, 'Path::Class::File', 'Plan file';
isa_ok $plan = $target->plan, 'App::Sqitch::Plan', 'Plan';
is $plan->file, $target->plan_file, 'Plan should use target plan file';
is $target->top_dir, 'foo', 'Top dir should be "foo"';
isa_ok $target->top_dir, 'Path::Class::Dir', 'Top dir';
is $target->deploy_dir, 'foodep', 'Deploy dir should be "foodep"';
isa_ok $target->deploy_dir, 'Path::Class::Dir', 'Deploy dir';
is $target->revert_dir, 'foorev', 'Revert dir should be "foorev"';
isa_ok $target->revert_dir, 'Path::Class::Dir', 'Revert dir';
is $target->verify_dir, 'foover', 'Verify dir should be "foover"';
isa_ok $target->verify_dir, 'Path::Class::Dir', 'Verify dir';
is $target->reworked_dir, dir('foo/r'), 'Reworked dir should be "foo/r"';
isa_ok $target->reworked_dir, 'Path::Class::Dir', 'Reworked dir';
is $target->reworked_deploy_dir, 'foodepr', 'Reworked deploy dir should be "foodepr"';
isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir';
is $target->reworked_revert_dir, 'foorevr', 'Reworked revert dir should be "foorevr"';
isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir';
is $target->reworked_verify_dir, 'fooverr', 'Reworked verify dir should be "fooverr"';
isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir';
is $target->extension, 'fooddl', 'Extension should be "fooddl"';
is_deeply $target->variables, {x => 'ex', y => 'why', z => 'zie', a => 'ay'},
'Variables should be read from engine., and target.variables';
}
sub _load($) {
my $config = App::Sqitch::Config->new;
$config->load_file(file 't', "$_[0].conf");
return $config;
}
ALL: {
# Let's test loading all targets. Start with only core.
my $config = TestConfig->from(local => file qw(t core.conf) );
my $sqitch = App::Sqitch->new(config => $config);
ok my @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all targets';
is @targets, 1, 'Should have one target';
is $targets[0]->name, 'db:pg:',
'It should be the generic core engine target';
# Now load one with a core target defined.
$config = TestConfig->from(local => file qw(t core_target.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok @targets = $CLASS->all_targets(sqitch => $sqitch),
'Load all targets with core target config';
is @targets, 1, 'Should again have one target';
is $targets[0]->name, 'db:pg:whatever', 'It should be the named target';
is_deeply $targets[0]->variables, {}, 'It should have no variables';
# Try it with both engine and target defined.
$sqitch->config->load_file(file 't', 'core.conf');
ok @targets = $CLASS->all_targets(sqitch => $sqitch),
'Load all targets with core engine and target config';
is @targets, 1, 'Should still have one target';
is $targets[0]->name, 'db:pg:whatever', 'It should again be the named target';
is_deeply $targets[0]->variables, {}, 'It should have no variables';
# Great, now let's load one with some engines in it.
$config = TestConfig->from(local => file qw(t user.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all user conf targets';
is @targets, 4, 'Should have four user targets';
is_deeply [ sort map { $_->name } @targets ], [
'db:firebird:',
'db:mysql:',
'db:pg://postgres@localhost/thingies',
'db:sqlite:my.db',
], 'Should have all the engine targets';
my $mysql = first { $_->name eq 'db:mysql:' } @targets;
is_deeply $mysql->variables, {prefix => 'foo_'},
'MySQL target should have engine variables';
# Load one with targets.
$config = TestConfig->from(local => file qw(t target.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all target conf targets';
is @targets, 4, 'Should have three targets';
is $targets[0]->name, 'db:pg:', 'Core engine should be default target';
is_deeply [ sort map { $_->name } @targets ], [qw(db:pg: dev prod qa)],
'Should have the core target plus the named targets';
# Load one with engines and targets.
$config = TestConfig->from(local => file qw(t local.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all local conf targets';
is @targets, 2, 'Should have two local targets';
is $targets[0]->name, 'mydb', 'Core engine should be lead to default target';
is_deeply [ sort map { $_->name } @targets ], [qw(devdb mydb)],
'Should have the core target plus the named targets';
# Mix up a core engine, engines, and targets.
$config = TestConfig->from(local => file qw(t engine.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all engine conf targets';
is @targets, 3, 'Should have three engine conf targets';
is_deeply [ sort map { $_->name } @targets ],
[qw(db:mysql://root@/foo db:pg:try widgets)],
'Should have the engine and target targets';
# Make sure parameters are set on all targets.
ok @targets = $CLASS->all_targets(
sqitch => $sqitch,
registry => 'quack',
dbname => 'w00t',
), 'Overload all engine conf targets';
is @targets, 3, 'Should again have three engine conf targets';
is_deeply [ sort map { $_->uri->as_string } @targets ],
[qw(db:mysql://root@/w00t db:pg:w00t db:sqlite:w00t)],
'Should have set dbname on all target URIs';
is_deeply [ map { $_->registry } @targets ], [('quack') x 3],
'Should have set the registry on all targets.';
}
SCRIPT_DIRS: {
# Test for behavior of script dirs.
my $opts = {};
$config->replace(
'core.engine' => 'pg',
'core.deploy_dir' => 'up',
'core.revert_dir' => 'down',
'core.verify_dir' => 'test',
);
my $sqitch = App::Sqitch->new(options => $opts, config => $config);
my $target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => URI::db->new('db:pg:foo'),
);
is $target->top_dir, dir, 'Should have default top_dir';
is $target->deploy_dir, $target->top_dir->subdir('up'),
'Should have custom deploy_dir';
is $target->revert_dir, $target->top_dir->subdir('down'),
'Should have custom revert_dir';
is $target->verify_dir, $target->top_dir->subdir('test'),
'Should have custom verify_dir';
is $target->reworked_dir, $target->top_dir, 'Should have default reworked_dir';
is $target->reworked_deploy_dir, $target->reworked_dir->subdir('up'),
'Should have derived reworked_deploy_dir';
is $target->reworked_revert_dir, $target->reworked_dir->subdir('down'),
'Should have derived reworked_revert_dir';
is $target->reworked_verify_dir, $target->reworked_dir->subdir('test'),
'Should have derived reworked_verify_dir';
}
REWORK_DIRS: {
# Test for behavior of script dirs.
my $opts = {};
$config->replace(
'core.engine' => 'pg',
'core.reworked_dir' => 'past',
'core.deploy_dir' => 'up',
'core.revert_dir' => 'down',
'core.verify_dir' => 'test',
);
my $sqitch = App::Sqitch->new(options => $opts, config => $config);
my $target = $CLASS->new(
sqitch => $sqitch,
name => 'foo',
uri => URI::db->new('db:pg:foo'),
);
is $target->top_dir, dir, 'Should have default top_dir';
is $target->deploy_dir, $target->top_dir->subdir('up'),
'Should have custom deploy_dir';
is $target->revert_dir, $target->top_dir->subdir('down'),
'Should have custom revert_dir';
is $target->verify_dir, $target->top_dir->subdir('test'),
'Should have custom verify_dir';
is $target->reworked_dir, dir('past'), 'Should have custom reworked_dir';
is $target->reworked_deploy_dir, $target->reworked_dir->subdir('up'),
'Should have derived reworked_deploy_dir';
is $target->reworked_revert_dir, $target->reworked_dir->subdir('down'),
'Should have derived reworked_revert_dir';
is $target->reworked_verify_dir, $target->reworked_dir->subdir('test'),
'Should have derived reworked_verify_dir';
}
done_testing;
oracle.t 100644 001751 000166 65073 15004170404 15626 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# Environment variables required to test:
#
# * `SQITCH_TEST_ORACLE_URI`: A `db:oracle:` URI to connnect to the Oracle
# database.
# * `SQITCH_TEST_ALT_ORACLE_REGISTRY`: A different Oracle username to use as
# an alternate registry schema. The user in `SQITCH_TEST_ORACLE_URI` must
# have permission to write to this user's schema.
# * `TWO_TASK`: If connecting to a pluggable database, you must also use the
# TWO_TASK environment variable.
#
# ## Prerequisites
#
# Sqitch requires local access to the [Oracle Instant
# Client](https://www.oracle.com/database/technologies/instant-client/downloads.html),
# specifically the Basic, SQL*Plus, and SDK packages. Unpack them into a
# directory and set `ORACLE_HOME` and `LD_LIBRARY_PATH` to point to that
# directory, and add it to the Path. Then install DBD::Oracle.
#
# ## Oracle-XE Docker Image
#
# The simplest way to the Sqitch Oracle engine is with the
# [gvenzl/oracle-xe](https://hub.docker.com/r/gvenzl/oracle-xe) docker image.
# See `.github/workflows/oracle.yml` for an example. But essentially, start it
# like so:
#
# docker run -d -p 1521:1521 -e ORACLE_PASSWORD=oracle gvenzl/oracle-xe:18-slim
#
# Then you can configure connection like so:
#
# export SQITCH_TEST_ORACLE_URI=db:oracle://system:oracle@localhost/XE
# export SQITCH_TEST_ALT_ORACLE_REGISTRY=gsmuser
# prove -lv t/oracle.t
#
# The `gsmuser` schema already exists in the `18-slim` image, so it should just
# work. You can create another user (and schema), though on Oracle 12 and later
# it will only be created in the XEPDB1 pluggable database. Pass the `APP_USER`
# and `APP_USER_PASSWORD` variables to `docker run` like so:
#
# docker run -d -p 1521:1521 \
# -e ORACLE_PASSWORD=oracle \
# -e APP_USER=sqitch \
# -e APP_USER_PASSWORD=oracle \
# gvenzl/oracle-xe:18-slim
#
# Then use the `TWO_TASK` environment variable to complete the connection
# (connecting to a pluggable database cannot be done purely by the connnection
# URI; see [oci-oracle-xe#46](https://github.com/gvenzl/oci-oracle-xe/issues/46)
# and [DBD::Oracle#131](https://github.com/perl5-dbi/DBD-Oracle/issues/131) for
# details):
#
# export SQITCH_TEST_ORACLE_URI=db:oracle://system:oracle@/
# export TWO_TASK=localhost/XEPDB1
# export SQITCH_TEST_ALT_ORACLE_REGISTRY=sqitch
# prove -lv t/oracle.t
#
# ## Developer Days VM
#
# Tests can also be run against the Developer Days VM with a bit of
# configuration. Download the VM from:
#
# https://www.oracle.com/database/technologies/databaseappdev-vm.html
#
# Once the VM is imported into VirtualBox and started, login with the username
# "oracle" and the password "oracle". Then, in VirtualBox, go to Settings ->
# Network, select the NAT adapter, and add two port forwarding rules
# (https://barrymcgillin.blogspot.com/2011/12/using-oracle-developer-days-virtualbox.html):
#
# Host Port | Guest Port
# -----------+------------
# 1521 | 1521
# 2222 | 22
#
# Then restart the VM. You should then be able to connect from your host with:
#
# sqlplus sys/oracle@localhost/ORCL as sysdba
#
# If this fails with either of these errors:
#
# ORA-01017: invalid username/password; logon denied ORA-21561: OID
# generation failed
#
# Make sure that your computer's hostname is on the localhost line of /etc/hosts
# (https://sourceforge.net/p/tora/discussion/52737/thread/f68b89ad/):
#
# > hostname
# stickywicket
# > grep 127 /etc/hosts
# 127.0.0.1 localhost stickywicket
#
# Once connected, execute this SQL to create the user and give it access:
#
# CREATE USER sqitchtest IDENTIFIED BY oracle;
# GRANT ALL PRIVILEGES TO sqitchtest;
#
# The tests can use the existing "oe" user for the altnerate schema, so now the
# test can be run with:
#
# export SQITCH_TEST_ORACLE_URI=db:oracle://sqitchtest:oracle@localhost/ORCL
# export SQITCH_TEST_ALT_ORACLE_REGISTRY=oe
# prove -lv t/oracle.t
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::Target;
use App::Sqitch::Plan;
use File::Temp 'tempdir';
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine::oracle';
require_ok $CLASS or die;
delete $ENV{ORACLE_HOME};
}
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $config = TestConfig->new('core.engine' => 'oracle');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
isa_ok my $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $ora->key, 'oracle', 'Key should be "oracle"';
is $ora->name, 'Oracle', 'Name should be "Oracle"';
my $client = 'sqlplus' . (App::Sqitch::ISWIN ? '.exe' : '');
is $ora->client, $client, 'client should default to sqlplus';
ORACLE_HOME: {
my $iswin = App::Sqitch::ISWIN || $^O eq 'cygwin';
my $cli = 'sqlplus' . ($iswin ? '.exe' : '');
# Start with no ORACLE_HOME.
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
isa_ok my $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $ora->client, $cli, 'client should default to sqlplus';
# Put client in ORACLE_HOME.
my $tmpdir = tempdir(CLEANUP => 1);
my $tmp = Path::Class::Dir->new("$tmpdir");
my $sqlplus = $tmp->file($cli);
$sqlplus->touch;
chmod 0755, $sqlplus unless $iswin;
local $ENV{ORACLE_HOME} = "$tmpdir";
$target = App::Sqitch::Target->new(sqitch => $sqitch);
isa_ok $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $ora->client, $sqlplus, 'client should use $ORACLE_HOME';
# ORACLE_HOME/bin takes precedence.
my $bin = Path::Class::Dir->new("$tmpdir", 'bin');
$bin->mkpath;
$sqlplus = $bin->file($cli);
$sqlplus->touch;
chmod 0755, $sqlplus unless $iswin;
$target = App::Sqitch::Target->new(sqitch => $sqitch);
isa_ok $ora = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $ora->client, $sqlplus, 'client should use $ORACLE_HOME/bin';
}
is $ora->registry, '', 'registry default should be empty';
is $ora->uri, 'db:oracle:', 'Default URI should be "db:oracle"';
my $dest_uri = $ora->uri->clone;
$dest_uri->dbname(
$ENV{TWO_TASK}
|| (App::Sqitch::ISWIN ? $ENV{LOCAL} : undef)
|| $ENV{ORACLE_SID}
);
is $ora->target->name, $ora->uri, 'Target name should be the uri stringified';
is $ora->destination, $dest_uri->as_string,
'Destination should fall back on environment variables';
is $ora->registry_destination, $ora->destination,
'Registry target should be the same as target';
my @std_opts = qw(-S -L /nolog);
is_deeply [$ora->sqlplus], [$client, @std_opts],
'sqlplus command should connect to /nolog';
is $ora->_script, join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'connect ',
$ora->_registry_variable,
) ), '_script should work';
# Set up a target URI.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:oracle://fred:derf@/blah')
);
isa_ok $ora = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $ora->_script, join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'connect fred/"derf"@"blah"',
$ora->_registry_variable,
) ), '_script should assemble connection string';
# Add a host name.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:oracle://fred:derf@there/blah')
);
isa_ok $ora = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $ora->_script('@foo'), join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'connect fred/"derf"@//there/"blah"',
$ora->_registry_variable,
'@foo',
) ), '_script should assemble connection string with host';
# Add a port and varibles.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new(
'db:oracle://fred:derf%20%22derf%22@there:1345/blah%20%22blah%22'
),
);
isa_ok $ora = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
ok $ora->set_variables(foo => 'baz', whu => 'hi there', yo => q{"stellar"}),
'Set some variables';
is $ora->_script, join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'DEFINE foo="baz"',
'DEFINE whu="hi there"',
'DEFINE yo="""stellar"""',
'connect fred/"derf ""derf"""@//there:1345/"blah ""blah"""',
$ora->_registry_variable,
) ), '_script should assemble connection string with host, port, and vars';
# Try a URI with nothing but the database name.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:oracle:secure_user_tns.tpg'),
);
like $target->uri->dbi_dsn, qr{^dbi:Oracle:(?:service_name=)?secure_user_tns\.tpg$},
'Database-only URI should produce proper DSN';
isa_ok $ora = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $ora->_script('@foo'), join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'connect /@"secure_user_tns.tpg"',
$ora->_registry_variable,
'@foo',
) ), '_script should assemble connection string with just dbname';
# Try a URI with double slash, but otherwise just the db name.
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:oracle://:@/wallet_tns_name'),
);
like $target->uri->dbi_dsn, qr{dbi:Oracle:(?:service_name=)?wallet_tns_name$},
'Database and double-slash URI should produce proper DSN';
isa_ok $ora = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $ora->_script('@foo'), join( "\n" => (
'SET ECHO OFF NEWP 0 SPA 0 PAGES 0 FEED OFF HEAD OFF TRIMS ON TAB OFF VERIFY OFF',
'WHENEVER OSERROR EXIT 9;',
'WHENEVER SQLERROR EXIT 4;',
'connect /@"wallet_tns_name"',
$ora->_registry_variable,
'@foo',
) ), '_script should assemble connection string with double-slash and dbname';
##############################################################################
# Test other configs for the destination.
$target = App::Sqitch::Target->new(sqitch => $sqitch);
ENV: {
# Make sure we override system-set vars.
local $ENV{TWO_TASK};
local $ENV{ORACLE_SID};
for my $env (qw(TWO_TASK ORACLE_SID)) {
my $ora = $CLASS->new(sqitch => $sqitch, target => $target);
local $ENV{$env} = '$ENV=whatever';
is $ora->target->name, "db:oracle:", "Target name should not read \$$env";
is $ora->destination, "db:oracle:\$ENV=whatever", "Destination should read \$$env";
is $ora->registry_destination, $ora->destination,
'Registry destination should be the same as destination';
}
$ENV{TWO_TASK} = 'mydb';
$ora = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target);
is $ora->target->name, 'db:oracle:', 'Target should be the default';
is $ora->destination, 'db:oracle:mydb',
'Destination should prefer $TWO_TASK to username';
is $ora->registry_destination, $ora->destination,
'Registry destination should be the same as destination';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.oracle.client' => '/path/to/sqlplus',
'engine.oracle.target' => 'db:oracle://bob:hi@db.net:12/howdy',
'engine.oracle.registry' => 'meta',
);
$target = App::Sqitch::Target->new(sqitch => $sqitch);
ok $ora = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another ora';
is $ora->client, '/path/to/sqlplus', 'client should be as configured';
is $ora->uri->as_string, 'db:oracle://bob:hi@db.net:12/howdy',
'DB URI should be as configured';
like $ora->target->name, qr{^db:oracle://bob:?\@db\.net:12/howdy$},
'Target name should be the passwordless URI stringified';
like $ora->destination, qr{^db:oracle://bob:?\@db\.net:12/howdy$},
'Destination should be the URI without the password';
is $ora->registry_destination, $ora->destination,
'registry_destination should replace be the same URI';
is $ora->registry, 'meta', 'registry should be as configured';
is_deeply [$ora->sqlplus], ['/path/to/sqlplus', @std_opts],
'sqlplus command should be configured';
$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 verosity 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"'],
'Verifile 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';
is $ora->_can_limit, 0, 'Should have _can_limit false';
is $ora->_multi_values(1, 'FOO'), 'SELECT FOO FROM dual',
'Should get single expression from _multi_values';
is $ora->_multi_values(2, 'LOWER(?)'),
"SELECT LOWER(?) FROM dual\nUNION ALL SELECT LOWER(?) FROM dual",
'Should get double expression from _multi_values';
is $ora->_multi_values(4, 'X'),
"SELECT X FROM dual\nUNION ALL SELECT X FROM dual\nUNION ALL SELECT X FROM dual\nUNION ALL SELECT X FROM dual",
'Should get quadrupal expression from _multi_values';
DBI: {
local *DBI::err;
ok !$ora->_no_table_error, 'Should have no table error';
ok !$ora->_no_column_error, 'Should have no column error';
$DBI::err = 942;
ok $ora->_no_table_error, 'Should now have table error';
ok !$ora->_no_column_error, 'Still should have no column error';
$DBI::err = 904;
ok !$ora->_no_table_error, 'Should again have no table error';
ok $ora->_no_column_error, 'Should now have no column error';
}
# Test _log_tags_param.
my $plan = App::Sqitch::Plan->new(
sqitch => $sqitch,
target => $target,
'project' => 'oracle',
);
my $change = App::Sqitch::Plan::Change->new(
name => 'oracle_test',
plan => $plan,
);
my @tags = map {
App::Sqitch::Plan::Tag->new(
plan => $plan,
name => $_,
change => $change,
)
} qw(xxx yyy zzz);
$change->add_tag($_) for @tags;
is_deeply $ora->_log_tags_param($change), [qw(@xxx @yyy @zzz)],
'_log_tags_param should format tags';
# Test _log_requires_param.
my @req = map {
App::Sqitch::Plan::Depend->new(
%{ App::Sqitch::Plan::Depend->parse($_) },
plan => $plan,
)
} qw(aaa bbb ccc);
my $mock_change = Test::MockModule->new(ref $change);
$mock_change->mock(requires => sub { @req });
is_deeply $ora->_log_requires_param($change), [qw(aaa bbb ccc)],
'_log_requires_param should format prereqs';
# Test _log_conflicts_param.
$mock_change->mock(conflicts => sub { @req });
is_deeply $ora->_log_conflicts_param($change), [qw(aaa bbb ccc)],
'_log_conflicts_param should format prereqs';
$mock_change->unmock_all;
##############################################################################
# Test _change_id_in()
can_ok $CLASS, qw(_change_id_in);
my $change_id_in = $CLASS->can('_change_id_in');
is $change_id_in->(0), '', 'Should get empty string for 0 change IDs';
is $change_id_in->(1), 'change_id IN (?)',
'Should get single param for 1 change ID';
is $change_id_in->(3), 'change_id IN (?, ?, ?)',
'Should get 3 params for 3 change IDs';
for my $count (10, 32, 50, 200, 250) {
is $change_id_in->($count),
'change_id IN (' . join(', ' => ('?') x $count) . ')',
"Should get $count params for $count change IDs";
}
# Make sure we get multiple IN clauses for over 250 IDs.
my $in_group = 'change_id IN (' . join(', ' => ('?') x 250) . ')';
is $change_id_in->(251), "$in_group OR change_id IN (?)",
'Should get 250 and 1 groups for 251 IDs';
is $change_id_in->(253), "$in_group OR change_id IN (?, ?, ?)",
'Should get 250 and 3 groups for 253 IDs';
is $change_id_in->(502), "$in_group OR $in_group OR change_id IN (?, ?)",
'Should get 250, 240, and 2 groups for 503 IDs';
is $change_id_in->(1042), join(
' OR ', $in_group, $in_group, $in_group, $in_group,
'change_id IN (' . join(', ' => ('?') x 42) . ')'
), 'Should get 4 x 250 and 42 groups for 1042 IDs';
# Make sure we have templates.
DBIEngineTest->test_templates_for($ora->key);
##############################################################################
# Can we do live tests?
if (App::Sqitch::ISWIN && eval { require Win32::API }) {
# Call kernel32.SetErrorMode(SEM_FAILCRITICALERRORS):
# "The system does not display the critical-error-handler message box.
# Instead, the system sends the error to the calling process." and
# "A child process inherits the error mode of its parent process."
my $SetErrorMode = Win32::API->new('kernel32', 'SetErrorMode', 'I', 'I');
my $SEM_FAILCRITICALERRORS = 0x0001;
$SetErrorMode->Call($SEM_FAILCRITICALERRORS);
}
my $alt_reg = $ENV{SQITCH_TEST_ALT_ORACLE_REGISTRY} || 'oe';
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->{RaiseError} = 0;
$dbh->{PrintError} = 1;
$dbh->do($_) for (
'DROP TABLE events',
'DROP TABLE dependencies',
'DROP TABLE tags',
'DROP TABLE changes',
'DROP TABLE projects',
'DROP TABLE releases',
'DROP TYPE sqitch_array',
"DROP TABLE $alt_reg.events",
"DROP TABLE $alt_reg.dependencies",
"DROP TABLE $alt_reg.tags",
"DROP TABLE $alt_reg.changes",
"DROP TABLE $alt_reg.projects",
"DROP TABLE $alt_reg.releases",
"DROP TYPE $alt_reg.sqitch_array",
);
$dbh->disconnect;
}
my $uri = $ENV{SQITCH_TEST_ORACLE_URI} ? URI->new($ENV{SQITCH_TEST_ORACLE_URI}) : do {
my $uri = URI->new('db:oracle:');
$uri->user($ENV{ORAUSER} || 'scott');
$uri->password($ENV{ORAPASS} || 'tiger');
$uri;
};
my $err = try {
$ora->use_driver;
$dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $ora->error_handler,
});
undef;
} catch {
$_;
};
DBIEngineTest->run(
class => $CLASS,
version_query => q{SELECT * FROM v$version WHERE banner LIKE 'Oracle%'},
target_params => [ uri => $uri ],
alt_target_params => [ uri => $uri, registry => $alt_reg ],
skip_unless => sub {
my $self = shift;
die $err if $err;
#####
## Uncomment to find another user/schema to use for the alternate
# schema in .github/workflows/oracle.yml.
# my $dbh = $self->dbh;
# for my $u (@{ $dbh->selectcol_arrayref('SELECT USERNAME FROM all_users') }) {
# my $result = 'success';
# try {
# $dbh->do("CREATE TABLE $u.try(id FLOAT)");
# $dbh->do("INSERT INTO $u.try VALUES(?)", undef, 1.0);
# } catch {
# $result = 'fail';
# };
# Test::More::diag("$u: $result");
# }
# Make sure we have sqlplus and can connect to the database.
$self->sqitch->probe( $self->client, '-v' );
my $v = $self->sqitch->capture( $self->client, '-v' );
$v =~ s/\n+/ /gsx; $v =~ s/^\s+//;
say "# Detected $v";
$self->_capture('SELECT 1 FROM dual;');
},
engine_err_regex => qr/^ORA-00925: /,
init_error => __ 'Sqitch already initialized',
add_second_format => q{%s + interval '1' second},
);
done_testing;
bundle.t 100644 001751 000166 46226 15004170404 15631 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 301;
#use Test::More 'no_plan';
use App::Sqitch;
use Path::Class;
use Test::Exception;
use Test::Warn;
use Test::File qw(file_exists_ok file_not_exists_ok);
use Test::File::Contents;
use Locale::TextDomain qw(App-Sqitch);
use File::Path qw(remove_tree);
use Test::NoWarnings;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::bundle';
# Ignore user and system configs.
$ENV{SQITCH_USER_CONFIG} = $ENV{SQITCH_SYSTEM_CONFIG} = File::Spec->devnull;
ok my $sqitch = App::Sqitch->new, 'Load a sqitch object';
my $config = $sqitch->config;
isa_ok my $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'bundle command';
can_ok $CLASS, qw(
configure
execute
from
to
dest_dir
dest_top_dir
dest_dirs_for
bundle_config
bundle_plan
bundle_scripts
_mkpath
_copy_if_modified
does
);
ok $CLASS->does("App::Sqitch::Role::ContextCommand"),
"$CLASS does ContextCommand";
is_deeply [$CLASS->options], [qw(
dest-dir|dir=s
all|a!
from=s
to=s
plan-file|f=s
top-dir=s
)], 'Should have dest_dir option';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
is $bundle->dest_dir, dir('bundle'),
'Default dest_dir should be bundle/';
is $bundle->dest_top_dir($bundle->default_target), dir('bundle'),
'Should have dest top dir';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {_cx => []},
'Default config should be empty';
is_deeply $CLASS->configure($config, {dest_dir => 'whu'}), {
dest_dir => dir('whu'),
_cx => [],
}, '--dest_dir should be converted to a path object by configure()';
is_deeply $CLASS->configure($config, {from => 'HERE', to => 'THERE'}), {
from => 'HERE',
to => 'THERE',
_cx => [],
}, '--from and --to should be passed through configure';
chdir 't';
$config= TestConfig->from(local => 'sqitch.conf');
$config->update('core.top_dir' => dir('sql')->stringify);
END { remove_tree 'bundle' if -d 'bundle' }
ok $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch object with top_dir';
$config = $sqitch->config;
my $dir = dir qw(_build sql);
is_deeply $CLASS->configure($config, {}), {
dest_dir => $dir,
_cx => [],
}, 'bundle.dest_dir config should be converted to a path object by configure()';
##############################################################################
# Load a real project.
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'another bundle command';
is $bundle->dest_dir, $dir, qq{dest_dir should be "$dir"};
is $bundle->dest_top_dir($bundle->default_target), dir(qw(_build sql sql)),
'Dest top dir should be _build/sql/sql/';
my $target = $bundle->default_target;
my $dir_for = $bundle->dest_dirs_for($target);
for my $sub (qw(deploy revert verify)) {
is $dir_for->{$sub}, $dir->subdir('sql', $sub),
"Dest $sub dir should be _build/sql/sql/$sub";
}
# Try engine project.
$config->update(
'core.top_dir' => dir('engine')->stringify,
'core.reworked_dir' => dir(qw(engine reworked))->stringify,
);
ok $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch object with engine top_dir';
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'engine bundle command';
$target = $bundle->default_target;
is $bundle->dest_dir, $dir, qq{dest_dir should again be "$dir"};
$dir_for = $bundle->dest_dirs_for($target);
for my $sub (qw(deploy revert verify)) {
is $dir_for->{$sub}, $dir->subdir('engine', $sub),
"Dest $sub dir should be _build/sql/engine/$sub";
}
##############################################################################
# Test _copy().
my $path = dir 'delete.me';
END { remove_tree $path->stringify if -e $path }
my $file = file qw(sql deploy roles.sql);
my $dest = file $path, qw(deploy roles.sql);
file_not_exists_ok $dest, "File $dest should not exist";
ok $bundle->_copy_if_modified($file, $dest), "Copy $file to $dest";
file_exists_ok $dest, "File $dest should now exist";
file_contents_identical $dest, $file;
is_deeply +MockOutput->get_debug, [
[' ', __x 'Created {file}', file => $dest->dir],
[' ', __x(
"Copying {source} -> {dest}",
source => $file,
dest => $dest
)],
], 'The mkdir and copy info should have been output';
# Copy it again.
ok $bundle->_copy_if_modified($file, $dest), "Copy $file to $dest again";
file_exists_ok $dest, "File $dest should still exist";
file_contents_identical $dest, $file;
my $out = MockOutput->get_debug;
is_deeply $out, [], 'Should have no debugging output' or diag explain $out;
# Make it old and copy it again.
utime 0, $file->stat->mtime - 1, $dest;
ok $bundle->_copy_if_modified($file, $dest), "Copy $file to old $dest";
file_exists_ok $dest, "File $dest should still be there";
file_contents_identical $dest, $file;
is_deeply +MockOutput->get_debug, [[' ', __x(
"Copying {source} -> {dest}",
source => $file,
dest => $dest
)]], 'Only copy message should again have been emitted';
# Copy a different file.
my $file2 = file qw(sql deploy users.sql);
$dest->remove;
ok $bundle->_copy_if_modified($file2, $dest), "Copy $file2 to $dest";
file_exists_ok $dest, "File $dest should now exist";
file_contents_identical $dest, $file2;
is_deeply +MockOutput->get_debug, [[' ', __x(
"Copying {source} -> {dest}",
source => $file2,
dest => $dest
)]], 'Again only Copy message should have been emitted';
# Try to copy a nonexistent file.
my $nonfile = file 'nonexistent.txt';
throws_ok { $bundle->_copy_if_modified($nonfile, $dest) } 'App::Sqitch::X',
'Should get exception when source file does not exist';
is $@->ident, 'bundle', 'Nonexistent file error ident should be "bundle"';
is $@->message, __x(
'Cannot copy {file}: does not exist',
file => $nonfile,
), 'Nonexistent file error message should be correct';
COPYDIE: {
# Make copy die.
$dest->remove;
my $mocker = Test::MockModule->new('File::Copy');
$mocker->mock(copy => sub { return 0 });
throws_ok { $bundle->_copy_if_modified($file, $dest) } 'App::Sqitch::X',
'Should get exception when copy returns false';
is $@->ident, 'bundle', 'Copy fail ident should be "bundle"';
is $@->message, __x(
'Cannot copy "{source}" to "{dest}": {error}',
source => $file,
dest => $dest,
error => $!,
), 'Copy fail error message should be correct';
}
##############################################################################
# Test bundle_config().
END {
my $to_remove = $dir->parent->stringify;
remove_tree $to_remove if -e $to_remove;
}
$dest = file $dir, qw(sqitch.conf);
file_not_exists_ok $dest;
ok $bundle->bundle_config, 'Bundle the config file';
file_exists_ok $dest;
file_contents_identical $dest, file('sqitch.conf');
is_deeply +MockOutput->get_info, [[__ 'Writing config']],
'Should have config notice';
##############################################################################
# Test bundle_plan().
$dest = file $bundle->dest_top_dir($bundle->default_target), qw(sqitch.plan);
file_not_exists_ok $dest;
ok $bundle->bundle_plan($bundle->default_target),
'Bundle the default target plan file';
file_exists_ok $dest;
file_contents_identical $dest, file(qw(engine sqitch.plan));
is_deeply +MockOutput->get_info, [[__ 'Writing plan']],
'Should have plan notice';
# Make sure that --from works.
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
args => ['--from', 'widgets'],
}), $CLASS, '--from bundle command';
is $bundle->from, 'widgets', 'From should be "widgets"';
ok $bundle->bundle_plan($bundle->default_target, 'widgets'),
'Bundle the default target plan file with from arg';
my $plan = $bundle->default_target->plan;
is_deeply +MockOutput->get_info, [[__x(
'Writing plan from {from} to {to}',
from => 'widgets',
to => '@HEAD',
)]], 'Statement of the bits written should have been emitted';
file_contents_is $dest,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=engine' . "\n"
. "\n"
. $plan->find('widgets')->as_string . "\n"
. $plan->find('func/add_user')->as_string . "\n"
. $plan->find('users@HEAD')->as_string . "\n",
'Plan should contain only changes from "widgets" on';
# Make sure that --to works.
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
args => ['--to', 'users'],
}), $CLASS, '--to bundle command';
is $bundle->to, 'users', 'To should be "users"';
ok $bundle->bundle_plan($bundle->default_target, undef, 'users'),
'Bundle the default target plan file with to arg';
is_deeply +MockOutput->get_info, [[__x(
'Writing plan from {from} to {to}',
from => '@ROOT',
to => 'users',
)]], 'Statement of the bits written should have been emitted';
file_contents_is $dest,
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=engine' . "\n"
. "\n"
. $plan->find('users')->as_string . "\n"
. join( "\n", map { $_->as_string } $plan->find('users')->tags ) . "\n",
'Plan should have written only "users" and its tags';
##############################################################################
# Test bundle_scripts().
my @scripts = (
$dir_for->{reworked_deploy}->file('users@alpha.sql'),
$dir_for->{reworked_revert}->file('users@alpha.sql'),
$dir_for->{deploy}->file('widgets.sql'),
$dir_for->{revert}->file('widgets.sql'),
$dir_for->{deploy}->file(qw(func add_user.sql)),
$dir_for->{revert}->file(qw(func add_user.sql)),
$dir_for->{deploy}->file('users.sql'),
$dir_for->{revert}->file('users.sql'),
);
file_not_exists_ok $_ for @scripts;
$config->update( 'core.extension' => 'sql');
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'another bundle command';
ok $bundle->bundle_scripts($bundle->default_target),
'Bundle default target scripts';
file_exists_ok $_ for @scripts;
is_deeply +MockOutput->get_info, [
[__ 'Writing scripts'],
[' + ', 'users @alpha'],
[' + ', 'widgets'],
[' + ', 'func/add_user'],
[' + ', 'users'],
], 'Should have change notices';
# Make sure that --from works.
remove_tree $dir->parent->stringify;
isa_ok $bundle = App::Sqitch::Command::bundle->new(
sqitch => $sqitch,
dest_dir => $bundle->dest_dir,
from => 'widgets',
), $CLASS, 'bundle from "widgets"';
ok $bundle->bundle_scripts($bundle->default_target, 'widgets'), 'Bundle scripts';
file_not_exists_ok $_ for @scripts[0,1];
file_exists_ok $_ for @scripts[2,3];
is_deeply +MockOutput->get_info, [
[__ 'Writing scripts'],
[' + ', 'widgets'],
[' + ', 'func/add_user'],
[' + ', 'users'],
], 'Should have changes only from "widets" onward in notices';
# Make sure that --to works.
remove_tree $dir->parent->stringify;
isa_ok $bundle = App::Sqitch::Command::bundle->new(
sqitch => $sqitch,
dest_dir => $bundle->dest_dir,
to => 'users@alpha',
), $CLASS, 'bundle to "users"';
ok $bundle->bundle_scripts($bundle->default_target, undef, 'users@alpha'), 'Bundle scripts';
file_exists_ok $_ for @scripts[0,1];
file_not_exists_ok $_ for @scripts[2,3];
is_deeply +MockOutput->get_info, [
[__ 'Writing scripts'],
[' + ', 'users @alpha'],
], 'Should have only "users" in change notices';
# Should throw exceptions on unknonw changes.
for my $key (qw(from to)) {
my $bundle = $CLASS->new( sqitch => $sqitch, $key => 'nonexistent' );
throws_ok {
$bundle->bundle_scripts($bundle->default_target, 'nonexistent')
} 'App::Sqitch::X', "Should die on nonexistent $key change";
is $@->ident, 'bundle', qq{Nonexistent $key change ident should be "bundle"};
is $@->message, __x(
'Cannot find change {change}',
change => 'nonexistent',
), "Nonexistent $key message change should be correct";
}
##############################################################################
# Test execute().
MockOutput->get_debug;
remove_tree $dir->parent->stringify;
@scripts = (
file($dir, 'sqitch.conf'),
file($bundle->dest_top_dir($bundle->default_target), 'sqitch.plan'),
@scripts,
);
file_not_exists_ok $_ for @scripts;
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'another bundle command';
ok $bundle->execute, 'Execute!';
file_exists_ok $_ for @scripts;
is_deeply +MockOutput->get_info, [
[__x 'Bundling into {dir}', dir => $bundle->dest_dir ],
[__ 'Writing config'],
[__ 'Writing plan'],
[__ 'Writing scripts'],
[' + ', 'users @alpha'],
[' + ', 'widgets'],
[' + ', 'func/add_user'],
[' + ', 'users'],
], 'Should have all notices';
# Try a configuration with multiple plans.
my $multidir = $dir->parent;
END { remove_tree $multidir->stringify }
remove_tree $multidir->stringify;
my @sql = (
$multidir->file(qw(sql sqitch.plan)),
$multidir->file(qw(sql deploy roles.sql)),
$multidir->file(qw(sql deploy users.sql)),
$multidir->file(qw(sql verify users.sql)),
$multidir->file(qw(sql deploy widgets.sql)),
);
my @engine = (
$multidir->file(qw(engine sqitch.plan)),
$multidir->file(qw(engine reworked deploy users@alpha.sql)),
$multidir->file(qw(engine reworked revert users@alpha.sql)),
$multidir->file(qw(engine deploy widgets.sql)),
$multidir->file(qw(engine revert widgets.sql)),
$multidir->file(qw(engine deploy func add_user.sql)),
$multidir->file(qw(engine revert func add_user.sql)),
$multidir->file(qw(engine deploy users.sql)),
$multidir->file(qw(engine revert users.sql)),
);
my $conf_file = $multidir->file('multiplan.conf'),;
file_not_exists_ok $_ for ($conf_file, @sql, @engine);
$config = TestConfig->from(local => 'multiplan.conf');
$sqitch = App::Sqitch->new(config => $config);
isa_ok $bundle = $CLASS->new(
sqitch => $sqitch,
config => $config,
all => 1,
from => '@ROOT',
dest_dir => dir '_build',
), $CLASS, 'all multiplan bundle command';
ok $bundle->execute, 'Execute multi-target bundle!';
file_exists_ok $_ for ($conf_file, @sql, @engine);
is_deeply +MockOutput->get_warn, [[__(
"Use of --to or --from to bundle multiple targets is not recommended.\nPass them as arguments after each target argument, instead."
)]], 'Should have a warning about --from and -too';
# Make sure we get an error with both --all and a specified target.
throws_ok { $bundle->execute('pg' ) } 'App::Sqitch::X',
'Should get an error for --all and a target arg';
is $@->ident, 'bundle', 'Mixed arguments error ident should be "bundle"';
is $@->message, __(
'Cannot specify both --all and engine, target, or plan arugments'
), 'Mixed arguments error message should be correct';
# Try without --all.
isa_ok $bundle = $CLASS->new(
sqitch => $sqitch,
config => $sqitch->config,
dest_dir => dir '_build',
), $CLASS, 'multiplan bundle command';
remove_tree $multidir->stringify;
ok $bundle->execute, qq{Execute with no arg};
file_exists_ok $_ for ($conf_file, @engine);
file_not_exists_ok $_ for @sql;
# Make sure it works with bundle.all set, as well.
$config->update('bundle.all' => 1);
remove_tree $multidir->stringify;
ok $bundle->execute, qq{Execute with bundle.all config};
file_exists_ok $_ for ($conf_file, @engine, @sql);
# Try limiting it in various ways.
for my $spec (
[
target => 'pg',
{ include => \@engine, exclude => \@sql },
],
[
'plan file' => file(qw(engine sqitch.plan))->stringify,
{ include => \@engine, exclude => \@sql },
],
[
target => 'mysql',
{ include => \@sql, exclude => \@engine },
],
[
'plan file' => file(qw(sql sqitch.plan))->stringify,
{ include => \@sql, exclude => \@engine },
],
) {
my ($type, $arg, $files) = @{ $spec };
remove_tree $multidir->stringify;
ok $bundle->execute($arg), qq{Execute with $type arg "$arg"};
file_exists_ok $_ for ($conf_file, @{ $files->{include} });
file_not_exists_ok $_ for @{ $files->{exclude} };
}
# Make sure we handle --to and --from.
isa_ok $bundle = $CLASS->new(
sqitch => $sqitch,
config => $sqitch->config,
from => 'widgets',
to => 'widgets',
dest_dir => dir '_build',
), $CLASS, 'to/from bundle command';
remove_tree $multidir->stringify;
ok $bundle->execute('pg'), 'Execute to/from bundle!';
file_exists_ok $_ for ($conf_file, @engine[0,3,4]);
file_not_exists_ok $_ for (@engine[1,2,5..$#engine]);
file_contents_is $engine[0],
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=engine' . "\n"
. "\n"
. $plan->find('widgets')->as_string . "\n",
'Plan should have written only "widgets"';
# Make sure we handle to and from args.
isa_ok $bundle = $CLASS->new(
sqitch => $sqitch,
config => $sqitch->config,
dest_dir => dir '_build',
), $CLASS, 'another bundle command';
remove_tree $multidir->stringify;
ok $bundle->execute(qw(pg widgets @HEAD)), 'Execute bundle with to/from args!';
file_exists_ok $_ for ($conf_file, @engine[0,3..$#engine]);
file_not_exists_ok $_ for (@engine[1,2]);
file_contents_is $engine[0],
'%syntax-version=' . App::Sqitch::Plan::SYNTAX_VERSION . "\n"
. '%project=engine' . "\n"
. "\n"
. $plan->find('widgets')->as_string . "\n"
. $plan->find('func/add_user')->as_string . "\n"
. $plan->find('users@HEAD')->as_string . "\n",
'Plan should have written "widgets" and "func/add_user"';
# Should die on unknown argument.
throws_ok { $bundle->execute('nonesuch') } 'App::Sqitch::X',
'Should get an exception for unknown argument';
is $@->ident, 'bundle', 'Unknown argument error ident shoud be "bundle"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'nonesuch',
), 'Unknown argument error message should be correct';
# Should handle multiple arguments, too.
throws_ok { $bundle->execute(qw(ba da dum)) } 'App::Sqitch::X',
'Should get an exception for unknown arguments';
is $@->ident, 'bundle', 'Unknown arguments error ident shoud be "bundle"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
3,
arg => join ', ', qw(ba da dum)
), 'Unknown arguments error message should be correct';
# Should die on both changes and --from or -to.
isa_ok $bundle = $CLASS->new(
sqitch => $sqitch,
config => $sqitch->config,
from => '@ROOT',
), $CLASS, 'all multiplan bundle command';
throws_ok { $bundle->execute(qw(widgets)) } 'App::Sqitch::X',
'Should get an exception a change name and --from';
is $@->ident, 'bundle', 'Conflicting arguments error ident shoud be "bundle"';
is $@->message, __('Cannot specify both --from or --to and change arguments'),
'Conflicting arguments error message should be correct';
config.t 100644 001751 000166 120432 15004170404 15635 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 360;
# use Test::More 'no_plan';
use File::Spec;
use Test::MockModule;
use Test::Exception;
use Test::NoWarnings;
use Test::Warn;
use Path::Class;
use File::Path qw(remove_tree);
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Command::config';
use_ok $CLASS or die;
}
my $config = TestConfig->new;
ok my $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
isa_ok my $cmd = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'config',
config => $config,
}), 'App::Sqitch::Command::config', 'Config command';
isa_ok $cmd, 'App::Sqitch::Command', 'Config command';
can_ok $cmd, qw(file action context get get_all get_regex set add unset unset_all list edit);
is_deeply [$cmd->options], [qw(
file|config-file|f=s
local
user|global
system
int
bool
bool-or-int
num
get
get-all
get-regex|get-regexp
add
replace-all
unset
unset-all
rename-section
remove-section
list|l
edit|e
)], 'Options should be configured';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
##############################################################################
# Test configure errors.
my $mock = Test::MockModule->new('App::Sqitch::Command::config');
my @usage;
$mock->mock(usage => sub { shift; @usage = @_; die 'USAGE' });
# Test for multiple config file specifications.
throws_ok { $CLASS->configure( $sqitch->config, {
user => 1,
system => 1,
}) } qr/USAGE/, 'Construct with user and system';
is_deeply \@usage, ['Only one config file at a time.'],
'Should get error for multiple config files';
throws_ok { $CLASS->configure( $sqitch->config, {
user => 1,
local => 1,
}) } qr/USAGE/, 'Construct with user and local';
is_deeply \@usage, ['Only one config file at a time.'],
'Should get error for multiple config files';
throws_ok { $CLASS->configure( $sqitch->config, {
file => 't/sqitch.ini',
system => 1,
})} qr/USAGE/, 'Construct with file and system';
is_deeply \@usage, ['Only one config file at a time.'],
'Should get another error for multiple config files';
throws_ok { $CLASS->configure( $sqitch->config, {
file => 't/sqitch.ini',
user => 1,
})} qr/USAGE/, 'Construct with file and user';
is_deeply \@usage, ['Only one config file at a time.'],
'Should get a third error for multiple config files';
throws_ok { $CLASS->configure( $sqitch->config, {
file => 't/sqitch.ini',
user => 1,
system => 1,
})} qr/USAGE/, 'Construct with file, system, and user';
is_deeply \@usage, ['Only one config file at a time.'],
'Should get one last error for multiple config files';
# Test for multiple type specifications.
throws_ok { $CLASS->configure( $sqitch->config, {
bool => 1,
num => 1,
}) } qr/USAGE/, 'Construct with bool and num';
is_deeply \@usage, ['Only one type at a time.'],
'Should get error for multiple types';
throws_ok { $CLASS->configure( $sqitch->config, {
sqitch => $sqitch,
int => 1,
num => 1,
})} qr/USAGE/, 'Construct with int and num';
is_deeply \@usage, ['Only one type at a time.'],
'Should get another error for multiple types';
throws_ok { $CLASS->configure( $sqitch->config, {
int => 1,
bool => 1,
})} qr/USAGE/, 'Construct with int and bool';
is_deeply \@usage, ['Only one type at a time.'],
'Should get a third error for multiple types';
throws_ok { $CLASS->configure( $sqitch->config, {
int => 1,
bool => 1,
num => 1,
})} qr/USAGE/, 'Construct with int, num, and bool';
is_deeply \@usage, ['Only one type at a time.'],
'Should get one last error for multiple types';
# Test for multiple action specifications.
for my $spec (
[qw(get unset)],
[qw(get unset edit)],
[qw(get unset edit list)],
[qw(unset edit)],
[qw(unset edit list)],
[qw(edit list)],
[qw(edit add list)],
[qw(edit add list get_all)],
[qw(edit add list get_regex)],
[qw(edit add list unset_all)],
[qw(edit add list get_all unset_all)],
[qw(edit list remove_section)],
[qw(edit list remove_section rename_section)],
) {
throws_ok { $CLASS->configure( $sqitch->config, {
map { $_ => 1 } @{ $spec }
})} qr/USAGE/, 'Construct with ' . join ' & ' => @{ $spec };
is_deeply \@usage, ['Only one action at a time.'],
'Should get error for multiple actions';
}
##############################################################################
# Test context.
is $cmd->file, $sqitch->config->dir_file,
'Default context should be local context';
is $cmd->action, undef, 'Default action should be undef';
is $cmd->context, undef, 'Default context should be undef';
# Test local file name.
is_deeply $CLASS->configure( $sqitch->config, {
local => 1,
}), {
context => 'local',
}, 'Local context should be local';
# Test user file name.
is_deeply $CLASS->configure( $sqitch->config, {
user => 1,
}), {
context => 'user',
}, 'User context should be user';
# Test system file name.
is_deeply $CLASS->configure( $sqitch->config, {
system => 1,
}), {
context => 'system',
}, 'System context should be system';
##############################################################################
# Test execute().
my @fail;
$mock->mock(fail => sub { shift; @fail = @_; die "FAIL @_" });
my @set;
$mock->mock(set => sub { shift; @set = @_; return 1 });
my @get;
$mock->mock(get => sub { shift; @get = @_; return 1 });
my @get_all;
$mock->mock(get_all => sub { shift; @get_all = @_; return 1 });
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'system',
}), 'Create config set command';
ok $cmd->execute(qw(foo bar)), 'Execute the set command';
is_deeply \@set, [qw(foo bar)], 'The set method should have been called';
ok $cmd->execute(qw(foo)), 'Execute the get command';
is_deeply \@get, [qw(foo)], 'The get method should have been called';
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
}), 'Create config get_all command';
$cmd->execute('boy.howdy');
is_deeply \@get_all, ['boy.howdy'],
'An action with a dash should have triggered a method with an underscore';
$mock->unmock(qw(set get get_all));
##############################################################################
# Test get().
chdir 't';
$config = TestConfig->from(local => 'sqitch.conf', user => 'user.conf');
$sqitch = App::Sqitch->new(config => $config);
my @emit;
$mock->mock(emit => sub { shift; push @emit => [@_] });
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
}), 'Create config get command';
ok $cmd->execute('core.engine'), 'Get core.engine';
is_deeply \@emit, [['pg']], 'Should have emitted the merged core.engine';
@emit = ();
ok $cmd->execute('engine.pg.registry'), 'Get engine.pg.registry';
is_deeply \@emit, [['meta']], 'Should have emitted the merged engine.pg.registry';
@emit = ();
ok $cmd->execute('engine.pg.client'), 'Get engine.pg.client';
is_deeply \@emit, [['/usr/local/pgsql/bin/psql']],
'Should have emitted the merged engine.pg.client';
@emit = ();
# Make sure the key is required.
throws_ok { $cmd->get } qr/USAGE/, 'Should get usage for missing get key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing get key should trigger a usage message';
throws_ok { $cmd->get('') } qr/USAGE/, 'Should get usage for invalid get key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid get key should trigger a usage message';
# Make sure int data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
type => 'int',
}), 'Create config get int command';
ok $cmd->execute('revert.count'), 'Get revert.count as int';
is_deeply \@emit, [[2]],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as int';
is_deeply \@emit, [[1]],
'Should have emitted the revert revision as an int';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an int should fail';
is $@->ident, 'config', 'Int cast exception ident should be "config"';
# Make sure num data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
type => 'num',
}), 'Create config get num command';
ok $cmd->execute('revert.count'), 'Get revert.count as num';
is_deeply \@emit, [[2]],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as num';
is_deeply \@emit, [[1.1]],
'Should have emitted the revert revision as an num';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an num should fail';
is $@->ident, 'config', 'Num cast exception ident should be "config"';
# Make sure bool data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
type => 'bool',
}), 'Create config get bool command';
throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X',
'Should get failure for invalid bool int';
is $@->ident, 'config', 'Bool int cast exception ident should be "config"';
throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X',
'Should get failure for invalid bool num';
is $@->ident, 'config', 'Bool num cast exception ident should be "config"';
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool';
is_deeply \@emit, [['true']],
'Should have emitted bundle.tags_only as a bool';
@emit = ();
# Make sure bool-or-int data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
type => 'bool-or-int',
}), 'Create config get bool-or-int command';
ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int';
is_deeply \@emit, [[2]],
'Should have emitted the revert count as an int';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int';
is_deeply \@emit, [[1]],
'Should have emitted the revert revision as an int';
@emit = ();
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int';
is_deeply \@emit, [['true']],
'Should have emitted bundle.tags_only as a bool';
@emit = ();
chdir File::Spec->updir;
CONTEXT: {
my $config = TestConfig->from(system => file qw(t sqitch.conf));
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'system',
action => 'get',
}), 'Create system config get command';
ok $cmd->execute('core.engine'), 'Get system core.engine';
is_deeply \@emit, [['pg']], 'Should have emitted the system core.engine';
@emit = ();
ok $cmd->execute('engine.pg.client'), 'Get system engine.pg.client';
is_deeply \@emit, [['/usr/local/pgsql/bin/psql']],
'Should have emitted the system engine.pg.client';
@emit = @fail = ();
throws_ok { $cmd->execute('engine.pg.host') } 'App::Sqitch::X',
'Attempt to get engine.pg.host should fail';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
is_deeply \@emit, [], 'Nothing should have been emitted';
$config = TestConfig->from(
system => file(qw(t sqitch.conf)),
user => file(qw(t user.conf)),
);
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'user',
action => 'get',
}), 'Create user config get command';
@emit = ();
ok $cmd->execute('engine.pg.registry'), 'Get user engine.pg.registry';
is_deeply \@emit, [['meta']], 'Should have emitted the user engine.pg.registry';
@emit = ();
ok $cmd->execute('engine.pg.client'), 'Get user engine.pg.client';
is_deeply \@emit, [['/opt/local/pgsql/bin/psql']],
'Should have emitted the user engine.pg.client';
@emit = ();
$config = TestConfig->from(
system => file(qw(t sqitch.conf)),
user => file(qw(t user.conf)),
local => file(qw(t local.conf)),
);
$sqitch->config->load;
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'local',
action => 'get',
}), 'Create local config get command';
@emit = ();
ok $cmd->execute('engine.pg.target'), 'Get local engine.pg.target';
is_deeply \@emit, [['mydb']], 'Should have emitted the local engine.pg.target';
@emit = ();
ok $cmd->execute('core.engine'), 'Get local core.engine';
is_deeply \@emit, [['pg']], 'Should have emitted the local core.engine';
@emit = ();
}
CONTEXT: {
# What happens when there is no config file?
my $config = TestConfig->new;
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'system',
action => 'get',
}), 'Create another system config get command';
ok !-f $cmd->file, 'There should be no system config file';
throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X',
'Should fail when no system config file';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'user',
action => 'get',
}), 'Create another user config get command';
ok !-f $cmd->file, 'There should be no user config file';
throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X',
'Should fail when no user config file';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'local',
action => 'get',
}), 'Create another local config get command';
ok !-f $cmd->file, 'There should be no local config file';
throws_ok { $cmd->execute('core.engine') } 'App::Sqitch::X',
'Should fail when no local config file';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
}
##############################################################################
# Test list().
$config = TestConfig->from(
system => file(qw(t sqitch.conf)),
user => file(qw(t user.conf)),
local => file(qw(t local.conf)),
);
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'list',
}), 'Create config list command';
ok $cmd->execute, 'Execute the list action';
is_deeply \@emit, [[
'bundle.dest_dir=_build/sql
bundle.from=gamma
bundle.tags_only=true
core.engine=pg
core.extension=ddl
core.pager=less -r
core.top_dir=migrations
core.uri=https://github.com/sqitchers/sqitch/
engine.firebird.client=/opt/firebird/bin/isql
engine.firebird.registry=meta
engine.mysql.client=/opt/local/mysql/bin/mysql
engine.mysql.registry=meta
engine.mysql.variables.prefix=foo_
engine.pg.client=/opt/local/pgsql/bin/psql
engine.pg.registry=meta
engine.pg.target=mydb
engine.sqlite.client=/opt/local/bin/sqlite3
engine.sqlite.registry=meta
engine.sqlite.target=devdb
foo.BAR.baz=hello
foo.BAR.yep
guess.Yes.No.calico=false
guess.Yes.No.red=true
revert.count=2
revert.revision=1.1
revert.to=gamma
target.devdb.uri=db:sqlite:
target.mydb.plan_file=t/plans/dependencies.plan
target.mydb.uri=db:pg:mydb
user.email=michael@example.com
user.name=Michael Stonebraker
'
]], 'Should have emitted the merged config';
@emit = ();
CONTEXT: {
$config = TestConfig->from(system => file qw(t sqitch.conf) );
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'system',
action => 'list',
}), 'Create system config list command';
ok $cmd->execute, 'List the system config';
is_deeply \@emit, [[
'bundle.dest_dir=_build/sql
bundle.from=gamma
bundle.tags_only=true
core.engine=pg
core.extension=ddl
core.pager=less -r
core.top_dir=migrations
core.uri=https://github.com/sqitchers/sqitch/
engine.pg.client=/usr/local/pgsql/bin/psql
foo.BAR.baz=hello
foo.BAR.yep
guess.Yes.No.calico=false
guess.Yes.No.red=true
revert.count=2
revert.revision=1.1
revert.to=gamma
'
]], 'Should have emitted the system config list';
@emit = ();
$config = TestConfig->from(
system => file(qw(t sqitch.conf)),
user => file(qw(t user.conf)),
);
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'user',
action => 'list',
}), 'Create user config list command';
ok $cmd->execute, 'List the user config';
is_deeply \@emit, [[
'engine.firebird.client=/opt/firebird/bin/isql
engine.firebird.registry=meta
engine.mysql.client=/opt/local/mysql/bin/mysql
engine.mysql.registry=meta
engine.mysql.variables.prefix=foo_
engine.pg.client=/opt/local/pgsql/bin/psql
engine.pg.registry=meta
engine.pg.target=db:pg://postgres@localhost/thingies
engine.sqlite.client=/opt/local/bin/sqlite3
engine.sqlite.registry=meta
engine.sqlite.target=db:sqlite:my.db
user.email=michael@example.com
user.name=Michael Stonebraker
'
]], 'Should only have emitted the user config list';
@emit = ();
$config = TestConfig->from(
system => file(qw(t sqitch.conf)),
user => file(qw(t user.conf)),
local => file(qw(t local.conf)),
);
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'local',
action => 'list',
}), 'Create local config list command';
ok $cmd->execute, 'List the local config';
is_deeply \@emit, [[
'core.engine=pg
engine.pg.target=mydb
engine.sqlite.target=devdb
target.devdb.uri=db:sqlite:
target.mydb.plan_file=t/plans/dependencies.plan
target.mydb.uri=db:pg:mydb
'
]], 'Should only have emitted the local config list';
@emit = ();
}
# What happens when there is no config file?
$config = TestConfig->from;
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'system',
action => 'list',
}), 'Create system config list command with no file';
ok $cmd->execute, 'List the system config';
is_deeply \@emit, [], 'Nothing should have been emitted';
ok $cmd = $CLASS->new({
sqitch => $sqitch,
context => 'user',
action => 'list',
}), 'Create user config list command with no file';
ok $cmd->execute, 'List the user config';
is_deeply \@emit, [], 'Nothing should have been emitted';
##############################################################################
# Test set().
my $file = 'testconfig.conf';
$mock->mock(file => $file);
END { unlink $file }
ok $cmd = $CLASS->new({
sqitch => $sqitch,
}), 'Create system config set command';
ok $cmd->execute('core.foo' => 'bar'), 'Write core.foo';
is_deeply $config->data_from($cmd->file), {'core.foo' => 'bar' },
'The property should have been written';
# Write another property.
ok $cmd->execute('core.engine' => 'funky'), 'Write core.engine';
is_deeply $config->data_from($cmd->file), {'core.foo' => 'bar', 'core.engine' => 'funky' },
'Both settings should be saved';
# Write a sub-propery.
ok $cmd->execute('engine.pg.user' => 'theory'), 'Write engine.pg.user';
is_deeply $config->data_from($cmd->file), {
'core.foo' => 'bar',
'core.engine' => 'funky',
'engine.pg.user' => 'theory',
}, 'Both sections should be saved';
# Make sure the key is required.
throws_ok { $cmd->set } qr/USAGE/, 'Should set usage for missing set key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing set key should trigger a usage message';
throws_ok { $cmd->set('') } qr/USAGE/, 'Should set usage for invalid set key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid set key should trigger a usage message';
# Make sure the value is required.
throws_ok { $cmd->set('foo.bar') } qr/USAGE/, 'Should set usage for missing set value';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing set value should trigger a usage message';
##############################################################################
# Test add().
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'add',
}), 'Create system config add command';
ok $cmd->execute('core.foo' => 'baz'), 'Add to core.foo';
is_deeply $config->data_from($cmd->file), {
'core.foo' => ['bar', 'baz'],
'core.engine' => 'funky',
'engine.pg.user' => 'theory',
}, 'The value should have been added to the property';
# Make sure the key is required.
throws_ok { $cmd->add } qr/USAGE/, 'Should add usage for missing add key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing add key should trigger a usage message';
throws_ok { $cmd->add('') } qr/USAGE/, 'Should add usage for invalid add key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid add key should trigger a usage message';
# Make sure the value is required.
throws_ok { $cmd->add('foo.bar') } qr/USAGE/, 'Should add usage for missing add value';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing add value should trigger a usage message';
##############################################################################
# Test get with regex.
$config = TestConfig->from(user => $file);
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get',
}), 'Create system config add command';
ok $cmd->execute('core.engine', 'funk'), 'Get core.engine with regex';
is_deeply \@emit, [['funky']], 'Should have emitted value';
@emit = ();
ok $cmd->execute('core.foo', 'z$'), 'Get core.foo with regex';
is_deeply \@emit, [['baz']], 'Should have emitted value';
@emit = ();
throws_ok { $cmd->execute('core.foo', 'x$') } 'App::Sqitch::X',
'Attempt to get core.foo with non-matching regex should fail';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
is_deeply \@emit, [], 'Nothing should have been emitted';
##############################################################################
# Test get_all().
@emit = ();
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
}), 'Create system config get_all command';
ok $cmd->execute('core.engine'), 'Call get_all on core.engine';
is_deeply \@emit, [['funky']], 'The engine should have been emitted';
@emit = ();
ok $cmd->execute('core.engine', 'funk'), 'Get all core.engine with regex';
is_deeply \@emit, [['funky']], 'Should have emitted value';
@emit = ();
ok $cmd->execute('core.foo'), 'Call get_all on core.foo';
is_deeply \@emit, [["bar\nbaz"]], 'Both foos should have been emitted';
@emit = ();
ok $cmd->execute('core.foo', '^ba'), 'Call get_all on core.foo with regex';
is_deeply \@emit, [["bar\nbaz"]], 'Both foos should have been emitted';
@emit = ();
ok $cmd->execute('core.foo', 'z$'), 'Call get_all on core.foo with limiting regex';
is_deeply \@emit, [["baz"]], 'Only the one foo should have been emitted';
@emit = ();
throws_ok { $cmd->execute('core.foo', 'x$') } 'App::Sqitch::X',
'Attempt to get_all core.foo with non-matching regex should fail';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
is_deeply \@emit, [], 'Nothing should have been emitted';
# Make sure the key is required.
throws_ok { $cmd->get_all } qr/USAGE/, 'Should get_all usage for missing get_all key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing get_all key should trigger a usage message';
throws_ok { $cmd->get_all('') } qr/USAGE/, 'Should get_all usage for invalid get_all key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid get_all key should trigger a usage message';
# Make sure int data type works.
$config = TestConfig->from(local => file qw(t sqitch.conf));
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
type => 'int',
}), 'Create config get_all int command';
ok $cmd->execute('revert.count'), 'Get revert.count as int';
is_deeply \@emit, [[2]],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as int';
is_deeply \@emit, [[1]],
'Should have emitted the revert revision as an int';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an int should fail';
is $@->ident, 'config', 'Int cast exception ident should be "config"';
# Make sure num data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
type => 'num',
}), 'Create config get_all num command';
ok $cmd->execute('revert.count'), 'Get revert.count as num';
is_deeply \@emit, [[2]],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as num';
is_deeply \@emit, [[1.1]],
'Should have emitted the revert revision as an num';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an num should fail';
is $@->ident, 'config', 'Num cast exception ident should be "config"';
# Make sure bool data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
type => 'bool',
}), 'Create config get_all bool command';
throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X',
'Should get failure for invalid bool int';
is $@->ident, 'config', 'Bool int cast exception ident should be "config"';
throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X',
'Should get failure for invalid bool num';
is $@->ident, 'config', 'Num int cast exception ident should be "config"';
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool';
is_deeply \@emit, [['true']], 'Should have emitted bundle.tags_only as a bool';
@emit = ();
# Make sure bool-or-int data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_all',
type => 'bool-or-int',
}), 'Create config get_all bool-or-int command';
ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int';
is_deeply \@emit, [[2]],
'Should have emitted the revert count as an int';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int';
is_deeply \@emit, [[1]],
'Should have emitted the revert revision as an int';
@emit = ();
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int';
is_deeply \@emit, [['true']], 'Should have emitted bundle.tags_only as a bool';
@emit = ();
##############################################################################
# Test get_regex().
$config = TestConfig->from(local => $file, user => file qw(t sqitch.conf));
$sqitch = App::Sqitch->new(config => $config);
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_regex',
}), 'Create system config get_regex command';
ok $cmd->execute('core\\..+'), 'Call get_regex on core\\..+';
is_deeply \@emit, [[q{core.engine=funky
core.extension=ddl
core.foo=[bar, baz]
core.pager=less -r
core.top_dir=migrations
core.uri=https://github.com/sqitchers/sqitch/}
]], 'Should match all core options';
@emit = ();
ok $cmd->execute('engine\\.pg\\..+'), 'Call get_regex on engine\\.pg\\..+';
is_deeply \@emit, [[q{engine.pg.client=/usr/local/pgsql/bin/psql
engine.pg.user=theory}
]], 'Should match all engine.pg options';
@emit = ();
ok $cmd->execute('engine\\.pg\\..+', 'theory$'),
'Call get_regex on engine\\.pg\\..+ and value regex';
is_deeply \@emit, [[q{engine.pg.user=theory}
]], 'Should match all engine.pg options that match';
@emit = ();
ok $cmd->execute('foo\\.BAR\\..+', ''),
'Call get_regex on foo\\Bar\\..+ and always-matching regex';
is_deeply \@emit, [[q{foo.BAR.baz=hello
foo.BAR.yep}
]], 'Should include key with no value';
@emit = ();
throws_ok { $cmd->execute('engine\\.pg\\..+', 'x$') } 'App::Sqitch::X',
'Attempt to get_regex engine\\.pg with non-matching regex should fail';
is $@->ident, 'config', 'Error ident should be "config"';
is $@->message, '', 'Error Message should be empty';
is $@->exitval, 1, 'Error exitval should be 1';
is_deeply \@emit, [], 'Nothing should have been emitted';
# Make sure the key is required.
throws_ok { $cmd->get_regex } qr/USAGE/, 'Should get_regex usage for missing get_regex key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing get_regex key should trigger a usage message';
throws_ok { $cmd->get_regex('') } qr/USAGE/, 'Should get_regex usage for invalid get_regex key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid get_regex key should trigger a usage message';
# Make sure int data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_regex',
type => 'int',
}), 'Create config get_regex int command';
ok $cmd->execute('revert.count'), 'Get revert.count as int';
is_deeply \@emit, [['revert.count=2']],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as int';
is_deeply \@emit, [['revert.revision=1']],
'Should have emitted the revert revision as an int';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an int should fail';
is $@->ident, 'config', 'Int cast exception ident should be "config"';
# Make sure num data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_regex',
type => 'num',
}), 'Create config get_regexp num command';
ok $cmd->execute('revert.count'), 'Get revert.count as num';
is_deeply \@emit, [['revert.count=2']],
'Should have emitted the revert count';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as num';
is_deeply \@emit, [['revert.revision=1.1']],
'Should have emitted the revert revision as an num';
@emit = ();
throws_ok { $cmd->execute('bundle.tags_only') } 'App::Sqitch::X',
'Get bundle.tags_only as an num should fail';
is $@->ident, 'config', 'Num cast exception ident should be "config"';
# Make sure bool data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_regex',
type => 'bool',
}), 'Create config get_regex bool command';
throws_ok { $cmd->execute('revert.count') } 'App::Sqitch::X',
'Should get failure for invalid bool int';
is $@->ident, 'config', 'Bool int cast exception ident should be "config"';
throws_ok { $cmd->execute('revert.revision') } 'App::Sqitch::X',
'Should get failure for invalid bool num';
is $@->ident, 'config', 'Num int cast exception ident should be "config"';
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool';
is_deeply \@emit, [['bundle.tags_only=true']],
'Should have emitted bundle.tags_only as a bool';
@emit = ();
# Make sure int data type works.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'get_regex',
type => 'bool-or-int',
}), 'Create config get_regex bool-or-int command';
ok $cmd->execute('revert.count'), 'Get revert.count as bool-or-int';
is_deeply \@emit, [['revert.count=2']],
'Should have emitted the revert count as an int';
@emit = ();
ok $cmd->execute('revert.revision'), 'Get revert.revision as bool-or-int';
is_deeply \@emit, [['revert.revision=1']],
'Should have emitted the revert revision as an int';
@emit = ();
ok $cmd->execute('bundle.tags_only'), 'Get bundle.tags_only as bool-or-int';
is_deeply \@emit, [['bundle.tags_only=true']],
'Should have emitted bundle.tags_only as a bool';
@emit = ();
##############################################################################
# Test unset().
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'unset',
}), 'Create system config unset command';
ok $cmd->execute('engine.pg.user'), 'Unset engine.pg.user';
is_deeply $config->data_from($cmd->file), {
'core.foo' => ['bar', 'baz'],
'core.engine' => 'funky',
}, 'engine.pg.user should be gone';
ok $cmd->execute('core.engine'), 'Unset core.engine';
is_deeply $config->data_from($cmd->file), {
'core.foo' => ['bar', 'baz'],
}, 'core.engine should have been removed';
throws_ok { $cmd->execute('core.foo') } 'App::Sqitch::X',
'Should get failure trying to delete multivalue key';
is $@->ident, 'config', 'Multiple value exception ident should be "config"';
is $@->message, __ 'Cannot unset key with multiple values',
'And it should have the proper error message';
ok $cmd->execute('core.foo', 'z$'), 'Unset core.foo with a regex';
is_deeply $config->data_from($cmd->file), {
'core.foo' => 'bar',
}, 'The core.foo "baz" value should have been removed';
# Make sure the key is required.
throws_ok { $cmd->unset } qr/USAGE/, 'Should unset usage for missing unset key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing unset key should trigger a usage message';
throws_ok { $cmd->unset('') } qr/USAGE/, 'Should unset usage for invalid unset key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid unset key should trigger a usage message';
##############################################################################
# Test unset_all().
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'unset_all',
}), 'Create system config unset_all command';
$cmd->add('core.foo', 'baz');
ok $cmd->execute('core.foo'), 'unset_all core.foo';
is_deeply $config->data_from($cmd->file), {}, 'core.foo should have been removed';
# Test handling of multiple value.
$cmd->add('core.foo', 'bar');
$cmd->add('core.foo', 'baz');
$cmd->add('core.foo', 'yo');
ok $cmd->execute('core.foo', '^ba'), 'unset_all core.foo with regex';
is_deeply $config->data_from($cmd->file), {
'core.foo' => 'yo',
}, 'core.foo should have one value left';
# Make sure the key is required.
throws_ok { $cmd->unset_all } qr/USAGE/, 'Should unset_all usage for missing unset_all key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the missing unset_all key should trigger a usage message';
throws_ok { $cmd->unset_all('') } qr/USAGE/, 'Should unset_all usage for invalid unset_all key';
is_deeply \@usage, ['Wrong number of arguments.'],
'And the invalid unset_all key should trigger a usage message';
##############################################################################
# Test replace_all.
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'replace_all',
}), 'Create system config replace_all command';
$cmd->add('core.bar', 'bar');
$cmd->add('core.bar', 'baz');
$cmd->add('core.bar', 'yo');
ok $cmd->execute('core.bar', 'hi'), 'Replace all core.bar';
is_deeply $config->data_from($cmd->file), {
'core.bar' => 'hi',
'core.foo' => 'yo',
}, 'core.bar should have all its values with one value';
$cmd->add('core.foo', 'bar');
$cmd->add('core.foo', 'baz');
ok $cmd->execute('core.foo', 'ba', '^ba'), 'Replace all core.bar matching /^ba/';
is_deeply $config->data_from($cmd->file), {
'core.bar' => 'hi',
'core.foo' => ['yo', 'ba'],
}, 'core.foo should have had the matching values replaced';
# Clean up.
$cmd->unset_all('core.bar');
$cmd->unset('core.foo', 'ba');
##############################################################################
# Test rename_section().
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'rename_section',
}), 'Create system config rename_section command';
ok $cmd->execute('core', 'funk'), 'Rename "core" to "funk"';
is_deeply $config->data_from($cmd->file), {
'funk.foo' => 'yo',
}, 'core.foo should have become funk.foo';
throws_ok { $cmd->execute('foo') } qr/USAGE/, 'Should fail with no new name';
is_deeply \@usage, ['Wrong number of arguments.'],
'Message should be in the usage call';
throws_ok { $cmd->execute('', 'bar') } qr/USAGE/, 'Should fail with bad old name';
is_deeply \@usage, ['Wrong number of arguments.'],
'Message should be in the usage call';
throws_ok { $cmd->execute('baz', '') } qr/USAGE/, 'Should fail with bad new name';
is_deeply \@usage, ['Wrong number of arguments.'],
'Message should be in the usage call';
throws_ok { $cmd->execute('foo', 'bar') } 'App::Sqitch::X',
'Should fail with invalid section';
is $@->ident, 'config', 'Invalid section exception ident should be "config"';
is $@->message, __ 'No such section!',
'Invalid section exception message should be set';
##############################################################################
# Test remove_section().
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'remove_section',
}), 'Create system config remove_section command';
ok $cmd->execute('funk'), 'Remove "func" section';
is_deeply $config->data_from($cmd->file), {},
'The "funk" section should be gone';
throws_ok { $cmd->execute() } qr/USAGE/, 'Should fail with no name';
is_deeply \@usage, ['Wrong number of arguments.'],
'Message should be in the usage call';
throws_ok { $cmd->execute('bar') } 'App::Sqitch::X',
'Should fail with invalid name';
is $@->ident, 'config', 'Invalid key name exception ident should be "config"';
is $@->message, __ 'No such section!', 'And the invalid key message should be set';
##############################################################################
# Test errors with multiple values.
throws_ok { $cmd->get('core.foo', '.') } 'App::Sqitch::X',
'Should fail fetching multi-value key';
is $@->ident, 'config', 'Multi-value key exception ident should be "config"';
is $@->message, __x(
'More then one value for the key "{key}"',
key => 'core.foo',
), 'The multiple value error should be thrown';
$cmd->add('core.foo', 'hi');
$cmd->add('core.foo', 'bye');
throws_ok { $cmd->set('core.foo', 'hi') } 'App::Sqitch::X',
'Should fail setting multi-value key';
is $@->ident, 'config', 'Multi-value key exception ident should be "config"';
is $@->message, __('Cannot overwrite multiple values with a single value'),
'The multi-value key error should be thrown';
SETERR: {
my $mock_cfg = TestConfig->mock(
set => sub { die 'XXX' },
rename_section => sub { die 'YYY' },
remove_section => sub { die 'ZZZ' },
);
throws_ok { $cmd->set('core.xxx', 'hi') } 'App::Sqitch::X',
'Set should fail on App::Sqitch::Cofig error';
is $@->ident, 'config', 'Set exception ident should be "config"';
like $@->message, qr/^XXX/,
'Config set exception message should propagate';
throws_ok { $cmd->unset('core.foo') } 'App::Sqitch::X',
'Unset should fail on App::Sqitch::Cofig error';
is $@->ident, 'config', 'Unset exception ident should be "config"';
like $@->message, qr/^XXX/,
'Config set exception message should propagate';
throws_ok { $cmd->rename_section('core.foo', 'core.bar') } 'App::Sqitch::X',
'Rename should fail on App::Sqitch::Cofig error';
is $@->ident, 'config', 'Rename exception ident should be "config"';
like $@->message, qr/^YYY/,
'Config rename exception message should propagate';
throws_ok { $cmd->remove_section('core') } 'App::Sqitch::X',
'Remove should fail on App::Sqitch::Cofig error';
is $@->ident, 'config', 'Remove exception ident should be "config"';
like $@->message, qr/^ZZZ/,
'Config remove exception message should propagate';
}
##############################################################################
# Test edit().
my $shell;
my $ret = 1;
$mock->mock(shell => sub { $shell = $_[1]; return $ret });
ok $cmd = $CLASS->new({
sqitch => $sqitch,
action => 'edit',
}), 'Create system config edit command';
ok $cmd->execute, 'Execute the edit comand';
is $shell, $sqitch->editor . ' ' . $sqitch->quote_shell($cmd->file),
'The editor should have been run';
##############################################################################
# Make sure we can write to a file in a directory.
my $path = file qw(t config.tmp test.conf);
$mock->mock(file => $path);
END { remove_tree +File::Spec->catdir(qw(t config.tmp)) }
ok $sqitch = App::Sqitch->new, 'Load a new sqitch object';
ok $cmd = $CLASS->new({
sqitch => $sqitch,
}), 'Create system config set command with subdirectory config file path';
ok $cmd->execute('my.foo', 'hi'), 'Set "my.foo" in subdirectory config file';
is_deeply $config->data_from($cmd->file), {'my.foo' => 'hi' },
'The file should have been written';
pragma.t 100644 001751 000166 2557 15004170404 15606 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 10;
#use Test::More 'no_plan';
use Test::NoWarnings;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan::Pragma';
require_ok $CLASS or die;
}
can_ok $CLASS, qw(
name
lspace
rspace
hspace
ropspace
lopspace
note
plan
value
);
my $config = TestConfig->new('core.engine' => 'sqlite');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
isa_ok my $dir = $CLASS->new(
name => 'foo',
plan => $plan,
), $CLASS;
isa_ok $dir, 'App::Sqitch::Plan::Line';
is $dir->format_name, '%foo', 'Name should format as "%foo"';
is $dir->format_value, '', 'Value should format as ""';
is $dir->as_string, '%foo', 'should stringify to "%foo"';
ok $dir = $CLASS->new(
name => 'howdy',
value => 'woody',
plan => $plan,
lspace => ' ',
hspace => ' ',
rspace => "\t",
lopspace => ' ',
operator => '=',
ropspace => ' ',
note => 'blah blah blah',
), 'Create pragma with more stuff';
is $dir->as_string, " % howdy = woody\t# blah blah blah",
'It should stringify correctly';
status.t 100644 001751 000166 53137 15004170404 15702 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 124;
#use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use Test::Warn;
use Test::MockModule;
use Path::Class;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::status';
require_ok $CLASS;
local $ENV{TZ} = 'America/Barbados';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => 'test-status',
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch object';
isa_ok my $status = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'status',
config => $config,
}), $CLASS, 'status command';
can_ok $status, qw(
project
show_changes
show_tags
date_format
options
execute
configure
emit_state
emit_changes
emit_tags
emit_status
does
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(ContextCommand ConnectingCommand);
is_deeply [ $CLASS->options ], [qw(
project=s
target|t=s
show-tags
show-changes
date-format|date=s
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my @projs;
$engine_mocker->mock( registered_projects => sub { @projs });
my $initialized;
$engine_mocker->mock( initialized => sub {
diag "Gonna return $initialized" if $ENV{RELEASE_TESTING};
$initialized;
} );
my $mock_target = Test::MockModule->new('App::Sqitch::Target');
my ($target, $orig_new);
$mock_target->mock(new => sub { $target = shift->$orig_new(@_); });
$orig_new = $mock_target->original('new');
# Start with uninitialized database.
$initialized = 0;
##############################################################################
# Test project.
$status->target($status->default_target);
throws_ok { $status->project } 'App::Sqitch::X',
'Should have error for uninitialized database';
is $@->ident, 'status', 'Uninitialized database error ident should be "status"';
is $@->message, __(
'Database not initialized for Sqitch'
), 'Uninitialized database error message should be correct';
# Specify a project.
isa_ok $status = $CLASS->new(
sqitch => $sqitch,
project => 'foo',
), $CLASS, 'new status command';
is $status->project, 'foo', 'Should have project "foo"';
# Look up the project in the database.
ok $sqitch = App::Sqitch->new( config => $config),
'Load a sqitch object with SQLite';
ok $status = $CLASS->new(sqitch => $sqitch), 'Create another status command';
$status->target($status->default_target);
throws_ok { $status->project } 'App::Sqitch::X',
'Should get an error for uninitialized db';
is $@->ident, 'status', 'Uninitialized db error ident should be "status"';
is $@->message, __ 'Database not initialized for Sqitch',
'Uninitialized db error message should be correct';
# Try no registered projects.
$initialized = 1;
throws_ok { $status->project } 'App::Sqitch::X',
'Should get an error for no registered projects';
is $@->ident, 'status', 'No projects error ident should be "status"';
is $@->message, __ 'No projects registered',
'No projects error message should be correct';
# Try too many registered projects.
@projs = qw(foo bar);
throws_ok { $status->project } 'App::Sqitch::X',
'Should get an error for too many projects';
is $@->ident, 'status', 'Too many projects error ident should be "status"';
is $@->message, __x(
'Use --project to select which project to query: {projects}',
projects => join __ ', ', @projs,
), 'Too many projects error message should be correct';
# Go for one project.
@projs = ('status');
is $status->project, 'status', 'Should find single project';
$engine_mocker->unmock_all;
# Fall back on plan project name.
ok $sqitch = App::Sqitch->new(config => TestConfig->new(
'core.top_dir' => dir(qw(t sql))->stringify,
));
isa_ok $status = $CLASS->new( sqitch => $sqitch ), $CLASS,
'another status command';
$status->target($status->default_target);
is $status->project, $target->plan->project, 'Should have plan project';
##############################################################################
# Test database.
is $status->target_name, undef, 'Default target should be undef';
isa_ok $status = $CLASS->new(
sqitch => $sqitch,
target_name => 'foo',
), $CLASS, 'new status with target';
is $status->target_name, 'foo', 'Should have target "foo"';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {_params => [], _cx => []},
'Should get empty hash for no config or options';
$config->update('status.date_format' => 'nonesuch');
throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X',
'Should get error for invalid date format in config';
is $@->ident, 'datetime',
'Invalid date format error ident should be "datetime"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'nonesuch',
), 'Invalid date format error message should be correct';
$config->replace(
'status.show_changes' => 1,
'status.show_tags' => 0,
);
is_deeply $CLASS->configure($config, {}), {
show_changes => 1,
show_tags => 0,
_params => [],
_cx => [],
}, 'Should get bool values set from config';
throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} }
'App::Sqitch::X',
'Should get error for invalid date format in optsions';
is $@->ident, 'datetime',
'Invalid date format error ident should be "status"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'non',
), 'Invalid date format error message should be correct';
##############################################################################
# Test emit_state().
my $dt = App::Sqitch::DateTime->new(
year => 2012,
month => 7,
day => 7,
hour => 16,
minute => 12,
second => 47,
time_zone => 'America/Denver',
);
my $state = {
project => 'mystatus',
change_id => 'someid',
change => 'widgets_table',
committer_name => 'fred',
committer_email => 'fred@example.com',
committed_at => $dt->clone,
tags => [],
planner_name => 'barney',
planner_email => 'barney@example.com',
planned_at => $dt->clone->subtract(days => 2),
};
$dt->set_time_zone('local');
my $ts = $dt->as_string( format => $status->date_format );
ok $status->emit_state($state), 'Emit the state';
is_deeply +MockOutput->get_comment, [
[__x 'Project: {project}', project => 'mystatus'],
[__x 'Change: {change_id}', change_id => 'someid'],
[__x 'Name: {change}', change => 'widgets_table'],
[__x 'Deployed: {date}', date => $ts],
[__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ],
], 'The state should have been emitted';
# Try with a tag.
$state-> {tags} = ['@alpha'];
ok $status->emit_state($state), 'Emit the state with a tag';
is_deeply +MockOutput->get_comment, [
[__x 'Project: {project}', project => 'mystatus'],
[__x 'Change: {change_id}', change_id => 'someid'],
[__x 'Name: {change}', change => 'widgets_table'],
[__nx 'Tag: {tags}', 'Tags: {tags}', 1, tags => '@alpha'],
[__x 'Deployed: {date}', date => $ts],
[__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ],
], 'The state should have been emitted with a tag';
# Try with mulitple tags.
$state-> {tags} = ['@alpha', '@beta', '@gamma'];
ok $status->emit_state($state), 'Emit the state with multiple tags';
is_deeply +MockOutput->get_comment, [
[__x 'Project: {project}', project => 'mystatus'],
[__x 'Change: {change_id}', change_id => 'someid'],
[__x 'Name: {change}', change => 'widgets_table'],
[__nx 'Tag: {tags}', 'Tags: {tags}', 3,
tags => join(__ ', ', qw(@alpha @beta @gamma))],
[__x 'Deployed: {date}', date => $ts],
[__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com' ],
], 'The state should have been emitted with multiple tags';
##############################################################################
# Test emit_changes().
my @current_changes;
my $project;
$engine_mocker->mock(current_changes => sub {
$project = $_[1];
sub { shift @current_changes };
});
@current_changes = ({
change_id => 'someid',
change => 'foo',
committer_name => 'anna',
committer_email => 'anna@example.com',
committed_at => $dt,
planner_name => 'anna',
planner_email => 'anna@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
});
$config->replace('core.engine' => 'sqlite');
$sqitch = App::Sqitch->new(config => $config);
ok $status = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'status',
config => $config,
}), 'Create status command with an engine';
ok $status->emit_changes, 'Try to emit changes';
is_deeply +MockOutput->get_comment, [],
'Should have emitted no changes';
ok $status = App::Sqitch::Command::status->new(
sqitch => $sqitch,
show_changes => 1,
project => 'foo',
), 'Create change-showing status command';
$status->target($status->default_target);
ok $status->emit_changes, 'Emit changes again';
is $project, 'foo', 'Project "foo" should have been passed to current_changes';
is_deeply +MockOutput->get_comment, [
[''],
[__n 'Change:', 'Changes:', 1],
[" foo - $ts - anna "],
], 'Should have emitted one change';
# Add a couple more changes.
@current_changes = (
{
change_id => 'someid',
change => 'foo',
committer_name => 'anna',
committer_email => 'anna@example.com',
committed_at => $dt,
planner_name => 'anna',
planner_email => 'anna@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
{
change_id => 'anid',
change => 'blech',
committer_name => 'david',
committer_email => 'david@example.com',
committed_at => $dt,
planner_name => 'david',
planner_email => 'david@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
{
change_id => 'anotherid',
change => 'long_name',
committer_name => 'julie',
committer_email => 'julie@example.com',
committed_at => $dt,
planner_name => 'julie',
planner_email => 'julie@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
);
ok $status->emit_changes, 'Emit changes thrice';
is $project, 'foo',
'Project "foo" again should have been passed to current_changes';
is_deeply +MockOutput->get_comment, [
[''],
[__n 'Change:', 'Changes:', 3],
[" foo - $ts - anna "],
[" blech - $ts - david "],
[" long_name - $ts - julie "],
], 'Should have emitted three changes';
##############################################################################
# Test emit_tags().
my @current_tags;
$engine_mocker->mock(current_tags => sub {
$project = $_[1];
sub { shift @current_tags };
});
ok $status->emit_tags, 'Try to emit tags';
is_deeply +MockOutput->get_comment, [], 'No tags should have been emitted';
ok $status = App::Sqitch::Command::status->new(
sqitch => $sqitch,
show_tags => 1,
project => 'bar',
), 'Create tag-showing status command';
$status->target($status->default_target);
# Try with no tags.
ok $status->emit_tags, 'Try to emit tags again';
is $project, 'bar', 'Project "bar" should be passed to current_tags()';
is_deeply +MockOutput->get_comment, [
[''],
[__ 'Tags: None.'],
], 'Should have emitted a header for no tags';
@current_tags = ({
tag_id => 'tagid',
tag => '@alpha',
committer_name => 'duncan',
committer_email => 'duncan@example.com',
committed_at => $dt,
planner_name => 'duncan',
planner_email => 'duncan@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
});
ok $status->emit_tags, 'Emit tags';
is $project, 'bar', 'Project "bar" should again be passed to current_tags()';
is_deeply +MockOutput->get_comment, [
[''],
[__n 'Tag:', 'Tags:', 1],
[" \@alpha - $ts - duncan "],
], 'Should have emitted one tag';
# Add a couple more tags.
@current_tags = (
{
tag_id => 'tagid',
tag => '@alpha',
committer_name => 'duncan',
committer_email => 'duncan@example.com',
committed_at => $dt,
planner_name => 'duncan',
planner_email => 'duncan@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
{
tag_id => 'myid',
tag => '@beta',
committer_name => 'nick',
committer_email => 'nick@example.com',
committed_at => $dt,
planner_name => 'nick',
planner_email => 'nick@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
{
tag_id => 'yourid',
tag => '@gamma',
committer_name => 'jacqueline',
committer_email => 'jacqueline@example.com',
committed_at => $dt,
planner_name => 'jacqueline',
planner_email => 'jacqueline@example.com',
planned_at => $dt->clone->subtract( hours => 4 ),
},
);
ok $status->emit_tags, 'Emit tags again';
is $project, 'bar', 'Project "bar" should once more be passed to current_tags()';
is_deeply +MockOutput->get_comment, [
[''],
[__n 'Tag:', 'Tags:', 3],
[" \@alpha - $ts - duncan "],
[" \@beta - $ts - nick "],
[" \@gamma - $ts - jacqueline "],
], 'Should have emitted all three tags';
##############################################################################
# Test emit_status().
my $file = file qw(t plans multi.plan);
$config->update('core.plan_file' => $file->stringify);
$sqitch = App::Sqitch->new(config => $config);
ok $status = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'status',
config => $config,
}), 'Create status command with actual plan command';
$status->target($target = $status->default_target);
my @changes = $target->plan->changes;
# Start with an up-to-date state.
$state->{change_id} = $changes[-1]->id;
ok $status->emit_status($state), 'Emit status';
is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line';
is_deeply +MockOutput->get_emit, [
[__ 'Nothing to deploy (up-to-date)'],
], 'Should emit up-to-date output';
# Start with second-to-last change.
$state->{change_id} = $changes[2]->id;
ok $status->emit_status($state), 'Emit status again';
is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line';
is_deeply +MockOutput->get_emit, [
[__n 'Undeployed change:', 'Undeployed changes:', 1],
[' * ', $changes[3]->format_name_with_tags],
], 'Should emit list of undeployed changes';
# Start with second step.
$state->{change_id} = $changes[1]->id;
ok $status->emit_status($state), 'Emit status thrice';
is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line';
is_deeply +MockOutput->get_emit, [
[__n 'Undeployed change:', 'Undeployed changes:', 2],
map { [' * ', $_->format_name_with_tags] } @changes[2..$#changes],
], 'Should emit list of undeployed changes';
# Now go for an ID that cannot be found.
$state->{change_id} = 'nonesuchid';
throws_ok { $status->emit_status($state) } 'App::Sqitch::X', 'Die on invalid ID';
is $@->ident, 'status', 'Invalid ID error ident should be "status"';
is $@->message, __ 'Make sure you are connected to the proper database for this project.',
'The invalid ID error message should be correct';
is_deeply +MockOutput->get_comment, [['']], 'Should have a blank comment line';
is_deeply +MockOutput->get_vent, [
[__x 'Cannot find this change in {file}', file => $file],
], 'Should have a message about inability to find the change';
##############################################################################
# Test execute().
my ($target_name_arg, $orig_meth);
$target_name_arg = '_blah';
$mock_target->mock(new => sub {
my $self = shift;
my %p = @_;
$target_name_arg = $p{name};
$self->$orig_meth(@_);
});
$orig_meth = $mock_target->original('new');
ok $status = App::Sqitch::Command::status->new(
sqitch => $sqitch,
config => $config,
), 'Recreate status command';
my $check_output = sub {
local $Test::Builder::Level = $Test::Builder::Level + 1;
is_deeply +MockOutput->get_comment, [
[__x 'On database {db}', db => $target->engine->destination ],
[__x 'Project: {project}', project => 'mystatus'],
[__x 'Change: {change_id}', change_id => $state->{change_id}],
[__x 'Name: {change}', change => 'widgets_table'],
[__nx 'Tag: {tags}', 'Tags: {tags}', 3,
tags => join(__ ', ', qw(@alpha @beta @gamma))],
[__x 'Deployed: {date}', date => $ts],
[__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com'],
[''],
], 'The state should have been emitted';
is_deeply +MockOutput->get_emit, [
[__n 'Undeployed change:', 'Undeployed changes:', 2],
map { [' * ', $_->format_name_with_tags] } @changes[2..$#changes],
], 'Should emit list of undeployed changes';
};
$state->{change_id} = $changes[1]->id;
$engine_mocker->mock( current_state => $state );
ok $status->execute, 'Execute';
$check_output->();
is $target_name_arg, undef, 'No target name should have been passed to Target';
# Test with a database argument.
ok $status->execute('db:sqlite:'), 'Execute with target arg';
$check_output->();
is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target';
# Pass the target in an option.
ok $status = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'status',
config => $config,
args => ['--target', 'db:sqlite:'],
}), 'Create status command with a target option';
ok $status->execute, 'Execute with target attribute';
$check_output->();
is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target';
# Test with two targets.
ok $status->execute('db:pg:'), 'Execute with target attribute and arg';
$check_output->();
is $target_name_arg, 'db:pg:', 'Name "db:sqlite:" should have been passed to Target';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => $status->target_name,
)]], 'Should have got warning for two targets';
# Test with a plan file param and no option.
ok $status = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'status',
config => $config,
}), 'Create status command with no target option';
ok $status->execute($file), 'Execute with plan file';
$check_output->();
is $target_name_arg, 'db:sqlite:', 'Name "db:sqlite:" should have been passed to Target';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Test with unknown plan.
for my $spec (
[ 'specified', App::Sqitch->new(config => $config) ],
[ 'external', $sqitch ],
) {
my ( $desc, $sqitch ) = @{ $spec };
ok $status = $CLASS->new(
sqitch => $sqitch,
project => 'foo',
), "Create status command with $desc project";
ok $status->execute, "Execute for $desc project";
is_deeply +MockOutput->get_comment, [
[__x 'On database {db}', db => $target->engine->destination ],
[__x 'Project: {project}', project => 'mystatus'],
[__x 'Change: {change_id}', change_id => $state->{change_id}],
[__x 'Name: {change}', change => 'widgets_table'],
[__nx 'Tag: {tags}', 'Tags: {tags}', 3,
tags => join(__ ', ', qw(@alpha @beta @gamma))],
[__x 'Deployed: {date}', date => $ts],
[__x 'By: {name} <{email}>', name => 'fred', email => 'fred@example.com'],
[''],
], "The $desc project state should have been emitted";
is_deeply +MockOutput->get_emit, [
[__x 'Status unknown. Use --plan-file to assess "{project}" status', project => 'foo'],
], "Should emit unknown status message for $desc project";
}
# Test with no changes.
$engine_mocker->mock( current_state => undef );
throws_ok { $status->execute } 'App::Sqitch::X', 'Die on no state';
is $@->ident, 'status', 'No state error ident should be "status"';
is $@->message, __ 'No changes deployed',
'No state error message should be correct';
is_deeply +MockOutput->get_comment, [
[__x 'On database {db}', db => $target->engine->destination ],
], 'The "On database" comment should have been emitted';
# Test with no initilization.
$initialized = 0;
$engine_mocker->mock( initialized => sub { $initialized } );
$engine_mocker->mock( current_state => sub { die 'No Sqitch tables' } );
throws_ok { $status->execute } 'App::Sqitch::X',
'Should get an error for uninitialized db';
is $@->ident, 'status', 'Uninitialized db error ident should be "status"';
is $@->message, __x(
'Database {db} has not been initialized for Sqitch',
db => $status->engine->destination,
), 'Uninitialized db error message should be correct';
change.t 100644 001751 000166 35370 15004170404 15603 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 92;
#use Test::More 'no_plan';
use Test::NoWarnings;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use App::Sqitch::Plan::Tag;
use Encode qw(encode_utf8);
use Locale::TextDomain qw(App-Sqitch);
use Test::Exception;
use Path::Class;
use File::Path qw(make_path remove_tree);
use Digest::SHA;
use Test::MockModule;
use URI;
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan::Change';
require_ok $CLASS or die;
}
can_ok $CLASS, qw(
name
info
id
lspace
rspace
note
parent
since_tag
rework_tags
add_rework_tags
is_reworked
tags
add_tag
plan
deploy_dir
deploy_file
script_hash
revert_dir
revert_file
revert_dir
verify_file
requires
conflicts
timestamp
planner_name
planner_email
format_name
format_dependencies
format_name_with_tags
format_tag_qualified_name
format_name_with_dependencies
format_op_name_dependencies
format_planner
note_prompt
);
my $sqitch = App::Sqitch->new(
config => TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir('test-change')->stringify,
),
);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
reworked_dir => dir('test-change/reworked'),
);
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
make_path 'test-change';
END { remove_tree 'test-change' };
my $fn = $target->plan_file;
open my $fh, '>', $fn or die "Cannot open $fn: $!";
say $fh "%project=change\n\n";
close $fh or die "Error closing $fn: $!";
isa_ok my $change = $CLASS->new(
name => 'foo',
plan => $plan,
), $CLASS;
isa_ok $change, 'App::Sqitch::Plan::Line';
ok $change->is_deploy, 'It should be a deploy change';
ok !$change->is_revert, 'It should not be a revert change';
is $change->action, 'deploy', 'And it should say so';
isa_ok $change->timestamp, 'App::Sqitch::DateTime', 'Timestamp';
my $tag = App::Sqitch::Plan::Tag->new(
plan => $plan,
name => 'alpha',
change => $change,
);
is_deeply [ $change->path_segments ], ['foo.sql'],
'path_segments should have the file name';
is $change->deploy_dir, $target->deploy_dir,
'The deploy dir should be correct';
is $change->deploy_file, $target->deploy_dir->file('foo.sql'),
'The deploy file should be correct';
is $change->revert_dir, $target->revert_dir,
'The revert dir should be correct';
is $change->revert_file, $target->revert_dir->file('foo.sql'),
'The revert file should be correct';
is $change->verify_dir, $target->verify_dir,
'The verify dir should be correct';
is $change->verify_file, $target->verify_dir->file('foo.sql'),
'The verify file should be correct';
ok !$change->is_reworked, 'The change should not be reworked';
is_deeply [ $change->path_segments ], ['foo.sql'],
'path_segments should not include suffix';
# Test script_hash.
is $change->script_hash, undef,
'Nonexistent deploy script hash should be undef';
make_path $change->deploy_dir->stringify;
$change->deploy_file->spew(iomode => '>:raw', encode_utf8 "Foo\nBar\nBøz\n亜唖娃阿" );
$change = $CLASS->new( name => 'foo', plan => $plan );
is $change->script_hash, 'd48866b846300912570f643c99b2ceec4ba29f5c',
'Deploy script hash should be correct';
is $change->format_tag_qualified_name, 'foo@HEAD',
'Tag-qualified name should be tagged with @HEAD';
# Identify it as reworked.
ok $change->add_rework_tags($tag), 'Add a rework tag';
is_deeply [$change->rework_tags], [$tag], 'Reworked tag should be stored';
ok $change->is_reworked, 'The change should be reworked';
$change->deploy_dir->mkpath;
$change->deploy_dir->file('foo@alpha.sql')->touch;
is_deeply [ $change->path_segments ], ['foo@alpha.sql'],
'path_segments should now include suffix';
# Make sure all rework tags are searched.
$change->clear_rework_tags;
ok !$change->is_reworked, 'The change should not be reworked';
my $tag2 = App::Sqitch::Plan::Tag->new(
plan => $plan,
name => 'beta',
change => $change,
);
ok $change->add_rework_tags($tag2, $tag), 'Add two rework tags';
ok $change->is_reworked, 'The change should again be reworked';
is_deeply [ $change->path_segments ], ['foo@alpha.sql'],
'path_segments should now include the correct suffixc';
is $change->format_name, 'foo', 'Name should format as "foo"';
is $change->format_name_with_tags, 'foo',
'Name should format with tags as "foo"';
is $change->format_tag_qualified_name, 'foo@beta',
'Tag-qualified Name should format as "foo@beta"';
is $change->format_dependencies, '', 'Dependencies should format as ""';
is $change->format_name_with_dependencies, 'foo',
'Name should format with dependencies as "foo"';
is $change->format_op_name_dependencies, 'foo',
'Name should format op without dependencies as "foo"';
is $change->format_content, 'foo ' . $change->timestamp->as_string
. ' ' . $change->format_planner,
'Change content should format correctly without dependencies';
is $change->planner_name, $sqitch->user_name,
'Planner name shoudld default to user name';
is $change->planner_email, $sqitch->user_email,
'Planner email shoudld default to user email';
is $change->format_planner, join(
' ',
$sqitch->user_name,
'<' . $sqitch->user_email . '>'
), 'Planner name and email should format properly';
my $ts = $change->timestamp->as_string;
is $change->as_string, "foo $ts " . $change->format_planner,
'should stringify to "foo" + planner';
is $change->since_tag, undef, 'Since tag should be undef';
is $change->parent, undef, 'Parent should be undef';
is $change->info, join("\n",
'project change',
'change foo',
'planner ' . $change->format_planner,
'date ' . $change->timestamp->as_string,
), 'Change info should be correct';
is $change->id, do {
my $content = encode_utf8 $change->info;
Digest::SHA->new(1)->add(
'change ' . length($content) . "\0" . $content
)->hexdigest;
},'Change ID should be correct';
my $date = App::Sqitch::DateTime->new(
year => 2012,
month => 7,
day => 16,
hour => 17,
minute => 25,
second => 7,
time_zone => 'UTC',
);
sub dep($) {
App::Sqitch::Plan::Depend->new(
%{ App::Sqitch::Plan::Depend->parse(shift) },
plan => $target->plan,
project => 'change',
)
}
ok my $change2 = $CLASS->new(
name => 'yo/howdy',
plan => $plan,
since_tag => $tag,
parent => $change,
lspace => ' ',
operator => '-',
ropspace => ' ',
rspace => "\t",
suffix => '@beta',
note => 'blah blah blah ',
pspace => ' ',
requires => [map { dep $_ } qw(foo bar @baz)],
conflicts => [dep '!dr_evil'],
timestamp => $date,
planner_name => 'Barack Obama',
planner_email => 'potus@whitehouse.gov',
), 'Create change with more stuff';
my $ts2 = '2012-07-16T17:25:07Z';
is $change2->as_string, " - yo/howdy [foo bar \@baz !dr_evil] "
. "$ts2 Barack Obama \t# blah blah blah",
'It should stringify correctly';
my $mock_plan = Test::MockModule->new(ref $plan);
$mock_plan->mock(index_of => 0);
my $uri = URI->new('https://github.com/sqitchers/sqitch/');
$mock_plan->mock( uri => $uri );
ok !$change2->is_deploy, 'It should not be a deploy change';
ok $change2->is_revert, 'It should be a revert change';
is $change2->action, 'revert', 'It should say so';
is $change2->since_tag, $tag, 'It should have a since tag';
is $change2->parent, $change, 'It should have a parent';
is $change2->info, join("\n",
'project change',
'uri https://github.com/sqitchers/sqitch/',
'change yo/howdy',
'parent ' . $change->id,
'planner Barack Obama ',
'date 2012-07-16T17:25:07Z',
'requires',
' + foo',
' + bar',
' + @baz',
'conflicts',
' - dr_evil',
'', 'blah blah blah'
), 'Info should include parent and dependencies';
# Check tags.
is_deeply [$change2->tags], [], 'Should have no tags';
ok $change2->add_tag($tag), 'Add a tag';
is_deeply [$change2->tags], [$tag], 'Should have the tag';
is $change2->format_name_with_tags, 'yo/howdy @alpha',
'Should format name with tags';
is $change2->format_tag_qualified_name, 'yo/howdy@alpha',
'Should format tag-qualiified name';
# Add another tag.
ok $change2->add_tag($tag2), 'Add another tag';
is_deeply [$change2->tags], [$tag, $tag2], 'Should have both tags';
is $change2->format_name_with_tags, 'yo/howdy @alpha @beta',
'Should format name with both tags';
is $change2->format_tag_qualified_name, 'yo/howdy@alpha',
'Should format tag-qualified name with first tag';
is $change2->format_planner, 'Barack Obama ',
'Planner name and email should format properly';
is $change2->format_dependencies, '[foo bar @baz !dr_evil]',
'Dependencies should format as "[foo bar @baz !dr_evil]"';
is $change2->format_name_with_dependencies, 'yo/howdy [foo bar @baz !dr_evil]',
'Name should format with dependencies as "yo/howdy [foo bar @baz !dr_evil]"';
is $change2->format_op_name_dependencies, '- yo/howdy [foo bar @baz !dr_evil]',
'Name should format op with dependencies as "yo/howdy [foo bar @baz !dr_evil]"';
is $change2->format_content, '- yo/howdy [foo bar @baz !dr_evil] '
. $change2->timestamp->as_string . ' ' . $change2->format_planner,
'Change content should format correctly with dependencies';
# Check file names.
my @fn = ('yo', 'howdy@beta.sql');
$change2->add_rework_tags($tag2);
is_deeply [ $change2->path_segments ], \@fn,
'path_segments should include directories';
is $change2->deploy_dir, $target->reworked_deploy_dir,
'Deploy dir should be in rworked dir';
is $change2->deploy_file, $target->reworked_deploy_dir->file(@fn),
'Deploy file should be in rworked dir and include suffix';
is $change2->revert_dir, $target->reworked_revert_dir,
'Revert dir should be in rworked dir';
is $change2->revert_file, $target->reworked_revert_dir->file(@fn),
'Revert file should be in rworked dir and include suffix';
is $change2->verify_dir, $target->reworked_verify_dir,
'Verify dir should be in rworked dir';
is $change2->verify_file, $target->reworked_verify_dir->file(@fn),
'Verify file should be in rworked dir and include suffix';
##############################################################################
# Test open_script.
make_path dir(qw(test-change deploy))->stringify;
file(qw(test-change deploy baz.sql))->touch;
my $change2_file = file qw(test-change deploy bar.sql);
$fh = $change2_file->open('>:utf8_strict') or die "Cannot open $change2_file: $!\n";
$fh->say('-- This is a comment');
$fh->say('# And so is this');
$fh->say('; and this, w€€!');
$fh->say('/* blah blah blah */');
$fh->close;
ok $change2 = $CLASS->new( name => 'baz', plan => $plan ),
'Create change "baz"';
ok $change2 = $CLASS->new( name => 'bar', plan => $plan ),
'Create change "bar"';
##############################################################################
# Test file handles.
ok $fh = $change2->deploy_handle, 'Get deploy handle';
is $fh->getline, "-- This is a comment\n", 'It should be the deploy file';
make_path dir(qw(test-change revert))->stringify;
$fh = $change2->revert_file->open('>')
or die "Cannot open " . $change2->revert_file . ": $!\n";
$fh->say('-- revert it, baby');
$fh->close;
ok $fh = $change2->revert_handle, 'Get revert handle';
is $fh->getline, "-- revert it, baby\n", 'It should be the revert file';
make_path dir(qw(test-change verify))->stringify;
$fh = $change2->verify_file->open('>')
or die "Cannot open " . $change2->verify_file . ": $!\n";
$fh->say('-- verify it, baby');
$fh->close;
ok $fh = $change2->verify_handle, 'Get verify handle';
is $fh->getline, "-- verify it, baby\n", 'It should be the verify file';
##############################################################################
# Test the requires/conflicts params.
my $file = file qw(t plans multi.plan);
my $sqitch2 = App::Sqitch->new(
config => TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir('test-change')->stringify,
'core.plan_file' => $file->stringify,
),
);
my $target2 = App::Sqitch::Target->new(sqitch => $sqitch2);
my $plan2 = $target2->plan;
ok $change2 = $CLASS->new(
name => 'whatever',
plan => $plan2,
requires => [dep 'hey', dep 'you'],
conflicts => [dep '!hey-there'],
), 'Create a change with explicit requires and conflicts';
is_deeply [$change2->requires], [dep 'hey', dep 'you'], 'requires should be set';
is_deeply [$change2->conflicts], [dep '!hey-there'], 'conflicts should be set';
is_deeply [$change2->dependencies], [dep 'hey', dep 'you', dep '!hey-there'],
'Dependencies should include requires and conflicts';
is_deeply [$change2->requires_changes], [$plan2->get('hey'), $plan2->get('you')],
'Should find changes for requires';
is_deeply [$change2->conflicts_changes], [$plan2->get('hey-there')],
'Should find changes for conflicts';
##############################################################################
# Test ID for a change with a UTF-8 name.
ok $change2 = $CLASS->new(
name => '阱阪阬',
plan => $plan2,
), 'Create change with UTF-8 name';
is $change2->info, join("\n",
'project ' . 'multi',
'uri ' . $uri->canonical,
'change ' . '阱阪阬',
'planner ' . $change2->format_planner,
'date ' . $change2->timestamp->as_string,
), 'The name should be decoded text in info';
is $change2->id, do {
my $content = Encode::encode_utf8 $change2->info;
Digest::SHA->new(1)->add(
'change ' . length($content) . "\0" . $content
)->hexdigest;
},'Change ID should be hashed from encoded UTF-8';
##############################################################################
# Test note_prompt().
is $change->note_prompt(
for => 'add',
scripts => [$change->deploy_file, $change->revert_file, $change->verify_file],
), exp_prompt(
for => 'add',
scripts => [$change->deploy_file, $change->revert_file, $change->verify_file],
name => $change->format_op_name_dependencies,
), 'note_prompt() should work';
is $change2->note_prompt(
for => 'add',
scripts => [$change2->deploy_file, $change2->revert_file, $change2->verify_file],
), exp_prompt(
for => 'add',
scripts => [$change2->deploy_file, $change2->revert_file, $change2->verify_file],
name => $change2->format_op_name_dependencies,
), 'note_prompt() should work';
sub exp_prompt {
my %p = @_;
join(
'',
__x(
"Please enter a note for your change. Lines starting with '#' will\n" .
"be ignored, and an empty message aborts the {command}.",
command => $p{for},
),
"\n",
__x('Change to {command}:', command => $p{for}),
"\n\n",
' ', $p{name},
join "\n ", '', @{ $p{scripts} },
"\n",
);
}
sqlite.t 100644 001751 000166 36230 15004170404 15653 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Test::MockModule;
use Path::Class;
use Try::Tiny;
use Test::Exception;
use Locale::TextDomain qw(App-Sqitch);
use File::Temp 'tempdir';
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine::sqlite';
require_ok $CLASS or die;
}
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $config = TestConfig->new('core.engine' => 'sqlite');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new('db:sqlite:foo.db'),
);
isa_ok my $sqlite = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $sqlite->key, 'sqlite', 'Key should be "sqlite"';
is $sqlite->name, 'SQLite', 'Name should be "SQLite"';
is $sqlite->client, 'sqlite3' . (App::Sqitch::ISWIN ? '.exe' : ''),
'client should default to sqlite3';
is $sqlite->uri->dbname, file('foo.db'), 'dbname should be filled in';
is $sqlite->target, $target, 'Target attribute should be specified target';
is $sqlite->destination, $sqlite->uri->as_string,
'Destination should be uri stringified';
is $sqlite->registry_destination, $sqlite->registry_uri->as_string,
'Registry target should be registry_uri stringified';
is $sqlite->_dsn, $sqlite->registry_uri->dbi_dsn, 'Should use registry DSN';
# Pretend for now that we always have a valid SQLite.
my $mock_sqitch = Test::MockModule->new(ref $sqitch);
my $sqlite_version = '3.8.6 2014-08-15 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af';
$mock_sqitch->mock(capture => sub { return $sqlite_version });
my @std_opts = (
'-noheader',
'-bail',
'-batch',
'-csv',
);
is_deeply [$sqlite->sqlite3], [$sqlite->client, @std_opts, $sqlite->uri->dbname],
'sqlite3 command should have the proper opts';
##############################################################################
# Make sure we get an error for no database name.
my $tmp_dir = Path::Class::dir( tempdir CLEANUP => 1 );
my $have_sqlite = try { $sqlite->use_driver };
if ($have_sqlite) {
# We have DBD::SQLite.
# Find out if it's built with SQLite >= 3.8.6.
my $dbh = DBI->connect('DBI:SQLite:');
my @v = split /[.]/ => $dbh->{sqlite_version};
$have_sqlite = $v[0] > 3 || ($v[0] == 3 && ($v[1] > 8 || ($v[1] == 8 && $v[2] >= 6)));
unless ($have_sqlite) {
# We have DBD::SQLite, but it is too old. Make sure we complain about that.
isa_ok $sqlite = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
throws_ok { $sqlite->dbh } 'App::Sqitch::X', 'Should get an error for old SQLite';
is $@->ident, 'sqlite', 'Unsupported SQLite error ident should be "sqlite"';
is $@->message, __x(
'Sqitch requires SQLite 3.8.6 or later; DBD::SQLite was built with {version}',
version => $dbh->{sqlite_version}
), 'Unsupported SQLite error message should be correct';
}
} else {
# No DBD::SQLite at all.
throws_ok { $sqlite->dbh } 'App::Sqitch::X',
'Should get an error without DBD::SQLite';
is $@->ident, 'sqlite', 'No DBD::SQLite error ident should be "sqlite"';
is $@->message, __x(
'{driver} required to manage {engine}',
driver => $sqlite->driver,
engine => $sqlite->name,
), 'No DBD::SQLite error message should be correct';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.sqlite.client' => '/path/to/sqlite3',
'engine.sqlite.target' => 'test',
'engine.sqlite.registry' => 'meta',
'target.test.uri' => 'db:sqlite:/path/to/sqlite.db',
);
$target = ref($target)->new( sqitch => $sqitch );
ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another sqlite';
is $sqlite->client, '/path/to/sqlite3',
'client should fall back on config';
is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqlite.db',
'dbname should fall back on config';
is $sqlite->target, $target, 'Target should be as specified';
is $sqlite->destination, 'test',
'Destination should be configured target name';
is $sqlite->registry_uri->as_string, 'db:sqlite:/path/to/meta.db',
'registry_uri should fall back on config';
is $sqlite->registry_destination, $sqlite->registry_uri->as_string,
'Registry target should be configured registry_uri stringified';
# Try a registry with an extension and a dbname without.
$config->update(
'engine.sqlite.registry' => 'meta.db',
'engine.sqlite.target' => 'test',
'target.test.uri' => 'db:sqlite:/path/to/sqitch',
);
$target = ref($target)->new( sqitch => $sqitch );
ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another sqlite';
is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqitch',
'dbname should fall back on config with no extension';
is $sqlite->target, $target, 'Target should be as specified';
is $sqlite->destination, 'test',
'Destination should be configured target name';
is $sqlite->registry_uri->as_string, 'db:sqlite:/path/to/meta.db',
'registry_uri should fall back on config wth extension';
is $sqlite->registry_destination, $sqlite->registry_uri->as_string,
'Registry target should be configured registry_uri stringified';
# Also try a registry with no extension and a dbname with.
$config->update(
'engine.sqlite.registry' => 'registry',
'engine.sqlite.target' => 'noext',
'target.noext.uri' => 'db:sqlite://x:foo@/path/to/sqitch.db',
);
$target = ref($target)->new( sqitch => $sqitch );
ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another sqlite';
is $sqlite->uri->as_string, 'db:sqlite://x:foo@/path/to/sqitch.db',
'dbname should fall back on config with no extension';
is $sqlite->target, $target, 'Target should be as specified';
is $sqlite->destination, 'noext',
'Destination should be configured target name';
is $sqlite->registry_uri->as_string, 'db:sqlite://x:foo@/path/to/registry.db',
'registry_uri should fall back on config wth extension';
like $sqlite->registry_destination, qr{^db:sqlite://x:?\@/path/to/registry\.db$},
'Registry target should be configured registry_uri without password';
# Try a registry with an absolute path.
$config->update(
'engine.sqlite.registry' => '/some/other/path.db',
'engine.sqlite.target' => 'abs',
'target.abs.uri' => 'db:sqlite:/path/to/sqitch.db',
);
$target = ref($target)->new( sqitch => $sqitch );
ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another sqlite';
is $sqlite->uri->as_string, 'db:sqlite:/path/to/sqitch.db',
'dbname should fall back on config with no extension';
is $sqlite->target, $target, 'Target should be as specified';
is $sqlite->destination, 'abs',
'Destination should be configured target name';
is $sqlite->registry_uri->as_string, 'db:sqlite:/some/other/path.db',
'registry_uri should fall back on config wth extension';
is $sqlite->registry_destination, $sqlite->registry_uri->as_string,
'Registry target should be configured registry_uri stringified';
##############################################################################
# Test _read().
$config->replace('core.engine' => 'sqlite');
my $id = DBIEngineTest->randstr;
my $db_name = $tmp_dir->file("sqitch$id.db");
$target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new("db:sqlite:$db_name")
);
ok $sqlite = $CLASS->new(sqitch => $sqitch, target => $target ),
'Instantiate with a temporary database file';
can_ok $sqlite, qw(_read);
SKIP: {
skip 'DBD::SQLite not available', 3 unless $have_sqlite;
is $sqlite->_read('foo'), q{.read 'foo'}, '_read() should work';
is $sqlite->_read('foo bar'), q{.read 'foo bar'},
'_read() should SQL-quote the file name';
is $sqlite->_read('foo \'bar\''), q{.read 'foo ''bar'''},
'_read() should SQL-quote quotes, too';
}
##############################################################################
# Test _run(), _capture(), and _spool().
can_ok $sqlite, qw(_run _capture _spool);
my (@run, @capture, @spool);
$mock_sqitch->mock(run => sub { shift; @run = @_ });
$mock_sqitch->mock(capture => sub { shift; @capture = @_; return $sqlite_version });
$mock_sqitch->mock(spool => sub { shift; @spool = @_ });
ok $sqlite->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@run, [$sqlite->sqlite3, qw(foo bar baz)],
'Command should be passed to run()';
ok $sqlite->_spool('FH'), 'Call _spool';
is_deeply \@spool, ['FH', $sqlite->sqlite3],
'Command should be passed to spool()';
ok $sqlite->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [$sqlite->sqlite3, qw(foo bar baz)],
'Command should be passed to capture()';
# Test file and handle running.
SKIP: {
skip 'DBD::SQLite not available', 2 unless $have_sqlite;
ok $sqlite->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, [$sqlite->sqlite3, ".read 'foo/bar.sql'"],
'File should be passed to run()';
}
ok $sqlite->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, ['FH', $sqlite->sqlite3],
'Handle should be passed to spool()';
SKIP: {
skip 'DBD::SQLite not available', 2 unless $have_sqlite;
# Verify should go to capture unless verosity is > 1.
ok $sqlite->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
is_deeply \@capture, [$sqlite->sqlite3, ".read 'foo/bar.sql'"],
'Verify file should be passed to capture()';
$mock_sqitch->mock(verbosity => 2);
ok $sqlite->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, [$sqlite->sqlite3, ".read 'foo/bar.sql'"],
'Verifile file should be passed to run() for high verbosity';
}
##############################################################################
# Test DateTime formatting stuff.
can_ok $CLASS, '_ts2char_format';
is sprintf($CLASS->_ts2char_format, 'foo'),
q{strftime('year:%Y:month:%m:day:%d:hour:%H:minute:%M:second:%S:time_zone:UTC', foo)},
'_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';
##############################################################################
# Test checking the SQLite version.
for my $v (qw(
3.3.9
3.3.10
3.3.200
3.4.0
3.4.8
3.7.11
3.8.12
3.10.0
4.1.30
)) {
$sqlite_version = "$v 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af";
ok my $sqlite = $CLASS->new(
sqitch => $sqitch,
target => $target,
), "Create command for v$v";
ok $sqlite->sqlite3, "Should be okay with sqlite v$v";
}
for my $v (qw(
3.3.8
3.3.0
3.2.8
3.0.1
3.0.0
2.8.1
2.20.0
1.0.0
)) {
$sqlite_version = "$v 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af";
ok my $sqlite = $CLASS->new(
sqitch => $sqitch,
target => $target,
), "Create command for v$v";
throws_ok { $sqlite->sqlite3 } 'App::Sqitch::X', "Should not be okay with v$v";
is $@->ident, 'sqlite', qq{Should get ident "sqlite" for v$v};
is $@->message, __x(
'Sqitch requires SQLite 3.3.9 or later; {client} is {version}',
client => $sqlite->client,
version => $v
), "Should get proper error message for v$v";
}
$mock_sqitch->unmock_all;
# Make sure we have templates.
DBIEngineTest->test_templates_for($sqlite->key);
##############################################################################
# Test against extra newline in capture.
$sqlite_version = '3.7.12 2012-04-03 19:43:07 86b8481be7e76cccc92d14ce762d21bfb69504af';
$mock_sqitch->mock(capture => sub { return ( "\n",$sqlite_version) });
{
ok my $sqlite = $CLASS->new(
sqitch => $sqitch,
target => $target,
), "Create command for v3.7.12 with newline";
ok $sqlite->sqlite3, "Should be okay with sqlite version v3.7.12 with newline";
}
# Un-mock for live tests below
$mock_sqitch->unmock_all;
##############################################################################
# Test error checking functions.
DBI: {
local *DBI::errstr;
ok !$sqlite->_no_table_error, 'Should have no table error';
ok !$sqlite->_no_column_error, 'Should have no column error';
$DBI::errstr = 'no such table: xyz';
ok $sqlite->_no_table_error, 'Should now have table error';
ok !$sqlite->_no_column_error, 'Still should have no column error';
$DBI::errstr = 'no such column: xyz';
ok !$sqlite->_no_table_error, 'Should again have no table error';
ok $sqlite->_no_column_error, 'Should now have no column error';
}
##############################################################################
my $alt_db = $db_name->dir->file("sqitchtest$id.db");
my ($reg1, $reg2) = map { $_ . $id } qw(sqitch sqitchtest);
# Can we do live tests?
END {
my %drivers = DBI->installed_drivers;
for my $driver (values %drivers) {
$driver->visit_child_handles(sub {
my $h = shift;
$h->disconnect if $h->{Type} eq 'db' && $h->{Active};
});
}
}
DBIEngineTest->run(
class => $CLASS,
version_query => q{select 'SQLite ' || sqlite_version()},
target_params => [
uri => URI->new("db:sqlite:$db_name"),
registry => $reg1,
],
alt_target_params => [
uri => URI->new("db:sqlite:$db_name"),
registry => $reg2,
],
skip_unless => sub {
my $self = shift;
# Should have the database handle and client.
$self->dbh && $self->sqlite3;
# Make sure we have a supported version.
my $version = $self->dbh->{sqlite_version};
my @v = split /[.]/ => $version;
die "SQLite >= 3.7.11 required; DBD::SQLite built with $version\n"
unless $v[0] > 3 || ($v[0] == 3 && ($v[1] > 7 || ($v[1] == 7 && $v[2] >= 11)));
$version = (split / / => scalar $self->sqitch->capture( $self->client, '-version' ))[0];
@v = split /[.]/ => $version;
die "SQLite >= 3.3.9 required; CLI is $version\n"
unless $v[0] > 3 || ($v[0] == 3 && ($v[1] > 3 || ($v[1] == 3 && $v[2] >= 9)));
say "# Detected SQLite CLI $version";
return 1;
},
engine_err_regex => qr/^near "blah": syntax error/,
init_error => __x(
'Sqitch database {database} already initialized',
database => $alt_db,
),
test_dbh => sub {
my $dbh = shift;
# Make sure foreign key constraints are enforced.
ok $dbh->selectcol_arrayref('PRAGMA foreign_keys')->[0],
'The foreign_keys pragma should be enabled';
},
add_second_format => q{strftime('%%Y-%%m-%%d %%H:%%M:%%f', strftime('%%J', %s) + (1/86400.0))},
);
done_testing;
depend.t 100644 001751 000166 20356 15004170404 15613 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 326;
#use Test::More 'no_plan';
use Test::Exception;
#use Test::NoWarnings;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use Path::Class;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Plan::Depend';
require_ok $CLASS or die;
}
ok my $sqitch = App::Sqitch->new(
config => TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
),
), 'Load a sqitch sqitch object';
my $target = App::Sqitch::Target->new( sqitch => $sqitch );
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, project => 'depend', target => $target);
can_ok $CLASS, qw(
conflicts
project
change
tag
id
resolved_id
key_name
as_string
as_plan_string
);
my $id = '9ed961ad7902a67fe0804c8e49e8993719fd5065';
for my $spec(
[ 'foo' => change => 'foo' ],
[ 'bar' => change => 'bar' ],
[ '@bar' => tag => 'bar' ],
[ '!foo' => change => 'foo', conflicts => 1 ],
[ '!@bar' => tag => 'bar', conflicts => 1 ],
[ 'foo@bar' => change => 'foo', tag => 'bar' ],
[ '!foo@bar' => change => 'foo', tag => 'bar', conflicts => 1 ],
[ 'proj:foo' => change => 'foo', project => 'proj' ],
[ '!proj:foo' => change => 'foo', project => 'proj', conflicts => 1 ],
[ 'proj:@foo' => tag => 'foo', project => 'proj' ],
[ '!proj:@foo' => tag => 'foo', project => 'proj', conflicts => 1 ],
[ 'proj:foo@bar' => change => 'foo', tag => 'bar', project => 'proj' ],
[
'!proj:foo@bar',
change => 'foo',
tag => 'bar',
project => 'proj',
conflicts => 1
],
[ $id => id => $id ],
[ "!$id" => id => $id, conflicts => 1 ],
[ "foo:$id" => id => $id, project => 'foo' ],
[ "!foo:$id" => id => $id, project => 'foo', conflicts => 1 ],
[ "$id\@what" => change => $id, tag => 'what' ],
[ "!$id\@what" => change => $id, tag => 'what', conflicts => 1 ],
[ "foo:$id\@what" => change => $id, tag => 'what', project => 'foo' ],
) {
my $exp = shift @{$spec};
ok my $depend = $CLASS->new(
plan => $plan,
@{$spec},
), qq{Construct "$exp"};
( my $str = $exp ) =~ s/^!//;
( my $key = $str ) =~ s/^[^:]+://;
my $proj = $1;
is $depend->as_string, $str, qq{Constructed should stringify as "$str"};
is $depend->key_name, $key, qq{Constructed should have key name "$key"};
is $depend->as_plan_string, $exp, qq{Constructed should plan stringify as "$exp"};
ok $depend = $CLASS->new(
plan => $plan,
%{ $CLASS->parse($exp) },
), qq{Parse "$exp"};
is $depend->as_plan_string, $exp, qq{Parsed should plan stringify as "$exp"};
if ($exp =~ /^!/) {
# Conflicting.
ok $depend->conflicts, qq{"$exp" should be conflicting};
ok !$depend->required, qq{"$exp" should not be required};
is $depend->type, 'conflict', qq{"$exp" type should be "conflict"};
} else {
# Required.
ok $depend->required, qq{"$exp" should be required};
ok !$depend->conflicts, qq{"$exp" should not be conflicting};
is $depend->type, 'require', qq{"$exp" type should be "require"};
}
if ($str =~ /^([^:]+):/) {
# Project specified in spec.
my $prj = $1;
ok $depend->got_project, qq{Should have got project from "$exp"};
is $depend->project, $prj, qq{Should have project "$prj" for "$exp"};
if ($prj eq $plan->project) {
ok !$depend->is_external, qq{"$exp" should not be external};
ok $depend->is_internal, qq{"$exp" should be internal};
} else {
ok $depend->is_external, qq{"$exp" should be external};
ok !$depend->is_internal, qq{"$exp" should not be internal};
}
} else {
ok !$depend->got_project, qq{Should not have got project from "$exp"};
if ($depend->change || $depend->tag) {
# No ID, default to current project.
my $prj = $plan->project;
is $depend->project, $prj, qq{Should have project "$prj" for "$exp"};
ok !$depend->is_external, qq{"$exp" should not be external};
ok $depend->is_internal, qq{"$exp" should be internal};
} else {
# ID specified, but no project, and ID not in plan, so unknown project.
is $depend->project, undef, qq{Should have undef project for "$exp"};
ok $depend->is_external, qq{"$exp" should be external};
ok !$depend->is_internal, qq{"$exp" should not be internal};
}
}
if ($exp =~ /\Q$id\E(?![@])/) {
ok $depend->got_id, qq{Should have got ID from "$exp"};
} else {
ok !$depend->got_id, qq{Should not have got ID from "$exp"};
}
}
for my $bad ( 'foo bar', 'foo+@bar', 'foo:+bar', 'foo@bar+', 'proj:foo@bar+', )
{
is $CLASS->parse($bad), undef, qq{Should fail to parse "$bad"};
}
throws_ok { $CLASS->new( plan => $plan ) } 'App::Sqitch::X',
'Should get exception for no change or tag';
is $@->ident, 'DEV', 'No change or tag error ident should be "DEV"';
is $@->message,
'Depend object must have either "change", "tag", or "id" defined',
'No change or tag error message should be correct';
for my $params (
{ change => 'foo' },
{ tag => 'bar' },
{ change => 'foo', tag => 'bar' },
) {
my $keys = join ' and ' => keys %{ $params };
throws_ok { $CLASS->new( plan => $plan, id => $id, %{ $params} ) }
'App::Sqitch::X', "Should get an error for ID + $keys";
is $@->ident, 'DEV', qq{ID + $keys error ident ident should be "DEV"};
is $@->message,
'Depend object cannot contain both an ID and a tag or change',
qq{ID + $keys error message should be correct};
}
##############################################################################
# Test ID.
ok my $depend = $CLASS->new(
plan => $plan,
%{ $CLASS->parse('roles') },
), 'Create "roles" dependency';
is $depend->id, $plan->find('roles')->id,
'Should find the "roles" ID in the plan';
ok !$depend->is_external, 'The "roles" change should not be external';
ok $depend->is_internal, 'The "roles" change should be internal';
ok $depend = $CLASS->new(
plan => $plan,
%{ $CLASS->parse('elsewhere:roles') },
), 'Create "elsewhere:roles" dependency';
is $depend->id, undef, 'The "elsewhere:roles" id should be undef';
ok $depend->is_external, 'The "elsewhere:roles" change should be external';
ok !$depend->is_internal, 'The "elsewhere:roles" change should not be internal';
ok $depend = $CLASS->new(
plan => $plan,
id => $id,
), 'Create depend using external ID';
is $depend->id, $id, 'The external ID should be set';
ok $depend->is_external, 'The external ID should register as external';
ok !$depend->is_internal, 'The external ID should not register as internal';
$id = $plan->find('roles')->id;
ok $depend = $CLASS->new(
plan => $plan,
id => $id,
), 'Create depend using "roles" ID';
is $depend->id, $id, 'The "roles" ID should be set';
ok !$depend->is_external, 'The "roles" ID should not register as external';
ok $depend->is_internal, 'The "roles" ID should register as internal';
ok $depend = $CLASS->new(
plan => $plan,
project => $plan->project,
%{ $CLASS->parse('nonexistent') },
), 'Create "nonexistent" dependency';
throws_ok { $depend->id } 'App::Sqitch::X',
'Should get error for nonexistent change';
is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"';
is $@->message, __x(
'Unable to find change "{change}" in plan {file}',
change => 'nonexistent',
file => $target->plan_file,
), 'Nonexistent change error message should be correct';
##############################################################################
# Test resolved_id.
ok $depend = $CLASS->new( plan => $plan, tag => 'foo' ),
'Create depend without ID';
is $depend->resolved_id, undef, 'Resolved ID should be undef';
ok $depend->resolved_id($id), 'Set resolved ID';
is $depend->resolved_id, $id, 'Resolved ID should be set';
ok !$depend->resolved_id(undef), 'Unset resolved ID';
is $depend->resolved_id, undef, 'Resolved ID should be undef again';
engine.t 100755 001751 000166 427210 15004170404 15644 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 802;
# use Test::More 'no_plan';
use App::Sqitch;
use App::Sqitch::Plan;
use App::Sqitch::Target;
use Path::Class;
use Test::Exception;
use Test::NoWarnings;
use Test::MockModule;
use Test::MockObject::Extends;
use Test::Warn 0.31 qw(warning_is);
use Time::HiRes qw(sleep);
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::X qw(hurl);
use App::Sqitch::DateTime;
use List::Util qw(max);
use lib 't/lib';
use MockOutput;
use TestConfig;
use Clone qw(clone);
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine';
use_ok $CLASS or die;
delete $ENV{PGDATABASE};
delete $ENV{PGUSER};
delete $ENV{USER};
}
can_ok $CLASS, qw(load new name run_deploy run_revert run_verify run_upgrade uri);
my ($is_deployed_tag, $is_deployed_change) = (0, 0);
my @deployed_changes;
my @deployed_change_ids;
my @resolved;
my @requiring;
my @load_changes;
my $offset_change;
my $die = '';
my $record_work = 1;
my ( $earliest_change_id, $latest_change_id, $initialized );
my $registry_version = $CLASS->registry_release;
my $script_hash;
my $try_lock_ret = 1;
my $wait_lock_ret = 0;
ENGINE: {
# Stub out an engine.
package App::Sqitch::Engine::whu;
use Moo;
use App::Sqitch::X qw(hurl);
extends 'App::Sqitch::Engine';
$INC{'App/Sqitch/Engine/whu.pm'} = __FILE__;
my @SEEN;
for my $meth (qw(
run_file
log_deploy_change
log_revert_change
log_fail_change
)) {
no strict 'refs';
*$meth = sub {
hurl 'AAAH!' if $die eq $meth;
push @SEEN => [ $meth => $_[1] ];
};
}
sub is_deployed_tag { push @SEEN => [ is_deployed_tag => $_[1] ]; $is_deployed_tag }
sub is_deployed_change { push @SEEN => [ is_deployed_change => $_[1] ]; $is_deployed_change }
sub are_deployed_changes { shift; push @SEEN => [ are_deployed_changes => [@_] ]; @deployed_change_ids }
sub change_id_for { shift; push @SEEN => [ change_id_for => {@_} ]; shift @resolved }
sub change_offset_from_id { shift; push @SEEN => [ change_offset_from_id => [@_] ]; $offset_change }
sub change_id_offset_from_id { shift; push @SEEN => [ change_id_offset_from_id => [@_] ]; $_[0] }
sub changes_requiring_change { push @SEEN => [ changes_requiring_change => $_[1] ]; @{ shift @requiring } }
sub earliest_change_id { push @SEEN => [ earliest_change_id => $_[1] ]; $earliest_change_id }
sub latest_change_id { push @SEEN => [ latest_change_id => $_[1] ]; $latest_change_id }
sub current_state { push @SEEN => [ current_state => $_[1] ]; $latest_change_id ? { change => 'what', change_id => $latest_change_id, script_hash => $script_hash } : undef }
sub initialized { push @SEEN => 'initialized'; $initialized }
sub initialize { push @SEEN => 'initialize' }
sub register_project { push @SEEN => 'register_project' }
sub deployed_changes { push @SEEN => [ deployed_changes => $_[1] ]; @deployed_changes }
sub load_change { push @SEEN => [ load_change => $_[1] ]; @load_changes }
sub deployed_changes_since { push @SEEN => [ deployed_changes_since => $_[1] ]; @deployed_changes }
sub mock_check_deploy { shift; push @SEEN => [ check_deploy_dependencies => [@_] ] }
sub mock_check_revert { shift; push @SEEN => [ check_revert_dependencies => [@_] ] }
sub mock_lock { shift; push @SEEN => [ lock_destination => [@_] ] }
sub begin_work { push @SEEN => ['begin_work'] if $record_work }
sub finish_work { push @SEEN => ['finish_work'] if $record_work }
sub log_new_tags { push @SEEN => [ log_new_tags => $_[1] ]; $_[0] }
sub _update_script_hashes { push @SEEN => ['_update_script_hashes']; $_[0] }
sub upgrade_registry { push @SEEN => 'upgrade_registry' }
sub seen { [@SEEN] }
after seen => sub { @SEEN = () };
sub name_for_change_id { return 'bugaboo' }
sub registry_version { $registry_version }
sub wait_lock { push @SEEN => 'wait_lock'; $wait_lock_ret }
sub try_lock { $try_lock_ret }
}
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t plans multi.plan))->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
my $mock_engine = Test::MockModule->new($CLASS);
##############################################################################
# Test new().
my $target = App::Sqitch::Target->new( sqitch => $sqitch );
throws_ok { $CLASS->new( sqitch => $sqitch ) }
qr/\QMissing required arguments: target/,
'Should get an exception for missing sqitch param';
throws_ok { $CLASS->new( target => $target ) }
qr/\QMissing required arguments: sqitch/,
'Should get an exception for missing sqitch param';
my $array = [];
throws_ok { $CLASS->new({ sqitch => $array, target => $target }) }
qr/\QReference [] did not pass type constraint "Sqitch"/,
'Should get an exception for array sqitch param';
throws_ok { $CLASS->new({ sqitch => $sqitch, target => $array }) }
qr/\QReference [] did not pass type constraint "Target"/,
'Should get an exception for array target param';
throws_ok { $CLASS->new({ sqitch => 'foo', target => $target }) }
qr/\QValue "foo" did not pass type constraint "Sqitch"/,
'Should get an exception for string sqitch param';
throws_ok { $CLASS->new({ sqitch => $sqitch, target => 'foo' }) }
qr/\QValue "foo" did not pass type constraint "Target"/,
'Should get an exception for string target param';
isa_ok $CLASS->new({sqitch => $sqitch, target => $target}), $CLASS, 'Engine';
##############################################################################
# Test load().
$config->update('core.engine' => 'whu');
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok my $engine = $CLASS->load({
sqitch => $sqitch,
target => $target,
}), 'Load an engine';
isa_ok $engine, 'App::Sqitch::Engine::whu';
is $engine->sqitch, $sqitch, 'The sqitch attribute should be set';
# Test handling of an invalid engine.
my $unknown_target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:nonexistent:')
);
throws_ok { $CLASS->load({ sqitch => $sqitch, target => $unknown_target }) }
'App::Sqitch::X', 'Should die on unknown target';
is $@->message, __x('Unknown engine: {engine}', engine => 'nonexistent'),
'Should get load error message';
like $@->previous_exception, qr/\QCan't locate/,
'Should have relevant previous exception';
NOENGINE: {
# Test handling of no target.
throws_ok { $CLASS->load({ sqitch => $sqitch }) } 'App::Sqitch::X',
'No target should die';
is $@->message, 'Missing "target" parameter to load()',
'It should be the expected message';
}
# Test handling a bad engine implementation.
use lib 't/lib';
my $bad_target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new('db:bad:')
);
throws_ok { $CLASS->load({ sqitch => $sqitch, target => $bad_target }) }
'App::Sqitch::X', 'Should die on bad engine module';
is $@->message, __x('Unknown engine: {engine}', engine => 'bad'),
'Should get another load error message';
like $@->previous_exception, qr/^LOL BADZ/,
'Should have relevant previous exception from the bad module';
##############################################################################
# Test run methods.
ok $engine->run_deploy('deploy');
is_deeply $engine->seen, [[qw(run_file deploy)]],
'run_deploy have called run_file';
ok $engine->run_revert('revert');
is_deeply $engine->seen, [[qw(run_file revert)]],
'run_revert have called run_file';
ok $engine->run_verify('verify');
is_deeply $engine->seen, [[qw(run_file verify)]],
'run_verify have called run_file';
ok $engine->run_upgrade('upgrade');
is_deeply $engine->seen, [[qw(run_file upgrade)]],
'run_upgrade have called run_file';
##############################################################################
# Test name.
can_ok $CLASS, 'name';
ok $engine = $CLASS->new({ sqitch => $sqitch, target => $target }),
"Create a $CLASS object";
throws_ok { $engine->name } 'App::Sqitch::X',
'Should get error from base engine name';
is $@->ident, 'engine', 'Name error ident should be "engine"';
is $@->message, __('No engine specified; specify via target or core.engine'),
'Name error message should be correct';
ok $engine = App::Sqitch::Engine::whu->new({sqitch => $sqitch, target => $target}),
'Create a subclass name object';
is $engine->name, 'whu', 'Subclass oject name should be "whu"';
is +App::Sqitch::Engine::whu->name, 'whu', 'Subclass class name should be "whu"';
##############################################################################
# Test config_vars.
can_ok $CLASS, 'config_vars';
is_deeply [App::Sqitch::Engine->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'Should have database and client in engine base class';
##############################################################################
# Test variables.
can_ok $CLASS, qw(variables set_variables clear_variables);
is_deeply [$engine->variables], [], 'Should have no variables';
ok $engine->set_variables(foo => 'bar'), 'Add a variable';
is_deeply [$engine->variables], [foo => 'bar'], 'Should have the variable';
ok $engine->set_variables(foo => 'baz', whu => 'hi', yo => 'stellar'),
'Set more variables';
is_deeply {$engine->variables}, {foo => 'baz', whu => 'hi', yo => 'stellar'},
'Should have all of the variables';
$engine->clear_variables;
is_deeply [$engine->variables], [], 'Should again have no variables';
##############################################################################
# Test target.
ok $engine = $CLASS->load({
sqitch => $sqitch,
target => $target,
}), 'Load engine';
is $engine->target, $target, 'Target should be as passed';
# Make sure password is removed from the target.
ok $engine = $CLASS->load({
sqitch => $sqitch,
target => $target,
uri => URI->new('db:whu://foo:bar@localhost/blah'),
}), 'Load engine with URI with password';
isa_ok $engine->target, 'App::Sqitch::Target', 'target attribute';
##############################################################################
# Test destination.
ok $engine = $CLASS->load({
sqitch => $sqitch,
target => $target,
}), 'Load engine';
is $engine->destination, 'db:whu:', 'Destination should be URI string';
is $engine->registry_destination, $engine->destination,
'Rgistry destination should be the same as destination';
# Make sure password is removed from the destination.
my $long_target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new('db:whu://foo:bar@localhost/blah'),
);
ok $engine = $CLASS->load({
sqitch => $sqitch,
target => $long_target,
}), 'Load engine with URI with password';
like $engine->destination, qr{^db:whu://foo:?\@localhost/blah$},
'Destination should not include password';
is $engine->registry_destination, $engine->destination,
'Registry destination should again be the same as destination';
##############################################################################
# Test _check_registry.
can_ok $engine, '_check_registry';
ok $engine->_check_registry, 'Registry should be fine at current version';
# Make the registry non-existent.
$registry_version = 0;
$initialized = 0;
throws_ok { $engine->_check_registry } 'App::Sqitch::X',
'Should get error for non-existent registry';
is $@->ident, 'engine', 'Non-existent registry error ident should be "engine"';
is $@->message, __x(
'No registry found in {destination}. Have you ever deployed?',
destination => $engine->registry_destination,
), 'Non-existent registry error message should be correct';
$engine->seen;
# Make sure it's checked on revert and verify.
for my $meth (qw(revert verify)) {
throws_ok { $engine->$meth(undef, 1, 1) } 'App::Sqitch::X', "Should get error from $meth";
is $@->ident, 'engine', qq{$meth registry error ident should be "engine"};
is $@->message, __x(
'No registry found in {destination}. Have you ever deployed?',
destination => $engine->registry_destination,
), "$meth registry error message should be correct";
$engine->seen;
}
# Make the registry out-of-date.
$registry_version = 0.1;
throws_ok { $engine->_check_registry } 'App::Sqitch::X',
'Should get error for out-of-date registry';
is $@->ident, 'engine', 'Out-of-date registry error ident should be "engine"';
is $@->message, __x(
'Registry is at version {old} but latest is {new}. Please run the "upgrade" command',
old => 0.1,
new => $engine->registry_release,
), 'Out-of-date registry error message should be correct';
# Send the registry to the future.
$registry_version = 999.99;
throws_ok { $engine->_check_registry } 'App::Sqitch::X',
'Should get error for future registry';
is $@->ident, 'engine', 'Future registry error ident should be "engine"';
is $@->message, __x(
'Registry version is {old} but {new} is the latest known. Please upgrade Sqitch',
old => 999.99,
new => $engine->registry_release,
), 'Future registry error message should be correct';
# Restore the registry version.
$registry_version = $CLASS->registry_release;
##############################################################################
# Test abstract methods.
ok $engine = $CLASS->new({
sqitch => $sqitch,
target => $target,
}), "Create a $CLASS object again";
for my $abs (qw(
initialized
initialize
register_project
run_file
run_handle
log_deploy_change
log_fail_change
log_revert_change
log_new_tags
is_deployed_tag
is_deployed_change
are_deployed_changes
change_id_for
changes_requiring_change
earliest_change_id
latest_change_id
deployed_changes
deployed_changes_since
load_change
name_for_change_id
current_state
current_changes
current_tags
search_events
registered_projects
change_offset_from_id
change_id_offset_from_id
wait_lock
registry_version
_update_script_hashes
)) {
throws_ok { $engine->$abs } qr/\Q$CLASS has not implemented $abs()/,
"Should get an unimplemented exception from $abs()"
}
##############################################################################
# Test _load_changes().
can_ok $engine, '_load_changes';
my $now = App::Sqitch::DateTime->now;
my $plan = $target->plan;
# Mock App::Sqitch::DateTime so that change tags all have the same
# timestamps.
my $mock_dt = Test::MockModule->new('App::Sqitch::DateTime');
$mock_dt->mock(now => $now);
for my $spec (
[ 'no change' => [] ],
[ 'undef' => [undef] ],
['no tags' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
]],
['multiple hashes with no tags' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
{
id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0',
name => 'booyah',
project => 'engine',
note => 'Whatever',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
]],
['tags' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(foo bar)],
},
]],
['tags with leading @' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(@foo @bar)],
},
]],
['multiple hashes with tags' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(foo bar)],
},
{
id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0',
name => 'booyah',
project => 'engine',
note => 'Whatever',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(@foo @bar)],
},
]],
['reworked change' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(foo bar)],
},
{
id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
rtags => [qw(howdy)],
},
]],
['reworked change & multiple tags' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(foo bar)],
},
{
id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0',
name => 'booyah',
project => 'engine',
note => 'Whatever',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(@settle)],
},
{
id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
rtags => [qw(booyah howdy)],
},
]],
['doubly reworked change' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
tags => [qw(foo bar)],
},
{
id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
rtags => [qw(howdy)],
tags => [qw(why)],
},
{
id => 'f38ceb6efcf2a813104b7bb08cc90667033ddf6b',
name => 'howdy',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
rtags => [qw(howdy)],
},
]],
) {
my ($desc, $args) = @{ $spec };
my %seen;
is_deeply [ $engine->_load_changes(@{ $args }) ], [ map {
my $tags = $_->{tags} || [];
my $rtags = $_->{rtags};
my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan );
$c->add_tag(App::Sqitch::Plan::Tag->new(
name => $_,
plan => $plan,
change => $c,
timestamp => $now,
)) for map { s/^@//; $_ } @{ $tags };
if (my $dupe = $seen{ $_->{name} }) {
$dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags });
}
$seen{ $_->{name} } = $c;
$c;
} grep { $_ } @{ $args }], "Should load changes with $desc";
}
# Rework a change in the plan.
my $you = $plan->get('you');
my $this_rocks = $plan->get('this/rocks');
my $hey_there = $plan->get('hey-there');
ok my $rev_change = $plan->rework( name => 'you' ), 'Rework change "you"';
ok $plan->tag( name => '@beta1' ), 'Tag @beta1';
# Load changes
for my $spec (
[ 'Unplanned change' => [
{
id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d',
name => 'you',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
{
id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163',
name => 'this/rocks',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
]],
[ 'reworked change without reworked version deployed' => [
{
id => $you->id,
name => $you->name,
project => $you->project,
note => $you->note,
planner_name => $you->planner_name,
planner_email => $you->planner_email,
timestamp => $you->timestamp,
ptags => [ $hey_there->tags, $you->tags ],
},
{
id => $this_rocks->id,
name => 'this/rocks',
project => 'engine',
note => 'For realz',
planner_name => 'Barack Obama',
planner_email => 'bo@whitehouse.gov',
timestamp => $now,
},
]],
[ 'reworked change with reworked version deployed' => [
{
id => $you->id,
name => $you->name,
project => $you->project,
note => $you->note,
planner_name => $you->planner_name,
planner_email => $you->planner_email,
timestamp => $you->timestamp,
tags => [qw(@foo @bar)],
ptags => [ $hey_there->tags, $you->tags ],
},
{
id => $rev_change->id,
name => $rev_change->name,
project => 'engine',
note => $rev_change->note,
planner_name => $rev_change->planner_name,
planner_email => $rev_change->planner_email,
timestamp => $rev_change->timestamp,
},
]],
) {
my ($desc, $args) = @{ $spec };
my %seen;
is_deeply [ $engine->_load_changes(@{ $args }) ], [ map {
my $tags = $_->{tags} || [];
my $rtags = $_->{rtags};
my $ptags = $_->{ptags};
my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan );
$c->add_tag(App::Sqitch::Plan::Tag->new(
name => $_,
plan => $plan,
change => $c,
timestamp => $now,
)) for map { s/^@//; $_ } @{ $tags };
my %seen_tags;
if (@{ $ptags || [] }) {
$c->add_rework_tags( @{ $ptags });
}
if (my $dupe = $seen{ $_->{name} }) {
$dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags });
}
$seen{ $_->{name} } = $c;
$c;
} grep { $_ } @{ $args }], "Should load changes with $desc";
}
##############################################################################
# Test deploy_change and revert_change.
ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ),
'Create a subclass name object again';
can_ok $engine, 'deploy_change', 'revert_change';
my $change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan );
$engine->max_name_length(length $change->format_name_with_tags);
ok $engine->deploy_change($change), 'Deploy a change';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->deploy_file ],
[log_deploy_change => $change ],
['finish_work'],
], 'deploy_change should have called the proper methods';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the deployment';
is_deeply +MockOutput->get_info, [[__ 'ok' ]],
'Output should reflect success';
# Have it log only.
$engine->log_only(1);
ok $engine->deploy_change($change), 'Only log a change';
is_deeply $engine->seen, [
['begin_work'],
[log_deploy_change => $change ],
['finish_work'],
], 'log-only deploy_change should not have called run_file';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the logging';
is_deeply +MockOutput->get_info, [[__ 'ok' ]],
'Output should reflect deploy success';
# Have it verify.
ok $engine->with_verify(1), 'Enable verification';
$engine->log_only(0);
ok $engine->deploy_change($change), 'Deploy a change to be verified';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->deploy_file ],
[run_file => $change->verify_file ],
[log_deploy_change => $change ],
['finish_work'],
], 'deploy_change with verification should run the verify file';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the logging';
is_deeply +MockOutput->get_info, [[__ 'ok' ]],
'Output should reflect deploy success';
# Have it verify *and* log-only.
ok $engine->log_only(1), 'Enable log_only';
ok $engine->deploy_change($change), 'Verify and log a change';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->verify_file ],
[log_deploy_change => $change ],
['finish_work'],
], 'deploy_change with verification and log-only should not run deploy';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the logging';
is_deeply +MockOutput->get_info, [[__ 'ok' ]],
'Output should reflect deploy success';
# Make run_file fail.
$die = 'run_file';
$engine->log_only(0);
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploy change with error';
is $@->message, 'AAAH!', 'Error should be from run_file';
is_deeply $engine->seen, [
['begin_work'],
[log_fail_change => $change ],
['finish_work'],
], 'Should have logged change failure';
$die = '';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the deployment, even with failure';
is_deeply +MockOutput->get_info, [[__ 'not ok' ]],
'Output should reflect deploy failure';
# Make the verify fail.
$mock_engine->mock( verify_change => sub { hurl 'WTF!' });
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploy change with failed verification';
is $@->message, __ 'Deploy failed', 'Error should be from deploy_change';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->deploy_file ],
['begin_work'],
[run_file => $change->revert_file ],
[log_fail_change => $change ],
['finish_work'],
], 'Should have logged verify failure';
$die = '';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the deployment, even with verify failure';
is_deeply +MockOutput->get_info, [[__ 'not ok' ]],
'Output should reflect deploy failure';
is_deeply +MockOutput->get_vent, [['WTF!']],
'Verify error should have been vented';
# Make the verify fail with log only.
ok $engine->log_only(1), 'Enable log_only';
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploy change with log-only and failed verification';
is $@->message, __ 'Deploy failed', 'Error should be from deploy_change';
is_deeply $engine->seen, [
['begin_work'],
['begin_work'],
[log_fail_change => $change ],
['finish_work'],
], 'Should have logged verify failure but not reverted';
$die = '';
is_deeply +MockOutput->get_info_literal, [[
' + users ..', '' , ' '
]], 'Output should reflect the deployment, even with verify failure';
is_deeply +MockOutput->get_info, [[__ 'not ok' ]],
'Output should reflect deploy failure';
is_deeply +MockOutput->get_vent, [['WTF!']],
'Verify error should have been vented';
# Try a change with no verify file.
$engine->log_only(0);
$mock_engine->unmock( 'verify_change' );
$change = App::Sqitch::Plan::Change->new( name => 'roles', plan => $target->plan );
ok $engine->deploy_change($change), 'Deploy a change with no verify script';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->deploy_file ],
[log_deploy_change => $change ],
['finish_work'],
], 'deploy_change with no verify file should not run it';
is_deeply +MockOutput->get_info_literal, [[
' + roles ..', '' , ' '
]], 'Output should reflect the logging';
is_deeply +MockOutput->get_info, [[__ 'ok' ]],
'Output should reflect deploy success';
is_deeply +MockOutput->get_vent, [
[__x 'Verify script {file} does not exist', file => $change->verify_file],
], 'A warning about no verify file should have been emitted';
# Try a change with no deploy file.
$change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan );
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploy change with log-only and failed verification';
is $@->message, __x(
'Deploy script {file} does not exist',
file => $change->deploy_file,
), 'Error should be from deploy_change';
is_deeply $engine->seen, [
['begin_work'],
['log_fail_change', $change],
['finish_work'],
], 'Should have logged just begin and finish';
$die = '';
is_deeply +MockOutput->get_info_literal, [[
' + foo ..', '..', ' ',
]], 'Output should reflect start of deployment';
is_deeply +MockOutput->get_info, [[__ 'not ok']],
'Output should acknowldge failure';
is_deeply +MockOutput->get_vent, [], 'Vent should be empty';
# Alright, disable verify now.
$engine->with_verify(0);
# Revert a change.
$change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan );
ok $engine->revert_change($change), 'Revert a change';
is_deeply $engine->seen, [
['begin_work'],
[run_file => $change->revert_file ],
[log_revert_change => $change ],
['finish_work'],
], 'revert_change should have called the proper methods';
is_deeply +MockOutput->get_info_literal, [[
' - users ..', '', ' '
]], 'Output should reflect reversion';
is_deeply +MockOutput->get_info, [[__ 'ok']],
'Output should acknowldge revert success';
# Revert with log-only.
ok $engine->log_only(1), 'Enable log_only';
ok $engine->revert_change($change), 'Revert a change with log-only';
is_deeply $engine->seen, [
['begin_work'],
[log_revert_change => $change ],
['finish_work'],
], 'Log-only revert_change should not have run the change script';
is_deeply +MockOutput->get_info_literal, [[
' - users ..', '', ' '
]], 'Output should reflect logged reversion';
is_deeply +MockOutput->get_info, [[__ 'ok']],
'Output should acknowldge revert success';
# Have the log throw an error.
$die = 'log_revert_change';
throws_ok { $engine->revert_change($change) }
'App::Sqitch::X', 'Should die on unknown revert logging error';
is $@->ident, 'revert', 'Sould have revert ident error';
is $@->message, 'Revert failed','Should get revert failure error message';
is_deeply $engine->seen, [
['begin_work'],
['finish_work'],
], 'Log failure should not have seen log_revert_change';
is_deeply +MockOutput->get_info_literal, [[
' - users ..', '', ' '
]], 'Output should reflect reversion';
is_deeply +MockOutput->get_info, [[__ 'not ok']],
'Output should acknowldge failure';
is_deeply +MockOutput->get_vent, [
['AAAH!'],
], 'The logging error should have been vented';
$die = '';
# Try a change with no revert file.
$change = App::Sqitch::Plan::Change->new( name => 'oops', plan => $target->plan );
throws_ok { $engine->revert_change($change) } 'App::Sqitch::X',
'Should die on missing revert script';
is $@->ident, 'revert', 'Sould have revert ident error';
is $@->message, __x(
'Revert script {file} does not exist',
file => $change->revert_file,
), 'Error should be from revert_change';
is_deeply $engine->seen, [
['begin_work'],
['finish_work'],
], 'Log failure should not have seen log_revert_change';
is_deeply +MockOutput->get_info_literal, [[
' - oops ..', '.', ' '
]], 'Output should reflect revert start';
is_deeply +MockOutput->get_info, [[__ 'not ok']],
'Output should acknowldge failure';
is_deeply +MockOutput->get_vent, [], 'Should have vented nothing';
$record_work = 0;
##############################################################################
# Test earliest_change() and latest_change().
chdir 't';
my $plan_file = file qw(sql sqitch.plan);
my $sqitch_old = $sqitch; # Hang on to this because $change does not retain it.
$config->update(
'core.top_dir' => 'sql',
'core.plan_file' => $plan_file->stringify,
);
$sqitch = App::Sqitch->new(config => $config);
$target = App::Sqitch::Target->new( sqitch => $sqitch );
$change = App::Sqitch::Plan::Change->new( name => 'lolz', plan => $target->plan );
ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ),
'Engine with sqitch with plan file';
$plan = $target->plan;
my @changes = $plan->changes;
$latest_change_id = $changes[0]->id;
is $engine->latest_change, $changes[0], 'Should get proper change from latest_change()';
is_deeply $engine->seen, [[ latest_change_id => undef ]],
'Latest change ID should have been called with no arg';
$latest_change_id = $changes[2]->id;
is $engine->latest_change(2), $changes[2],
'Should again get proper change from latest_change()';
is_deeply $engine->seen, [[ latest_change_id => 2 ]],
'Latest change ID should have been called with offset arg';
$latest_change_id = undef;
$earliest_change_id = $changes[0]->id;
is $engine->earliest_change, $changes[0], 'Should get proper change from earliest_change()';
is_deeply $engine->seen, [[ earliest_change_id => undef ]],
'Earliest change ID should have been called with no arg';
$earliest_change_id = $changes[2]->id;
is $engine->earliest_change(4), $changes[2],
'Should again get proper change from earliest_change()';
is_deeply $engine->seen, [[ earliest_change_id => 4 ]],
'Earliest change ID should have been called with offset arg';
$earliest_change_id = undef;
##############################################################################
# Test _sync_plan()
can_ok $CLASS, '_sync_plan';
$engine->seen;
is $plan->position, -1, 'Plan should start at position -1';
is $engine->start_at, undef, 'start_at should be undef';
ok $engine->_sync_plan, 'Sync the plan';
is $plan->position, -1, 'Plan should still be at position -1';
is $engine->start_at, undef, 'start_at should still be undef';
$plan->position(4);
is_deeply $engine->seen, [['current_state', undef]],
'Should not have updated IDs or hashes';
ok $engine->_sync_plan, 'Sync the plan again';
is $plan->position, -1, 'Plan should again be at position -1';
is $engine->start_at, undef, 'start_at should again be undef';
is_deeply $engine->seen, [['current_state', undef]],
'Still should not have updated IDs or hashes';
# Have latest_item return a tag.
$latest_change_id = $changes[2]->id;
ok $engine->_sync_plan, 'Sync the plan to a tag';
is $plan->position, 2, 'Plan should now be at position 2';
is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta';
is_deeply $engine->seen, [
['current_state', undef],
['log_new_tags' => $plan->change_at(2)],
], 'Should have updated IDs';
# Have current_state return a script hash.
$script_hash = '550aeeab2ae39cba45840888b12a70820a2d6f83';
ok $engine->_sync_plan, 'Sync the plan with a random script hash';
is $plan->position, 2, 'Plan should now be at position 1';
is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta';
is_deeply $engine->seen, [
['current_state', undef],
['log_new_tags' => $plan->change_at(2)],
], 'Should have updated IDs but not hashes';
# Have current_state return the last deployed ID as script_hash.
$script_hash = $latest_change_id;
ok $engine->_sync_plan, 'Sync the plan with a random script hash';
is $plan->position, 2, 'Plan should now be at position 1';
is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta';
is_deeply $engine->seen, [
['current_state', undef],
['_update_script_hashes'],
['log_new_tags' => $plan->change_at(2)],
], 'Should have updated IDs and hashes';
# Return no change ID, now.
$script_hash = $latest_change_id = $changes[1]->id;
ok $engine->_sync_plan, 'Sync the plan';
is $plan->position, 1, 'Plan should be at position 1';
is $engine->start_at, 'users@alpha', 'start_at should be users@alpha';
is_deeply $engine->seen, [
['current_state', undef],
['_update_script_hashes'],
['log_new_tags' => $plan->change_at(1)],
], 'Should have updated hashes but not IDs';
# Have current_state return no script hash.
my $mock_whu = Test::MockModule->new('App::Sqitch::Engine::whu');
my $state = {change_id => $latest_change_id};
$mock_whu->mock(current_state => $state);
ok $engine->_sync_plan, 'Sync the plan with no script hash';
$mock_whu->unmock('current_state');
is $plan->position, 1, 'Plan should now be at position 1';
is $engine->start_at, 'users@alpha', 'start_at should still be users@alpha';
is_deeply $engine->seen, [
'upgrade_registry',
['_update_script_hashes'],
['log_new_tags' => $plan->change_at(1)],
], 'Should have ugpraded the registry';
is $state->{script_hash}, $latest_change_id,
'The script hash should have been set to the change ID';
# Have _no_registry return true.
$mock_engine->mock(_no_registry => 1);
ok $engine->_sync_plan, 'Sync the plan with no registry';
is $plan->position, -1, 'Plan should start at position -1';
$mock_engine->unmock('_no_registry');
##############################################################################
# Test deploy.
can_ok $CLASS, 'deploy';
$script_hash = undef;
$latest_change_id = undef;
$plan->reset;
$engine->seen;
@changes = $plan->changes;
# Mock the deploy methods to log which were called.
my $deploy_meth;
for my $meth (qw(_deploy_all _deploy_by_tag _deploy_by_change)) {
my $orig = $CLASS->can($meth);
$mock_engine->mock($meth => sub {
$deploy_meth = $meth;
$orig->(@_);
});
}
# Mock locking and dependency checking to add their calls to the seen stuff.
$mock_engine->mock( check_deploy_dependencies => sub {
shift->mock_check_deploy(@_);
});
$mock_engine->mock( check_revert_dependencies => sub {
shift->mock_check_revert(@_);
});
$mock_engine->mock(lock_destination => sub {
shift->mock_lock(@_);
});
ok $engine->deploy('@alpha'), 'Deploy to @alpha';
is $plan->position, 1, 'Plan should be at position 1';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'initialized',
'initialize',
'register_project',
[check_deploy_dependencies => [$plan, 1]],
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
], 'Should have deployed through @alpha';
is $deploy_meth, '_deploy_all', 'Should have called _deploy_all()';
is_deeply +MockOutput->get_info, [
[__x 'Adding registry tables to {destination}',
destination => $engine->registry_destination,
],
[__x 'Deploying changes through {change} to {destination}',
destination => $engine->destination,
change => $plan->get('@alpha')->format_name_with_tags,
],
[__ 'ok'],
[__ 'ok'],
], 'Should have seen the output of the deploy to @alpha';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '.......', ' '],
[' + users @alpha ..', '', ' '],
], 'Both change names should be output';
# Try with log-only in all modes.
for my $mode (qw(change tag all)) {
ok $engine->log_only(1), 'Enable log_only';
ok $engine->deploy('@alpha', $mode, 1), 'Log-only deploy in $mode mode to @alpha';
is $plan->position, 1, 'Plan should be at position 1';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'initialized',
'initialize',
'register_project',
[check_deploy_dependencies => [$plan, 1]],
[log_deploy_change => $changes[0]],
[log_deploy_change => $changes[1]],
], 'Should have deployed through @alpha without running files';
my $meth = $mode eq 'all' ? 'all' : ('by_' . $mode);
is $deploy_meth, "_deploy_$meth", "Should have called _deploy_$meth()";
is_deeply +MockOutput->get_info, [
[
__x 'Adding registry tables to {destination}',
destination => $engine->registry_destination,
],
[
__x 'Deploying changes through {change} to {destination}',
destination => $engine->destination,
change => $plan->get('@alpha')->format_name_with_tags,
],
[__ 'ok'],
[__ 'ok'],
], 'Should have seen the output of the deploy to @alpha';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '.......', ' '],
[' + users @alpha ..', '', ' '],
], 'Both change names should be output';
}
# Try with no need to initialize.
$initialized = 1;
$plan->reset;
$engine->log_only(0);
ok $engine->deploy('@alpha', 'tag'), 'Deploy to @alpha with tag mode';
is $plan->position, 1, 'Plan should again be at position 1';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'initialized',
'upgrade_registry',
'register_project',
[check_deploy_dependencies => [$plan, 1]],
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
], 'Should have deployed through @alpha without initialization';
is $deploy_meth, '_deploy_by_tag', 'Should have called _deploy_by_tag()';
is_deeply +MockOutput->get_info, [
[__x 'Deploying changes through {change} to {destination}',
destination => $engine->registry_destination,
change => $plan->get('@alpha')->format_name_with_tags,
],
[__ 'ok'],
[__ 'ok'],
], 'Should have seen the output of the deploy to @alpha';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '.......', ' '],
[' + users @alpha ..', '', ' '],
], 'Both change names should be output';
# Try a bogus change.
throws_ok { $engine->deploy('nonexistent') } 'App::Sqitch::X',
'Should get an error for an unknown change';
is $@->message, __x(
'Unknown change: "{change}"',
change => 'nonexistent',
), 'The exception should report the unknown change';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
], 'Only latest_item() should have been called';
# Start with @alpha.
$latest_change_id = ($changes[1]->tags)[0]->id;
ok $engine->deploy('@alpha'), 'Deploy to alpha thrice';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
['log_new_tags' => $changes[1]],
], 'Only latest_item() should have been called';
is_deeply +MockOutput->get_info, [
[__x 'Nothing to deploy (already at "{change}")', change => '@alpha'],
], 'Should notify user that already at @alpha';
# Start with widgets.
$latest_change_id = $changes[2]->id;
throws_ok { $engine->deploy('@alpha') } 'App::Sqitch::X',
'Should fail deploying older change';
is $@->ident, 'deploy', 'Should be a "deploy" error';
is $@->message, __ 'Cannot deploy to an earlier change; use "revert" instead',
'It should suggest using "revert"';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
['log_new_tags' => $changes[2]],
], 'Should have called latest_item() and latest_tag()';
# Make sure that it upgrades the registry when deploying on existing changes.
$latest_change_id = undef;
my $mock_plan = Test::MockModule->new(ref $plan);
my $orig_pos_meth;
my @pos_vals = (1, 1);
$mock_plan->mock(position => sub { return @pos_vals ? shift @pos_vals : $orig_pos_meth->($_[0]) });
$orig_pos_meth = $mock_plan->original('position');
ok $engine->deploy(), 'Deploy to from index 1';
$mock_plan->unmock('position');
is $plan->position, 2, 'Plan should be at position 2';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'upgrade_registry',
[check_deploy_dependencies => [$plan, 2]],
], 'Should have deployed to change 2';
is_deeply +MockOutput->get_info, [
[__x 'Deploying changes to {destination}', destination => $engine->destination ],
], 'Should have emitted deploy announcement and successes';
# Make sure we can deploy everything by change.
MockOutput->clear;
$latest_change_id = undef;
$plan->reset;
$plan->add( name => 'lolz', note => 'ha ha' );
@changes = $plan->changes;
ok $engine->deploy(undef, 'change'), 'Deploy everything by change';
is $plan->position, 3, 'Plan should be at position 3';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'initialized',
'upgrade_registry',
'register_project',
[check_deploy_dependencies => [$plan, 3]],
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
[run_file => $changes[2]->deploy_file],
[log_deploy_change => $changes[2]],
[run_file => $changes[3]->deploy_file],
[log_deploy_change => $changes[3]],
], 'Should have deployed everything';
is $deploy_meth, '_deploy_by_change', 'Should have called _deploy_by_change()';
is_deeply +MockOutput->get_info, [
[__x 'Deploying changes to {destination}', destination => $engine->destination ],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
], 'Should have emitted deploy announcement and successes';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
], 'Should have seen the output of the deploy to the end';
is_deeply +MockOutput->get_debug, [
[__ 'Will deploy the following changes:' ],
['roles'],
['users @alpha'],
['widgets @beta'],
['lolz'],
], 'Debug output should show what will be deployed';
# If we deploy again, it should be up-to-date.
$latest_change_id = $changes[-1]->id;
ok $engine->deploy, 'Should return success for deploy to up-to-date DB';
is_deeply +MockOutput->get_info, [
[__ 'Nothing to deploy (up-to-date)' ],
], 'Should have emitted deploy announcement and successes';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
], 'It should have just fetched the latest change ID';
$latest_change_id = undef;
# Try invalid mode.
throws_ok { $engine->deploy(undef, 'evil_mode') } 'App::Sqitch::X',
'Should fail on invalid mode';
is $@->ident, 'deploy', 'Should be a "deploy" error';
is $@->message, __x('Unknown deployment mode: "{mode}"', mode => 'evil_mode'),
'And the message should reflect the unknown mode';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
'initialized',
'upgrade_registry',
'register_project',
[check_deploy_dependencies => [$plan, 3]],
], 'It should have check for initialization';
is_deeply +MockOutput->get_info, [
[__x 'Deploying changes to {destination}', destination => $engine->destination ],
], 'Should have announced destination';
# Try a plan with no changes.
NOSTEPS: {
my $plan_file = file qw(empty.plan);
my $fh = $plan_file->open('>') or die "Cannot open $plan_file: $!";
say $fh '%project=empty';
$fh->close or die "Error closing $plan_file: $!";
END { $plan_file->remove }
$config->update('core.plan_file' => $plan_file->stringify);
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(sqitch => $sqitch );
ok my $engine = App::Sqitch::Engine::whu->new(
sqitch => $sqitch,
target => $target,
), 'Engine with sqitch with no file';
$engine->max_name_length(10);
throws_ok { $engine->deploy } 'App::Sqitch::X', 'Should die with no changes';
is $@->message, __"Nothing to deploy (empty plan)",
'Should have the localized message';
is_deeply $engine->seen, [
[lock_destination => []],
[current_state => undef],
], 'It should have checked for the latest item';
}
##############################################################################
# Test _deploy_by_change()
$engine = App::Sqitch::Engine::whu->new(sqitch => $sqitch, target => $target);
$plan->reset;
$mock_engine->unmock('_deploy_by_change');
$engine->max_name_length(
max map {
length $_->format_name_with_tags
} $plan->changes
);
ok $engine->_deploy_by_change($plan, 1), 'Deploy changewise to index 1';
is_deeply $engine->seen, [
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
], 'Should changewise deploy to index 2';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
], 'Should have seen output of each change';
is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']],
'Output should reflect deploy successes';
ok $engine->_deploy_by_change($plan, 3), 'Deploy changewise to index 2';
is_deeply $engine->seen, [
[run_file => $changes[2]->deploy_file],
[log_deploy_change => $changes[2]],
[run_file => $changes[3]->deploy_file],
[log_deploy_change => $changes[3]],
], 'Should changewise deploy to from index 2 to index 3';
is_deeply +MockOutput->get_info_literal, [
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
], 'Should have seen output of changes 2-3';
is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']],
'Output should reflect deploy successes';
# Make it die.
$plan->reset;
$die = 'run_file';
throws_ok { $engine->_deploy_by_change($plan, 2) } 'App::Sqitch::X',
'Die in _deploy_by_change';
is $@->message, 'AAAH!', 'It should have died in run_file';
is_deeply $engine->seen, [
[log_fail_change => $changes[0] ],
], 'It should have logged the failure';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
], 'Should have seen output for first change';
is_deeply +MockOutput->get_info, [[__ 'not ok']],
'Output should reflect deploy failure';
$die = '';
##############################################################################
# Test _deploy_by_tag().
$plan->reset;
$mock_engine->unmock('_deploy_by_tag');
ok $engine->_deploy_by_tag($plan, 1), 'Deploy tagwise to index 1';
is_deeply $engine->seen, [
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
], 'Should tagwise deploy to index 1';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
], 'Should have seen output of each change';
is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']],
'Output should reflect deploy successes';
ok $engine->_deploy_by_tag($plan, 3), 'Deploy tagwise to index 3';
is_deeply $engine->seen, [
[run_file => $changes[2]->deploy_file],
[log_deploy_change => $changes[2]],
[run_file => $changes[3]->deploy_file],
[log_deploy_change => $changes[3]],
], 'Should tagwise deploy from index 2 to index 3';
is_deeply +MockOutput->get_info_literal, [
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
], 'Should have seen output of changes 3-3';
is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']],
'Output should reflect deploy successes';
# Add another couple of changes.
$plan->add(name => 'tacos' );
$plan->add(name => 'curry' );
@changes = $plan->changes;
# Make it die.
$plan->position(1);
$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] });
throws_ok { $engine->_deploy_by_tag($plan, $#changes) } 'App::Sqitch::X',
'Die in log_deploy_change';
is $@->message, __('Deploy failed'), 'Should get final deploy failure message';
is_deeply $engine->seen, [
[run_file => $changes[2]->deploy_file],
[run_file => $changes[3]->deploy_file],
[run_file => $changes[4]->deploy_file],
[run_file => $changes[5]->deploy_file],
[run_file => $changes[5]->revert_file],
[log_fail_change => $changes[5] ],
[run_file => $changes[4]->revert_file],
[log_revert_change => $changes[4]],
[run_file => $changes[3]->revert_file],
[log_revert_change => $changes[3]],
], 'It should have reverted back to the last deployed tag';
is_deeply +MockOutput->get_info_literal, [
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
[' + tacos ..', '........', ' '],
[' + curry ..', '........', ' '],
[' - tacos ..', '........', ' '],
[' - lolz ..', '.........', ' '],
], 'Should have seen deploy and revert messages (excluding curry revert)';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failure';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__x 'Reverting to {change}', change => 'widgets @beta']
], 'The original error should have been vented';
$mock_whu->unmock('log_deploy_change');
# Make it die with log-only.
$plan->position(1);
ok $engine->log_only(1), 'Enable log_only';
$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] });
throws_ok { $engine->_deploy_by_tag($plan, $#changes, 1) } 'App::Sqitch::X',
'Die in log_deploy_change log-only';
is $@->message, __('Deploy failed'), 'Should get final deploy failure message';
is_deeply $engine->seen, [
[log_fail_change => $changes[5] ],
[log_revert_change => $changes[4]],
[log_revert_change => $changes[3]],
], 'It should have run no deploy or revert scripts';
is_deeply +MockOutput->get_info_literal, [
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
[' + tacos ..', '........', ' '],
[' + curry ..', '........', ' '],
[' - tacos ..', '........', ' '],
[' - lolz ..', '.........', ' '],
], 'Should have seen deploy and revert messages (excluding curry revert)';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failure';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__x 'Reverting to {change}', change => 'widgets @beta']
], 'The original error should have been vented';
$mock_whu->unmock('log_deploy_change');
# Now have it fail back to the beginning.
$plan->reset;
$engine->log_only(0);
$mock_whu->mock(run_file => sub { die 'ROFL' if $_[1]->basename eq 'users.sql' });
throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_by_tag again';
is $@->message, __('Deploy failed'), 'Should again get final deploy failure message';
is_deeply $engine->seen, [
[log_deploy_change => $changes[0]],
[log_fail_change => $changes[1]],
[log_revert_change => $changes[0]],
], 'Should have logged back to the beginning';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'Should have seen deploy and revert messages';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failure';
my $vented = MockOutput->get_vent;
is @{ $vented }, 2, 'Should have one vented message';
my $errmsg = shift @{ $vented->[0] };
like $errmsg, qr/^ROFL\b/, 'And it should be the underlying error';
is_deeply $vented, [
[],
[__ 'Reverting all changes'],
], 'And it should had notified that all changes were reverted';
# Add a change and deploy to that, to make sure it rolls back any changes since
# last tag.
$plan->add(name => 'dr_evil' );
@changes = $plan->changes;
$plan->reset;
$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' });
throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_by_tag yet again';
is $@->message, __('Deploy failed'), 'Should die "Deploy failed" again';
is_deeply $engine->seen, [
[log_deploy_change => $changes[0]],
[log_deploy_change => $changes[1]],
[log_deploy_change => $changes[2]],
[log_deploy_change => $changes[3]],
[log_deploy_change => $changes[4]],
[log_deploy_change => $changes[5]],
[log_fail_change => $changes[6]],
[log_revert_change => $changes[5] ],
[log_revert_change => $changes[4] ],
[log_revert_change => $changes[3] ],
], 'Should have reverted back to last tag';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' + widgets @beta ..', '', ' '],
[' + lolz ..', '.........', ' '],
[' + tacos ..', '........', ' '],
[' + curry ..', '........', ' '],
[' + dr_evil ..', '......', ' '],
[' - curry ..', '........', ' '],
[' - tacos ..', '........', ' '],
[' - lolz ..', '.........', ' '],
], 'Should have user change reversion messages';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failure';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__x 'Reverting to {change}', change => 'widgets @beta']
], 'Should see underlying error and reversion message';
# Make it choke on change reversion.
$mock_whu->unmock_all;
$die = '';
$plan->reset;
$mock_whu->mock(run_file => sub {
hurl 'ROFL' if $_[1] eq $changes[1]->deploy_file;
hurl 'BARF' if $_[1] eq $changes[0]->revert_file;
});
$mock_whu->mock(start_at => 'whatever');
throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_by_tag again';
is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message';
is_deeply $engine->seen, [
[log_deploy_change => $changes[0] ],
[log_fail_change => $changes[1] ],
], 'Should have tried to revert one change';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'Should have seen revert message';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'not ok' ],
[__ 'not ok' ],
], 'Output should reflect deploy successes and failure';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__x 'Reverting to {change}', change => 'whatever'],
['BARF'],
[__ 'The schema will need to be manually repaired']
], 'Should get reversion failure message';
$mock_whu->unmock_all;
##############################################################################
# Test _deploy_all().
$plan->reset;
$mock_engine->unmock('_deploy_all');
ok $engine->_deploy_all($plan, 1), 'Deploy all to index 1';
is_deeply $engine->seen, [
[run_file => $changes[0]->deploy_file],
[log_deploy_change => $changes[0]],
[run_file => $changes[1]->deploy_file],
[log_deploy_change => $changes[1]],
], 'Should tagwise deploy to index 1';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
], 'Should have seen output of each change';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes';
ok $engine->_deploy_all($plan, 2), 'Deploy tagwise to index 2';
is_deeply $engine->seen, [
[run_file => $changes[2]->deploy_file],
[log_deploy_change => $changes[2]],
], 'Should tagwise deploy to from index 1 to index 2';
is_deeply +MockOutput->get_info_literal, [
[' + widgets @beta ..', '', ' '],
], 'Should have seen output of changes 3-4';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
], 'Output should reflect deploy successe';
# Make it die.
$plan->reset;
$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] });
throws_ok { $engine->_deploy_all($plan, 3) } 'App::Sqitch::X',
'Die in _deploy_all';
is $@->message, __('Deploy failed'), 'Should get final deploy failure message';
$mock_whu->unmock('log_deploy_change');
is_deeply $engine->seen, [
[run_file => $changes[0]->deploy_file],
[run_file => $changes[1]->deploy_file],
[run_file => $changes[2]->deploy_file],
[run_file => $changes[2]->revert_file],
[log_fail_change => $changes[2]],
[run_file => $changes[1]->revert_file],
[log_revert_change => $changes[1]],
[run_file => $changes[0]->revert_file],
[log_revert_change => $changes[0]],
], 'It should have logged up to the failure';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' + widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'Should have seen deploy and revert messages excluding revert for failed logging';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failures';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__ 'Reverting all changes'],
], 'The original error should have been vented';
$die = '';
# Make it die with log-only.
$plan->reset;
ok $engine->log_only(1), 'Enable log_only';
$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] });
throws_ok { $engine->_deploy_all($plan, 3, 1) } 'App::Sqitch::X',
'Die in log-only _deploy_all';
is $@->message, __('Deploy failed'), 'Should get final deploy failure message';
$mock_whu->unmock('log_deploy_change');
is_deeply $engine->seen, [
[log_fail_change => $changes[2]],
[log_revert_change => $changes[1]],
[log_revert_change => $changes[0]],
], 'It should have run no deploys or reverts';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' + widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'Should have seen deploy and revert messages excluding revert for failed logging';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failures';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__ 'Reverting all changes'],
], 'The original error should have been vented';
$die = '';
# Now have it fail on a later change, should still go all the way back.
$plan->reset;
$engine->log_only(0);
$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'widgets.sql' });
throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_all again';
is $@->message, __('Deploy failed'), 'Should again get final deploy failure message';
is_deeply $engine->seen, [
[log_deploy_change => $changes[0]],
[log_deploy_change => $changes[1]],
[log_fail_change => $changes[2]],
[log_revert_change => $changes[1]],
[log_revert_change => $changes[0]],
], 'Should have reveted all changes and tags';
is_deeply +MockOutput->get_info_literal, [
[' + roles ..', '........', ' '],
[' + users @alpha ..', '.', ' '],
[' + widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'Should see all changes revert';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failures';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__ 'Reverting all changes'],
], 'Should notifiy user of error and rollback';
# Die when starting from a later point.
$plan->position(2);
$engine->start_at('@alpha');
$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' });
throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_all on the last change';
is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message';
is_deeply $engine->seen, [
[log_deploy_change => $changes[3]],
[log_deploy_change => $changes[4]],
[log_deploy_change => $changes[5]],
[log_fail_change => $changes[6]],
[log_revert_change => $changes[5]],
[log_revert_change => $changes[4]],
[log_revert_change => $changes[3]],
], 'Should have deployed to dr_evil and revered down to @alpha';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' '],
[' + tacos ..', '........', ' '],
[' + curry ..', '........', ' '],
[' + dr_evil ..', '......', ' '],
[' - curry ..', '........', ' '],
[' - tacos ..', '........', ' '],
[' - lolz ..', '.........', ' '],
], 'Should see changes revert back to @alpha';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failures';
is_deeply +MockOutput->get_vent, [
['ROFL'],
[__x 'Reverting to {change}', change => '@alpha'],
], 'Should notifiy user of error and rollback to @alpha';
# Die with a string rather than an exception.
$plan->position(2);
$engine->start_at('@alpha');
$mock_whu->mock(run_file => sub { die 'Oops' if $_[1]->basename eq 'dr_evil.sql' });
throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X',
'Die in _deploy_all on the last change';
is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message';
is_deeply $engine->seen, [
[log_deploy_change => $changes[3]],
[log_deploy_change => $changes[4]],
[log_deploy_change => $changes[5]],
[log_fail_change => $changes[6]],
[log_revert_change => $changes[5]],
[log_revert_change => $changes[4]],
[log_revert_change => $changes[3]],
], 'Should have deployed to dr_evil and revered down to @alpha';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' '],
[' + tacos ..', '........', ' '],
[' + curry ..', '........', ' '],
[' + dr_evil ..', '......', ' '],
[' - curry ..', '........', ' '],
[' - tacos ..', '........', ' '],
[' - lolz ..', '.........', ' '],
], 'Should see changes revert back to @alpha';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'not ok' ],
[__ 'ok' ],
[__ 'ok' ],
[__ 'ok' ],
], 'Output should reflect deploy successes and failures';
$vented = MockOutput->get_vent;
is @{ $vented }, 2, 'Should have two vented items';
like $vented->[0][0], qr/Oops/, 'First vented should be the error';
is_deeply $vented->[1], [__x 'Reverting to {change}', change => '@alpha'],
'Should notifiy user of rollback to @alpha';
$mock_whu->unmock_all;
##############################################################################
# Test is_deployed().
my $tag = App::Sqitch::Plan::Tag->new(
name => 'foo',
change => $change,
plan => $target->plan,
);
$is_deployed_tag = $is_deployed_change = 1;
ok $engine->is_deployed($tag), 'Test is_deployed(tag)';
is_deeply $engine->seen, [
[is_deployed_tag => $tag],
], 'It should have called is_deployed_tag()';
ok $engine->is_deployed($change), 'Test is_deployed(change)';
is_deeply $engine->seen, [
[is_deployed_change => $change],
], 'It should have called is_deployed_change()';
##############################################################################
# Test deploy_change.
can_ok $engine, 'deploy_change';
ok $engine->deploy_change($change), 'Deploy a change';
is_deeply $engine->seen, [
[run_file => $change->deploy_file],
[log_deploy_change => $change],
], 'It should have been deployed';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' ']
], 'Should have shown change name';
is_deeply +MockOutput->get_info, [
[__ 'ok' ],
], 'Output should reflect deploy success';
# Make the logging die.
$mock_whu->mock(log_deploy_change => sub { hurl test => 'OHNO' });
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploying change should die on logging failure';
is $@->ident, 'private', 'Should have privat ident';
is $@->message, __('Deploy failed'), 'Should have failure message';
is_deeply $engine->seen, [
[run_file => $change->deploy_file],
[run_file => $change->revert_file],
['log_fail_change', $change],
], 'It should have been deployed and reverted';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' ']
], 'Should have shown change name';
is_deeply +MockOutput->get_info, [
[__ 'not ok' ],
], 'Output should reflect deploy failure';
is_deeply +MockOutput->get_vent, [
['OHNO']
], 'Vent should reflect deployment error';
# Also make the revert fail.
$mock_whu->mock('run_revert' => sub { hurl test => 'NO REVERT' });
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Deploying change should die on logging failure';
is $@->ident, 'private', 'Should have privat ident';
is $@->message, __('Deploy failed'), 'Should have failure message';
is_deeply $engine->seen, [
[run_file => $change->deploy_file],
['log_fail_change', $change],
], 'It should have been deployed but not reverted';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' ']
], 'Should have shown change name';
is_deeply +MockOutput->get_info, [
[__ 'not ok' ],
], 'Output should reflect deploy failure';
is_deeply +MockOutput->get_vent, [
['OHNO'],
['NO REVERT'],
], 'Vent should reflect deployment and reversion errors';
# Unmock.
$mock_whu->unmock('log_deploy_change');
$mock_whu->unmock('run_revert');
my $make_deps = sub {
my $conflicts = shift;
return map {
my $dep = App::Sqitch::Plan::Depend->new(
change => $_,
plan => $plan,
project => $plan->project,
conflicts => $conflicts,
);
$dep;
} @_;
};
DEPLOYDIE: {
my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend');
$mock_depend->mock(id => sub { undef });
# Now make it die on the actual deploy.
$die = 'log_deploy_change';
my @requires = $make_deps->( 0, qw(foo bar) );
my @conflicts = $make_deps->( 1, qw(dr_evil) );
my $change = App::Sqitch::Plan::Change->new(
name => 'lolz',
plan => $target->plan,
requires => \@requires,
conflicts => \@conflicts,
);
throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X',
'Shuld die on deploy failure';
is $@->message, __ 'Deploy failed', 'Should be told the deploy failed';
is_deeply $engine->seen, [
[run_file => $change->deploy_file],
[run_file => $change->revert_file],
[log_fail_change => $change],
], 'It should failed to have been deployed';
is_deeply +MockOutput->get_vent, [
['AAAH!'],
], 'Should have vented the original error';
is_deeply +MockOutput->get_info_literal, [
[' + lolz ..', '.........', ' '],
], 'Should have shown change name';
is_deeply +MockOutput->get_info, [
[__ 'not ok' ],
], 'Output should reflect deploy failure';
$die = '';
}
##############################################################################
# Test revert_change().
can_ok $engine, 'revert_change';
ok $engine->revert_change($change), 'Revert the change';
is_deeply $engine->seen, [
[run_file => $change->revert_file],
[log_revert_change => $change],
], 'It should have been reverted';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '.........', ' ']
], 'Should have shown reverted change name';
is_deeply +MockOutput->get_info, [
[__ 'ok'],
], 'And the revert failure should be "ok"';
##############################################################################
# Test revert().
can_ok $engine, 'revert';
$engine->plan($plan);
# Start with no deployed IDs.
@deployed_changes = ();
ok $engine->revert(undef, 1, 1),
'Should return success for no changes to revert';
is_deeply +MockOutput->get_info, [
[__ 'Nothing to revert (nothing deployed)']
], 'Should have notified that there is nothing to revert';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
], 'It should only have called deployed_changes()';
is_deeply +MockOutput->get_info, [], 'Nothing should have been output';
# Make sure deprecation warning happens.
# Test only the first line of the warning. Reason:
# https://github.com/hanfried/test-warn/issues/9
warning_is { $engine->revert }
"Engine::revert() requires the `prompt` and `prompt_default` arguments.\n",
'Should get warning omitting required arguments';
is_deeply +MockOutput->get_info, [
[__ 'Nothing to revert (nothing deployed)']
], 'Should have notified that there is nothing to revert';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
], 'It should only have called deployed_changes()';
is_deeply +MockOutput->get_info, [], 'Nothing should have been output';
# Try reverting to an unknown change.
throws_ok { $engine->revert('nonexistent', 1, 1) } 'App::Sqitch::X',
'Revert should die on unknown change';
is $@->ident, 'revert', 'Should be another "revert" error';
is $@->message, __x(
'Unknown change: "{change}"',
change => 'nonexistent',
), 'The message should mention it is an unknown change';
is_deeply $engine->seen, [ [lock_destination => []], ['change_id_for', {
change_id => undef,
change => 'nonexistent',
tag => undef,
project => 'sql',
}]], 'Should have called change_id_for() with change name';
is_deeply +MockOutput->get_info, [], 'Nothing should have been output';
# Try reverting to an unknown change ID.
throws_ok { $engine->revert('8d77c5f588b60bc0f2efcda6369df5cb0177521d', 1, 1) } 'App::Sqitch::X',
'Revert should die on unknown change ID';
is $@->ident, 'revert', 'Should be another "revert" error';
is $@->message, __x(
'Unknown change: "{change}"',
change => '8d77c5f588b60bc0f2efcda6369df5cb0177521d',
), 'The message should mention it is an unknown change';
is_deeply $engine->seen, [ [lock_destination => []], ['change_id_for', {
change_id => '8d77c5f588b60bc0f2efcda6369df5cb0177521d',
change => undef,
tag => undef,
project => 'sql',
}]], 'Should have called change_id_for() with change ID';
is_deeply +MockOutput->get_info, [], 'Nothing should have been output';
# Revert an undeployed change.
throws_ok { $engine->revert('@alpha', 1, 1) } 'App::Sqitch::X',
'Revert should die on undeployed change';
is $@->ident, 'revert', 'Should be another "revert" error';
is $@->message, __x(
'Change not deployed: "{change}"',
change => '@alpha',
), 'The message should mention that the change is not deployed';
is_deeply $engine->seen, [ [lock_destination => []], ['change_id_for', {
change => '',
change_id => undef,
tag => 'alpha',
project => 'sql',
}]], 'change_id_for';
is_deeply +MockOutput->get_info, [], 'Nothing should have been output';
# Revert to a point with no following changes.
$offset_change = $changes[0];
push @resolved => $offset_change->id;
ok $engine->revert($changes[0]->id, 1, 1),
'Should return success for revert even with no changes';
is_deeply +MockOutput->get_info, [
[__x(
'No changes deployed since: "{change}"',
change => $changes[0]->id,
)]
], 'No subsequent change error message should be correct';
delete $changes[0]->{_rework_tags}; # For deep comparison.
is_deeply $engine->seen, [
[lock_destination => []],
[change_id_for => {
change_id => $changes[0]->id,
change => undef,
tag => undef,
project => 'sql',
}],
[ change_offset_from_id => [$changes[0]->id, 0] ],
[deployed_changes_since => $changes[0]],
], 'Should have called change_id_for and deployed_changes_since';
# Revert with nothing deployed.
ok $engine->revert(undef, 1, 1),
'Should return success for known but undeployed change';
is_deeply +MockOutput->get_info, [
[__ 'Nothing to revert (nothing deployed)']
], 'No changes message should be correct';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
], 'Should have called deployed_changes';
# Now revert from a deployed change.
my @dbchanges;
@deployed_changes = map {
my $plan_change = $_;
my $params = {
id => $plan_change->id,
name => $plan_change->name,
project => $plan_change->project,
note => $plan_change->note,
planner_name => $plan_change->planner_name,
planner_email => $plan_change->planner_email,
timestamp => $plan_change->timestamp,
tags => [ map { $_->name } $plan_change->tags ],
};
push @dbchanges => my $db_change = App::Sqitch::Plan::Change->new(
plan => $plan,
%{ $params },
);
$db_change->add_tag( App::Sqitch::Plan::Tag->new(
name => $_->name, plan => $plan, change => $db_change
) ) for $plan_change->tags;
$db_change->tags; # Autovivify _tags For changes with no tags.
$params;
} @changes[0..3];
MockOutput->clear;
MockOutput->ask_yes_no_returns(1);
is $engine->revert(undef, 1, 1), $engine, 'Revert all changes';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
[check_revert_dependencies => [reverse @dbchanges[0..3]] ],
[run_file => $dbchanges[3]->revert_file ],
[log_revert_change => $dbchanges[3] ],
[run_file => $dbchanges[2]->revert_file ],
[log_revert_change => $dbchanges[2] ],
[run_file => $dbchanges[1]->revert_file ],
[log_revert_change => $dbchanges[1] ],
[run_file => $dbchanges[0]->revert_file ],
[log_revert_change => $dbchanges[0] ],
], 'Should have reverted the changes in reverse order';
is_deeply +MockOutput->get_ask_yes_no, [
[__x(
'Revert all changes from {destination}?',
destination => $engine->destination,
), 1],
], 'Should have prompted to revert all changes';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '.........', ' '],
[' - widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'It should have said it was reverting all changes and listed them';
is_deeply +MockOutput->get_debug, [
[__ 'Would revert the following changes:'],
['roles'],
['users @alpha'],
['widgets @beta'],
['lolz'],
], 'Output should show what would be reverted';
is_deeply +MockOutput->get_info, [
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
], 'And the revert successes should be emitted';
# Try with log-only.
ok $engine->log_only(1), 'Enable log_only';
ok $engine->revert(undef, 1, 1), 'Revert all changes log-only';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
[check_revert_dependencies => [reverse @dbchanges[0..3]] ],
[log_revert_change => $dbchanges[3] ],
[log_revert_change => $dbchanges[2] ],
[log_revert_change => $dbchanges[1] ],
[log_revert_change => $dbchanges[0] ],
], 'Log-only Should have reverted the changes in reverse order';
is_deeply +MockOutput->get_ask_yes_no, [
[__x(
'Revert all changes from {destination}?',
destination => $engine->destination,
), 1],
], 'Log-only should have prompted to revert all changes';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '.........', ' '],
[' - widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'It should have said it was reverting all changes and listed them';
is_deeply +MockOutput->get_debug, [
[__ 'Would revert the following changes:'],
['roles'],
['users @alpha'],
['widgets @beta'],
['lolz'],
], 'Output should show what would be reverted';
is_deeply +MockOutput->get_info, [
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
], 'And the revert successes should be emitted';
# Should exit if the revert is declined.
MockOutput->ask_yes_no_returns(0);
throws_ok { $engine->revert(undef, 1, 1) } 'App::Sqitch::X', 'Should abort declined revert';
is $@->ident, 'revert', 'Declined revert ident should be "revert"';
is $@->exitval, 1, 'Should have exited with value 1';
is $@->message, __ 'Nothing reverted', 'Should have exited with proper message';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
], 'Should have called deployed_changes only';
is_deeply +MockOutput->get_ask_yes_no, [
[__x(
'Revert all changes from {destination}?',
destination => $engine->destination,
), 1],
], 'Should have prompt to revert all changes';
is_deeply +MockOutput->get_debug, [
[__ 'Would revert the following changes:'],
['roles'],
['users @alpha'],
['widgets @beta'],
['lolz'],
], 'Output should show what would be reverted';
# Revert all changes with no prompt.
MockOutput->ask_yes_no_returns(1);
$engine->log_only(0);
ok $engine->revert(undef, 0, 1), 'Revert all changes with no prompt';
is_deeply $engine->seen, [
[lock_destination => []],
[deployed_changes => undef],
[check_revert_dependencies => [reverse @dbchanges[0..3]] ],
[run_file => $dbchanges[3]->revert_file ],
[log_revert_change => $dbchanges[3] ],
[run_file => $dbchanges[2]->revert_file ],
[log_revert_change => $dbchanges[2] ],
[run_file => $dbchanges[1]->revert_file ],
[log_revert_change => $dbchanges[1] ],
[run_file => $dbchanges[0]->revert_file ],
[log_revert_change => $dbchanges[0] ],
], 'Should have reverted the changes in reverse order';
is_deeply +MockOutput->get_ask_yes_no, [], 'Should have no prompt';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '.........', ' '],
[' - widgets @beta ..', '', ' '],
[' - users @alpha ..', '.', ' '],
[' - roles ..', '........', ' '],
], 'It should have said it was reverting all changes and listed them';
is_deeply +MockOutput->get_info, [
[__x(
'Reverting all changes from {destination}',
destination => $engine->destination,
)],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
[__ 'ok'],
], 'And the revert successes should be emitted';
is_deeply +MockOutput->get_debug, [
[__ 'Will revert the following changes:'],
['roles'],
['users @alpha'],
['widgets @beta'],
['lolz'],
], 'Output should show what will be reverted';
# Now just revert to an earlier change.
$offset_change = $dbchanges[1];
push @resolved => $offset_change->id;
@deployed_changes = @deployed_changes[2..3];
ok $engine->revert('@alpha', 1, 1), 'Revert to @alpha';
delete $dbchanges[1]->{_rework_tags}; # These need to be invisible.
is_deeply $engine->seen, [
[lock_destination => []],
[change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }],
[ change_offset_from_id => [$dbchanges[1]->id, 0] ],
[deployed_changes_since => $dbchanges[1]],
[check_revert_dependencies => [reverse @dbchanges[2..3]] ],
[run_file => $dbchanges[3]->revert_file ],
[log_revert_change => $dbchanges[3] ],
[run_file => $dbchanges[2]->revert_file ],
[log_revert_change => $dbchanges[2] ],
], 'Should have reverted only changes after @alpha';
is_deeply +MockOutput->get_ask_yes_no, [
[__x(
'Revert changes to {change} from {destination}?',
destination => $engine->destination,
change => $dbchanges[1]->format_name_with_tags,
), 1],
], 'Should have prompt to revert to change';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '.........', ' '],
[' - widgets @beta ..', '', ' '],
], 'Output should show what it reverts to';
is_deeply +MockOutput->get_debug, [
[__ 'Would revert the following changes:'],
['widgets @beta'],
['lolz'],
], 'Output should show what would be reverted';
is_deeply +MockOutput->get_info, [
[__ 'ok'],
[__ 'ok'],
], 'And the revert successes should be emitted';
MockOutput->ask_yes_no_returns(0);
$offset_change = $dbchanges[1];
push @resolved => $offset_change->id;
throws_ok { $engine->revert('@alpha', 1, 1) } 'App::Sqitch::X',
'Should abort declined revert to @alpha';
is $@->ident, 'revert:confirm', 'Declined revert ident should be "revert:confirm"';
is $@->exitval, 1, 'Should have exited with value 1';
is $@->message, __ 'Nothing reverted', 'Should have exited with proper message';
is_deeply $engine->seen, [
[lock_destination => []],
[change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }],
[change_offset_from_id => [$dbchanges[1]->id, 0] ],
[deployed_changes_since => $dbchanges[1]],
], 'Should have called revert methods';
is_deeply +MockOutput->get_ask_yes_no, [
[__x(
'Revert changes to {change} from {destination}?',
change => $dbchanges[1]->format_name_with_tags,
destination => $engine->destination,
), 1],
], 'Should have prompt to revert to @alpha';
is_deeply +MockOutput->get_debug, [
[__ 'Would revert the following changes:'],
['widgets @beta'],
['lolz'],
], 'Should emit a detailed prompt.';
# Try to revert just the last change with no prompt
MockOutput->ask_yes_no_returns(1);
my $rev_file = $dbchanges[-1]->revert_file; # Grab before deleting _rework_tags.
my $rtags = delete $dbchanges[-1]->{_rework_tags}; # These need to be invisible.
$offset_change = $dbchanges[-1];
push @resolved => $offset_change->id;
@deployed_changes = $deployed_changes[-1];
ok $engine->revert('@HEAD^', 0, 1), 'Revert to @HEAD^';
is_deeply $engine->seen, [
[lock_destination => []],
[change_id_for => { change_id => undef, change => '', tag => 'HEAD', project => 'sql' }],
[change_offset_from_id => [$dbchanges[-1]->id, -1] ],
[deployed_changes_since => $dbchanges[-1]],
[check_revert_dependencies => [{ %{ $dbchanges[-1] }, _rework_tags => $rtags }] ],
[run_file => $rev_file ],
[log_revert_change => { %{ $dbchanges[-1] }, _rework_tags => $rtags } ],
], 'Should have reverted one changes for @HEAD^';
is_deeply +MockOutput->get_ask_yes_no, [], 'Should have no prompt';
is_deeply +MockOutput->get_info_literal, [
[' - lolz ..', '', ' '],
], 'Output should show what it reverts to';
is_deeply +MockOutput->get_info, [
[__x(
'Reverting changes to {change} from {destination}',
destination => $engine->destination,
change => $dbchanges[-1]->format_name_with_tags,
)],
[__ 'ok'],
], 'And the header and "ok" should be emitted';
is_deeply +MockOutput->get_debug, [
[__ 'Will revert the following changes:'],
['lolz'],
], 'Output should show what will be reverted';
##############################################################################
# Test change_id_for_depend().
can_ok $CLASS, 'change_id_for_depend';
$offset_change = $dbchanges[1];
my ($dep) = $make_deps->( 1, 'foo' );
throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X',
'Should get error from change_id_for_depend when change not in plan';
is $@->ident, 'plan', 'Should get ident "plan" from change_id_for_depend';
is $@->message, __x(
'Unable to find change "{change}" in plan {file}',
change => $dep->key_name,
file => $target->plan_file,
), 'Should have proper message from change_id_for_depend error';
PLANOK: {
my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend');
$mock_depend->mock(id => sub { undef });
$mock_depend->mock(change => sub { undef });
throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X',
'Should get error from change_id_for_depend when no ID';
is $@->ident, 'engine', 'Should get ident "engine" when no ID';
is $@->message, __x(
'Invalid dependency: {dependency}',
dependency => $dep->as_string,
), 'Should have proper messag from change_id_for_depend error';
# Let it have the change.
$mock_depend->unmock('change');
push @resolved => $changes[1]->id;
is $engine->change_id_for_depend( $dep ), $changes[1]->id,
'Get a change id';
is_deeply $engine->seen, [
[change_id_for => {
change_id => $dep->id,
change => $dep->change,
tag => $dep->tag,
project => $dep->project,
first => 1,
}],
], 'Should have passed dependency params to change_id_for()';
}
##############################################################################
# Test find_change().
can_ok $CLASS, 'find_change';
push @resolved => $dbchanges[1]->id;
is $engine->find_change(
change_id => $resolved[0],
change => 'hi',
tag => 'yo',
), $dbchanges[1], 'find_change() should work';
is_deeply $engine->seen, [
[change_id_for => {
change_id => $dbchanges[1]->id,
change => 'hi',
tag => 'yo',
project => 'sql',
}],
[change_offset_from_id => [ $dbchanges[1]->id, undef ]],
], 'Its parameters should have been passed to change_id_for and change_offset_from_id';
# Pass a project and an ofset.
push @resolved => $dbchanges[1]->id;
is $engine->find_change(
change => 'hi',
offset => 1,
project => 'fred',
), $dbchanges[1], 'find_change() should work';
is_deeply $engine->seen, [
[change_id_for => {
change_id => undef,
change => 'hi',
tag => undef,
project => 'fred',
}],
[change_offset_from_id => [ $dbchanges[1]->id, 1 ]],
], 'Project and offset should have been passed off';
##############################################################################
# Test find_change_id().
can_ok $CLASS, 'find_change_id';
push @resolved => $dbchanges[1]->id;
is $engine->find_change_id(
change_id => $resolved[0],
change => 'hi',
tag => 'yo',
), $dbchanges[1]->id, 'find_change_id() should work';
is_deeply $engine->seen, [
[change_id_for => {
change_id => $dbchanges[1]->id,
change => 'hi',
tag => 'yo',
project => 'sql',
}],
[change_id_offset_from_id => [ $dbchanges[1]->id, undef ]],
], 'Its parameters should have been passed to change_id_for and change_offset_from_id';
# Pass a project and an ofset.
push @resolved => $dbchanges[1]->id;
is $engine->find_change_id(
change => 'hi',
offset => 1,
project => 'fred',
), $dbchanges[1]->id, 'find_change_id() should work';
is_deeply $engine->seen, [
[change_id_for => {
change_id => undef,
change => 'hi',
tag => undef,
project => 'fred',
}],
[change_id_offset_from_id => [ $dbchanges[1]->id, 1 ]],
], 'Project and offset should have been passed off';
##############################################################################
# Test verify_change().
can_ok $CLASS, 'verify_change';
$change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan );
ok $engine->verify_change($change), 'Verify a change';
is_deeply $engine->seen, [
[run_file => $change->verify_file ],
], 'The change file should have been run';
is_deeply +MockOutput->get_info, [], 'Should have no info output';
# Should raise an error when the verfiy fails script fails.
$mock_engine->mock(run_verify => sub { die 'OHNO' });
throws_ok { $engine->verify_change($change) } 'App::Sqitch::X',
'Should throw error on verify failure';
$mock_engine->unmock('run_verify');
is $@->ident, 'verify', 'Verify error ident should be "verify"';
like $@->previous_exception, qr/OHNO/, 'Previous exception should be captured';
is $@->message, __x(
'Verify script "{script}" failed.',
script => $change->verify_file
), 'Verify error message should be correct';
is_deeply $engine->seen, [], 'Should have seen not method calls';
is_deeply +MockOutput->get_info, [], 'Should have no info output';
# Try a change with no verify script.
$change = App::Sqitch::Plan::Change->new( name => 'roles', plan => $target->plan );
ok $engine->verify_change($change), 'Verify a change with no verify script.';
is_deeply $engine->seen, [], 'No abstract methods should be called';
is_deeply +MockOutput->get_info, [], 'Should have no info output';
is_deeply +MockOutput->get_vent, [
[__x 'Verify script {file} does not exist', file => $change->verify_file],
], 'A warning about no verify file should have been emitted';
##############################################################################
# Test check_deploy_dependenices().
$mock_engine->unmock('check_deploy_dependencies');
can_ok $engine, 'check_deploy_dependencies';
CHECK_DEPLOY_DEPEND: {
# Make sure dependencies check out for all the existing changes.
$plan->reset;
ok $engine->check_deploy_dependencies($plan),
'All planned changes should be okay';
is_deeply $engine->seen, [
[ are_deployed_changes => [map { $plan->change_at($_) } 0..$plan->count - 1] ],
], 'Should have called are_deployed_changes';
# Fail when some changes are already deployed.
my @deployed = map { $plan->change_at($_) } 0, 2;
@deployed_change_ids = map { $_->id } @deployed;
throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X',
'Should die when some changes deployed';
is $@->ident, 'deploy', 'Already deployed error ident should be "deploy"';
is $@->message, __nx(
'Change "{changes}" has already been deployed',
'Changes have already been deployed: {changes}',
scalar @deployed_change_ids,
changes => join(', ', map { $_->format_name_with_tags . " (" . $_->id . ")" } @deployed),
);
is_deeply $engine->seen, [
[ are_deployed_changes => [map { $plan->change_at($_) } 0..$plan->count - 1] ],
], 'Should have called are_deployed_changes';
@deployed_change_ids = ();
# Make sure it works when depending on a previous change.
my $change = $plan->change_at(3);
push @{ $change->_requires } => $make_deps->( 0, 'users' );
ok $engine->check_deploy_dependencies($plan),
'Dependencies should check out even when within those to be deployed';
is_deeply [ map { $_->resolved_id } map { $_->requires } $plan->changes ],
[ $plan->change_at(1)->id ],
'Resolved ID should be populated';
# Make sure it fails if there is a conflict within those to be deployed.
push @{ $change->_conflicts } => $make_deps->( 1, 'widgets' );
throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X',
'Conflict should throw exception';
is $@->ident, 'deploy', 'Should be a "deploy" error';
is $@->message, __nx(
'Conflicts with previously deployed change: {changes}',
'Conflicts with previously deployed changes: {changes}',
scalar 1,
changes => 'widgets',
), 'Should have localized message about the local conflict';
shift @{ $change->_conflicts };
# Now test looking stuff up in the database.
my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend');
my @depend_ids;
$mock_depend->mock(id => sub { shift @depend_ids });
my @conflicts = $make_deps->( 1, qw(foo bar) );
$change = App::Sqitch::Plan::Change->new(
name => 'foo',
plan => $target->plan,
conflicts => \@conflicts,
);
$plan->_changes->append($change);
my $start_from = $plan->count - 1;
$plan->position( $start_from - 1);
push @resolved, '2342', '253245';
throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X',
'Conflict should throw exception';
is $@->ident, 'deploy', 'Should be a "deploy" error';
is $@->message, __nx(
'Conflicts with previously deployed change: {changes}',
'Conflicts with previously deployed changes: {changes}',
scalar 2,
changes => 'foo bar',
), 'Should have localized message about conflicts';
is_deeply $engine->seen, [
[ are_deployed_changes => [map { $plan->change_at($_) } 0..$start_from-1] ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'bar',
tag => undef,
project => 'sql',
first => 1,
} ],
], 'Should have called change_id_for() twice';
is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef],
'Conflicting dependencies should have no resolved IDs';
# Fail with multiple conflicts.
push @{ $plan->change_at(3)->_conflicts } => $make_deps->( 1, 'widgets' );
$plan->reset;
push @depend_ids => $plan->change_at(2)->id;
push @resolved, '2342', '253245', '2323434';
throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X',
'Conflict should throw another exception';
is $@->ident, 'deploy', 'Should be a "deploy" error';
is $@->message, __nx(
'Conflicts with previously deployed change: {changes}',
'Conflicts with previously deployed changes: {changes}',
scalar 3,
changes => 'widgets foo bar',
), 'Should have localized message about all three conflicts';
is_deeply $engine->seen, [
[ change_id_for => {
change_id => undef,
change => 'users',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'bar',
tag => undef,
project => 'sql',
first => 1,
} ],
], 'Should have called change_id_for() twice';
is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef],
'Conflicting dependencies should have no resolved IDs';
##########################################################################
# Die on missing dependencies.
my @requires = $make_deps->( 0, qw(foo bar foo) );
$change = App::Sqitch::Plan::Change->new(
name => 'blah',
plan => $target->plan,
requires => \@requires,
);
$plan->_changes->append($change);
$start_from = $plan->count - 1;
$plan->position( $start_from - 1);
push @resolved, undef, undef;
throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X',
'Missing dependencies should throw exception';
is $@->ident, 'deploy', 'Should be another "deploy" error';
is $@->message, __nx(
'Missing required change: {changes}',
'Missing required changes: {changes}',
scalar 2,
changes => 'foo bar',
), 'Should have localized message missing dependencies without dupes';
is_deeply $engine->seen, [
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'bar',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
], 'Should have called check_requires';
is_deeply [ map { $_->resolved_id } @requires ], [undef, undef, undef],
'Missing requirements should not have resolved';
# Make sure we see both conflict and prereq failures.
push @resolved, '2342', '253245', '2323434', undef, undef;
$plan->reset;
throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X',
'Missing dependencies should throw exception';
is $@->ident, 'deploy', 'Should be another "deploy" error';
is $@->message, join(
"\n",
__nx(
'Conflicts with previously deployed change: {changes}',
'Conflicts with previously deployed changes: {changes}',
scalar 3,
changes => 'widgets foo',
),
__nx(
'Missing required change: {changes}',
'Missing required changes: {changes}',
scalar 2,
changes => 'foo bar',
),
), 'Should have localized conflicts and required error messages';
is_deeply $engine->seen, [
[ change_id_for => {
change_id => undef,
change => 'widgets',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'users',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'bar',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'bar',
tag => undef,
project => 'sql',
first => 1,
} ],
[ change_id_for => {
change_id => undef,
change => 'foo',
tag => undef,
project => 'sql',
first => 1,
} ],
], 'Should have called check_requires';
is_deeply [ map { $_->resolved_id } @requires ], [undef, undef, undef],
'Missing requirements should not have resolved';
}
# Test revert dependency-checking.
$mock_engine->unmock('check_revert_dependencies');
can_ok $engine, 'check_revert_dependencies';
CHECK_REVERT_DEPEND: {
my $change = App::Sqitch::Plan::Change->new(
name => 'urfa',
id => '24234234234e',
plan => $plan,
);
# First test with no dependencies.
@requiring = [];
ok $engine->check_revert_dependencies($change),
'Should get no error with no dependencies';
is_deeply $engine->seen, [
[changes_requiring_change => $change ],
], 'It should have check for requiring changes';
# Have revert change fail with requiring changes.
my $req = {
change_id => '23234234',
change => 'blah',
asof_tag => undef,
project => $plan->project,
};
@requiring = [$req];
throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X',
'Should get error reverting change another depend on';
is $@->ident, 'revert', 'Dependent error ident should be "revert"';
is $@->message, __nx(
'Change "{change}" required by currently deployed change: {changes}',
'Change "{change}" required by currently deployed changes: {changes}',
1,
change => 'urfa',
changes => 'blah'
), 'Dependent error message should be correct';
is_deeply $engine->seen, [
[changes_requiring_change => $change ],
], 'It should have check for requiring changes';
# Add a second requiring change.
my $req2 = {
change_id => '99999',
change => 'harhar',
asof_tag => '@foo',
project => 'elsewhere',
};
@requiring = [$req, $req2];
throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X',
'Should get error reverting change others depend on';
is $@->ident, 'revert', 'Dependent error ident should be "revert"';
is $@->message, __nx(
'Change "{change}" required by currently deployed change: {changes}',
'Change "{change}" required by currently deployed changes: {changes}',
2 ,
change => 'urfa',
changes => 'blah elsewhere:harhar@foo'
), 'Dependent error message should be correct';
is_deeply $engine->seen, [
[changes_requiring_change => $change ],
], 'It should have check for requiring changes';
# Try it with two changes.
my $req3 = {
change_id => '94949494',
change => 'frobisher',
project => 'whu',
};
@requiring = ([$req, $req2], [$req3]);
my $change2 = App::Sqitch::Plan::Change->new(
name => 'kazane',
id => '8686868686',
plan => $plan,
);
throws_ok { $engine->check_revert_dependencies($change, $change2) } 'App::Sqitch::X',
'Should get error reverting change others depend on';
is $@->ident, 'revert', 'Dependent error ident should be "revert"';
is $@->message, join(
"\n",
__nx(
'Change "{change}" required by currently deployed change: {changes}',
'Change "{change}" required by currently deployed changes: {changes}',
2 ,
change => 'urfa',
changes => 'blah elsewhere:harhar@foo'
),
__nx(
'Change "{change}" required by currently deployed change: {changes}',
'Change "{change}" required by currently deployed changes: {changes}',
1,
change => 'kazane',
changes => 'whu:frobisher'
),
), 'Dependent error message should be correct';
is_deeply $engine->seen, [
[changes_requiring_change => $change ],
[changes_requiring_change => $change2 ],
], 'It should have checked twice for requiring changes';
}
##############################################################################
# Test _trim_to().
can_ok $engine, '_trim_to';
# Should get an error when a change is not in the plan.
throws_ok { $engine->_trim_to( 'foo', 'nonexistent', [] ) } 'App::Sqitch::X',
'_trim_to should complain about a nonexistent change key';
is $@->ident, 'foo', '_trim_to nonexistent key error ident should be "foo"';
is $@->message, __x(
'Cannot find "{change}" in the database or the plan',
change => 'nonexistent',
), '_trim_to nonexistent key error message should be correct';
is_deeply $engine->seen, [
[ change_id_for => {
change => 'nonexistent',
change_id => undef,
project => 'sql',
tag => undef,
} ]
], 'It should have passed the change name and ROOT tag to change_id_for';
# Should get an error when it's in the plan but not the database.
throws_ok { $engine->_trim_to( 'yep', 'blah', [] ) } 'App::Sqitch::X',
'_trim_to should complain about an undeployed change key';
is $@->ident, 'yep', '_trim_to undeployed change error ident should be "yep"';
is $@->message, __x(
'Change "{change}" has not been deployed',
change => 'blah',
), '_trim_to undeployed change error message should be correct';
is_deeply $engine->seen, [
[ change_id_for => {
change => 'blah',
change_id => undef,
project => 'sql',
tag => undef,
} ]
], 'It should have passed change "blah" change_id_for';
# Should get an error when it's deployed but not in the plan.
@resolved = ('whatever');
throws_ok { $engine->_trim_to( 'oop', 'whatever', [] ) } 'App::Sqitch::X',
'_trim_to should complain about an unplanned change key';
is $@->ident, 'oop', '_trim_to unplanned change error ident should be "oop"';
is $@->message, __x(
'Change "{change}" is deployed, but not planned',
change => 'whatever',
), '_trim_to unplanned change error message should be correct';
is_deeply $engine->seen, [
[ change_id_for => {
change => 'whatever',
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => ['whatever', 0]],
], 'It should have passed "whatever" to change_id_offset_from_id';
# Let's mess with changes. Start by shifting nothing.
my $to_trim = [@changes];
@resolved = ($changes[0]->id);
my $key = $changes[0]->name;
is $engine->_trim_to('foo', $key, $to_trim), 0,
qq{_trim_to should find "$key" at index 0};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ],
'Changes should be untrimmed';
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[0]->id, 0]],
], 'It should have passed change 0 ID to change_id_offset_from_id';
# Try shifting to the third change.
$to_trim = [@changes];
@resolved = ($changes[2]->id);
$key = $changes[2]->name;
is $engine->_trim_to('foo', $key, $to_trim), 2,
qq{_trim_to should find "$key" at index 2};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ],
'First two changes should be shifted off';
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[2]->id, 0]],
], 'It should have passed change 2 ID to change_id_offset_from_id';
# Try popping nothing.
$to_trim = [@changes];
@resolved = ($changes[-1]->id);
$key = $changes[-1]->name;
is $engine->_trim_to('foo', $key, $to_trim, 1), $#changes,
qq{_trim_to should find "$key" at last index};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ],
'Changes should be untrimmed';
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[-1]->id, 0]],
], 'It should have passed change -1 ID to change_id_offset_from_id';
# Try shifting to the third-to-last change.
$to_trim = [@changes];
@resolved = ($changes[-3]->id);
$key = $changes[-3]->name;
is $engine->_trim_to('foo', $key, $to_trim, 1), 4,
qq{_trim_to should find "$key" at index 4};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0..$#changes-2] ],
'Last two changes should be popped off';
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[-3]->id, 0]],
], 'It should have passed change -3 ID to change_id_offset_from_id';
# ^ should be handled relative to deployed changes.
$to_trim = [@changes];
@resolved = ($changes[-3]->id);
$key = $changes[-4]->name;
is $engine->_trim_to('foo', "$key^", $to_trim, 1), 4,
qq{_trim_to should find "$key^" at index 4};
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[-3]->id, -1]],
], 'Should pass change -3 ID and offset -1 to change_id_offset_from_id';
# ~ should be handled relative to deployed changes.
$to_trim = [@changes];
@resolved = ($changes[-3]->id);
$key = $changes[-2]->name;
is $engine->_trim_to('foo', "$key~", $to_trim, 1), 4,
qq{_trim_to should find "$key~" at index 4};
is_deeply $engine->seen, [
[ change_id_for => {
change => $key,
change_id => undef,
project => 'sql',
tag => undef,
} ],
[ change_id_offset_from_id => [$changes[-3]->id, 1]],
], 'Should pass change -3 ID and offset 1 to change_id_offset_from_id';
# @HEAD and HEAD should be handled relative to deployed changes, not the plan.
$to_trim = [@changes];
@resolved = ($changes[2]->id);
$key = '@HEAD';
is $engine->_trim_to('foo', $key, $to_trim), 2,
qq{_trim_to should find "$key" at index 2};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ],
'First two changes should be shifted off';
is_deeply $engine->seen, [
[ change_id_for => {
change => '',
change_id => undef,
project => 'sql',
tag => 'HEAD',
} ],
[ change_id_offset_from_id => [$changes[2]->id, 0]],
], 'Should pass tag HEAD to change_id_for';
$to_trim = [@changes];
@resolved = ($changes[2]->id);
$key = 'HEAD';
is $engine->_trim_to('foo', $key, $to_trim), 2,
qq{_trim_to should find "$key" at index 2};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ],
'First two changes should be shifted off';
is_deeply $engine->seen, [
[ change_id_for => {
change => undef,
change_id => undef,
project => 'sql',
tag => 'HEAD',
} ],
[ change_id_offset_from_id => [$changes[2]->id, 0]],
], 'Should pass tag @HEAD to change_id_for';
# @ROOT and ROOT should be handled relative to deployed changes, not the plan.
$to_trim = [@changes];
@resolved = ($changes[2]->id);
$key = '@ROOT';
is $engine->_trim_to('foo', $key, $to_trim, 1), 2,
qq{_trim_to should find "$key" at index 2};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ],
'All but First three changes should be popped off';
is_deeply $engine->seen, [
[ change_id_for => {
change => '',
change_id => undef,
project => 'sql',
tag => 'ROOT',
} ],
[ change_id_offset_from_id => [$changes[2]->id, 0]],
], 'Should pass tag ROOT to change_id_for';
$to_trim = [@changes];
@resolved = ($changes[2]->id);
$key = 'ROOT';
is $engine->_trim_to('foo', $key, $to_trim, 1), 2,
qq{_trim_to should find "$key" at index 2};
is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ],
'All but First three changes should be popped off';
is_deeply $engine->seen, [
[ change_id_for => {
change => undef,
change_id => undef,
project => 'sql',
tag => 'ROOT',
} ],
[ change_id_offset_from_id => [$changes[2]->id, 0]],
], 'Should pass tag @ROOT to change_id_for';
##############################################################################
# Test _verify_changes().
can_ok $engine, '_verify_changes';
$engine->seen;
# Start with a single change with a valid verify script.
is $engine->_verify_changes(1, 1, 0, $changes[1]), 0,
'Verify of a single change should return errcount 0';
is_deeply +MockOutput->get_emit_literal, [[
' * users @alpha ..', '', ' ',
]], 'Declared output should list the change';
is_deeply +MockOutput->get_emit, [[__ 'ok']],
'Emitted Output should reflect the verification of the change';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply $engine->seen, [
[run_file => $changes[1]->verify_file ],
], 'The verify script should have been run';
# Try a single change with no verify script.
is $engine->_verify_changes(0, 0, 0, $changes[0]), 0,
'Verify of another single change should return errcount 0';
is_deeply +MockOutput->get_emit_literal, [[
' * roles ..', '', ' ',
]], 'Declared output should list the change';
is_deeply +MockOutput->get_emit, [[__ 'ok']],
'Emitted Output should reflect the verification of the change';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [
[__x 'Verify script {file} does not exist', file => $changes[0]->verify_file],
], 'A warning about no verify file should have been emitted';
is_deeply $engine->seen, [
], 'The verify script should not have been run';
# Try multiple changes.
is $engine->_verify_changes(0, 1, 0, @changes[0,1]), 0,
'Verify of two changes should return errcount 0';
is_deeply +MockOutput->get_emit_literal, [
[' * roles ..', '.......', ' '],
[' * users @alpha ..', '', ' '],
], 'Declared output should list both changes';
is_deeply +MockOutput->get_emit, [[__ 'ok'], [__ 'ok']],
'Emitted Output should reflect the verification of the changes';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [
[__x 'Verify script {file} does not exist', file => $changes[0]->verify_file],
], 'A warning about no verify file should have been emitted';
is_deeply $engine->seen, [
[run_file => $changes[1]->verify_file ],
], 'Only one verify script should have been run';
# Try multiple changes and show undeployed changes.
my @plan_changes = $plan->changes;
is $engine->_verify_changes(0, 1, 1, @changes[0,1]), 0,
'Verify of two changes and show pending';
is_deeply +MockOutput->get_emit_literal, [
[' * roles ..', '.......', ' '],
[' * users @alpha ..', '', ' '],
], 'Delcared output should list deployed changes';
is_deeply +MockOutput->get_emit, [
[__ 'ok'], [__ 'ok'],
[__n 'Undeployed change:', 'Undeployed changes:', 2],
map { [ ' * ', $_->format_name_with_tags] } @plan_changes[2..$#plan_changes]
], 'Emitted output should include list of pending changes';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [
[__x 'Verify script {file} does not exist', file => $changes[0]->verify_file],
], 'A warning about no verify file should have been emitted';
is_deeply $engine->seen, [
[run_file => $changes[1]->verify_file ],
], 'Only one verify script should have been run';
# Try a change that is not in the plan.
$change = App::Sqitch::Plan::Change->new( name => 'nonexistent', plan => $plan );
is $engine->_verify_changes(1, 0, 0, $change), 1,
'Verify of a change not in the plan should return errcount 1';
is_deeply +MockOutput->get_emit_literal, [[
' * nonexistent ..', '', ' '
]], 'Declared Output should reflect the verification of the change';
is_deeply +MockOutput->get_emit, [[__ 'not ok']],
'Emitted Output should reflect the failure of the verify';
is_deeply +MockOutput->get_comment, [[__ 'Not present in the plan' ]],
'Should have a comment about the change missing from the plan';
is_deeply $engine->seen, [], 'No verify script should have been run';
# Try a change in the wrong place in the plan.
$mock_plan->mock(index_of => 5);
is $engine->_verify_changes(1, 0, 0, $changes[1]), 1,
'Verify of an out-of-order change should return errcount 1';
is_deeply +MockOutput->get_emit_literal, [
[' * users @alpha ..', '', ' '],
], 'Declared output should reflect the verification of the change';
is_deeply +MockOutput->get_emit, [[__ 'not ok']],
'Emitted Output should reflect the failure of the verify';
is_deeply +MockOutput->get_comment, [[__ 'Out of order' ]],
'Should have a comment about the out-of-order change';
is_deeply $engine->seen, [
[run_file => $changes[1]->verify_file ],
], 'The verify script should have been run';
# Make sure that multiple issues add up.
$mock_engine->mock( verify_change => sub { hurl 'WTF!' });
is $engine->_verify_changes(1, 0, 0, $changes[1]), 2,
'Verify of a change with 2 issues should return 2';
is_deeply +MockOutput->get_emit_literal, [
[' * users @alpha ..', '', ' '],
], 'Declared output should reflect the verification of the change';
is_deeply +MockOutput->get_emit, [[__ 'not ok']],
'Emitted Output should reflect the failure of the verify';
is_deeply +MockOutput->get_comment, [
[__ 'Out of order' ],
['WTF!'],
], 'Should have comment about the out-of-order change and script failure';
is_deeply $engine->seen, [], 'No abstract methods should have been called';
# Make sure that multiple changes with multiple issues add up.
$mock_engine->mock( verify_change => sub { hurl 'WTF!' });
is $engine->_verify_changes(0, -1, 0, @changes[0,1]), 4,
'Verify of 2 changes with 2 issues each should return 4';
is_deeply +MockOutput->get_emit_literal, [
[' * roles ..', '.......', ' '],
[' * users @alpha ..', '', ' '],
], 'Declraed output should reflect the verification of both changes';
is_deeply +MockOutput->get_emit, [[__ 'not ok'], [__ 'not ok']],
'Emitted Output should reflect the failure of both verifies';
is_deeply +MockOutput->get_comment, [
[__ 'Out of order' ],
['WTF!'],
[__ 'Out of order' ],
['WTF!'],
], 'Should have comment about the out-of-order changes and script failures';
is_deeply $engine->seen, [], 'No abstract methods should have been called';
# Unmock before moving on.
$mock_plan->unmock('index_of');
$mock_engine->unmock('verify_change');
# Now deal with changes in the plan but not in the list.
is $engine->_verify_changes($#changes, $plan->count - 1, 0, $changes[-1]), 2,
'_verify_changes with two undeployed changes should returne 2';
is_deeply +MockOutput->get_emit_literal, [
[' * dr_evil ..', '', ' '],
[' * foo ..', '....', ' ' , __ 'not ok', ' '],
[' * blah ..', '...', ' ' , __ 'not ok', ' '],
], 'Listed changes should be both deployed and undeployed';
is_deeply +MockOutput->get_emit, [[__ 'ok']],
'Emitted Output should reflect 1 pass';
is_deeply +MockOutput->get_comment, [
[__ 'Not deployed' ],
[__ 'Not deployed' ],
], 'Should have comments for undeployed changes';
is_deeply $engine->seen, [], 'No abstract methods should have been called';
##############################################################################
# Test verify().
can_ok $engine, 'verify';
my @verify_changes;
$mock_engine->mock( _load_changes => sub { @verify_changes });
# First, test with no changes.
ok $engine->verify,
'Should return success for no deployed changes';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
[__ 'No changes deployed'],
], 'Notification of the verify should be emitted';
is_deeply $engine->seen, [["deployed_changes", undef]],
'Should have called deployed_changes';
# Try no changes *and* nothing in the plan.
my $count = 0;
$mock_plan->mock(count => sub { $count });
ok $engine->verify,
'Should return success for no changes';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
[__ 'Nothing to verify (no planned or deployed changes)'],
], 'Notification of the verify should be emitted';
is_deeply $engine->seen, [["deployed_changes", undef]],
'Should have called deployed_changes';
# Now return some changes but have nothing in the plan.
@verify_changes = @changes;
throws_ok { $engine->verify } 'App::Sqitch::X',
'Should get error for no planned changes';
is $@->ident, 'verify', 'No planned changes ident should be "verify"';
is $@->exitval, 2, 'No planned changes exitval should be 2';
is $@->message, __ 'There are deployed changes, but none planned!',
'No planned changes message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
is_deeply $engine->seen, [["deployed_changes", undef]],
'Should have called deployed_changes';
# Let's do one change and have it pass.
$mock_plan->mock(index_of => 0);
$count = 1;
@verify_changes = ($changes[1]);
undef $@;
ok $engine->verify, 'Verify one change';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
is_deeply +MockOutput->get_emit_literal, [
[' * ' . $changes[1]->format_name_with_tags . ' ..', '', ' ' ],
], 'The one change name should be declared';
is_deeply +MockOutput->get_emit, [
[__ 'ok'],
[__ 'Verify successful'],
], 'Success should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef],
[run_file => $changes[1]->verify_file ],
], 'Should have run the verify file';
# Verify two changes.
MockOutput->get_vent;
$mock_plan->unmock('index_of');
@verify_changes = @changes[0,1];
ok $engine->verify, 'Verify two changes';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
is_deeply +MockOutput->get_emit_literal, [
[' * roles ..', '.......', ' ' ],
[' * users @alpha ..', '', ' ' ],
], 'The two change names should be declared';
is_deeply +MockOutput->get_emit, [
[__ 'ok'], [__ 'ok'],
[__ 'Verify successful'],
], 'Both successes should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [
[__x(
'Verify script {file} does not exist',
file => $changes[0]->verify_file,
)]
], 'Should have warning about missing verify script';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef],
[run_file => $changes[1]->verify_file ],
], 'Should have run the verify file again';
# Make sure a reworked change (that is, one with a suffix) is ignored.
my $mock_change = Test::MockModule->new(ref $change);
$mock_change->mock(is_reworked => 1);
@verify_changes = @changes[0,1];
ok $engine->verify, 'Verify with a reworked change changes';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
is_deeply +MockOutput->get_emit_literal, [
[' * roles ..', '.......', ' ' ],
[' * users @alpha ..', '', ' ' ],
], 'The two change names should be emitted';
is_deeply +MockOutput->get_emit, [
[__ 'ok'], [__ 'ok'],
[__ 'Verify successful'],
], 'Both successes should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [], 'Should have no warnings';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef],
], 'Should not have run the verify file';
$mock_change->unmock('is_reworked');
# Make sure we can trim.
@verify_changes = @changes;
@resolved = map { $_->id } @changes[1,2];
ok $engine->verify('users', 'widgets'), 'Verify two specific changes';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
is_deeply +MockOutput->get_emit_literal, [
[' * users @alpha ..', '.', ' ' ],
[' * widgets @beta ..', '', ' ' ],
], 'The two change names should be emitted';
is_deeply +MockOutput->get_emit, [
[__ 'ok'], [__ 'ok'],
[__ 'Verify successful'],
], 'Both successes should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply +MockOutput->get_vent, [
[__x(
'Verify script {file} does not exist',
file => $changes[2]->verify_file,
)]
], 'Should have warning about missing verify script';
is_deeply $engine->seen, [
["deployed_changes", undef],
["change_id_for", {
change_id => undef,
change => 'users',
tag => undef,
project => 'sql',
}],
["change_id_offset_from_id", ['25cfff05d28c898f5c37263e2559fe75e239003c', 0]],
["change_id_for", {
change_id => undef,
change => 'widgets',
tag => undef,
project => 'sql',
}],
["change_id_offset_from_id", ['2f77ad8585862a3926df4b0447d2bafd199de791', 0]],
[run_file => $changes[1]->verify_file ],
], 'Should have searched offsets and run the verify file';
# Now fail!
$mock_engine->mock( verify_change => sub { hurl 'WTF!' });
@verify_changes = @changes;
@resolved = map { $_->id } @changes[1,2];
throws_ok { $engine->verify('users', 'widgets') } 'App::Sqitch::X',
'Should get failure for failing verify scripts';
is $@->ident, 'verify', 'Failed verify ident should be "verify"';
is $@->exitval, 2, 'Failed verify exitval should be 2';
is $@->message, __ 'Verify failed', 'Faield verify message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Verifying {destination}', destination => $engine->destination],
], 'Notification of the verify should be emitted';
my $msg = __ 'Verify Summary Report';
is_deeply +MockOutput->get_emit_literal, [
[' * users @alpha ..', '.', ' ' ],
[' * widgets @beta ..', '', ' ' ],
], 'Both change names should be declared';
is_deeply +MockOutput->get_emit, [
[__ 'not ok'], [__ 'not ok'],
[ "\n", $msg ],
[ '-' x length $msg ],
[__x 'Changes: {number}', number => 2 ],
[__x 'Errors: {number}', number => 2 ],
], 'Output should include the failure report';
is_deeply +MockOutput->get_comment, [
['WTF!'],
['WTF!'],
], 'Should have the errors in comments';
is_deeply +MockOutput->get_vent, [], 'Nothing should have been vented';
is_deeply $engine->seen, [
["deployed_changes", undef],
["change_id_for", {
change_id => undef,
change => 'users',
tag => undef,
project => 'sql',
}],
["change_id_offset_from_id", ['25cfff05d28c898f5c37263e2559fe75e239003c', 0]],
["change_id_for", {
change_id => undef,
change => 'widgets',
tag => undef,
project => 'sql',
}],
["change_id_offset_from_id", ['2f77ad8585862a3926df4b0447d2bafd199de791', 0]],
], 'Should have searched offsets but not run the verify file';
##############################################################################
# Test check().
can_ok $engine, 'check';
my @check_changes;
$mock_engine->mock( _load_changes => sub { @check_changes });
# First, test with no changes.
ok $engine->check,
'Should return success for no deployed changes';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
[__ 'No changes deployed'],
], 'Notification of the check should be emitted';
is_deeply $engine->seen, [["deployed_changes", undef]],
'Should have called deployed_changes';
# Try no changes *and* nothing in the plan.
$count = 0;
$mock_plan->mock(count => sub { $count });
ok $engine->check,
'Should return success for no changes';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
[__ 'Nothing to check (no planned or deployed changes)'],
], 'Notification of the verify should be emitted';
is_deeply $engine->seen, [["deployed_changes", undef]],
'Should have called deployed_changes';
# Now return some changes but have nothing in the plan.
@check_changes = @changes;
throws_ok { $engine->check } 'App::Sqitch::X',
'Should get error for no planned changes';
is $@->ident, 'check', 'Failed check ident should be "check"';
is $@->exitval, 1, 'No planned changes exitval should be 1';
is $@->message, __ 'Failed one check',
'Failed check message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__x 'Script signatures diverge at change {change}',
change => $check_changes[0]->format_name_with_tags],
], 'Divergent change info should be emitted';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef]
], 'Should have called deployed_changes and latest_change_id';
# Let's do one change and have it pass.
$mock_plan->mock(index_of => 0);
$count = 1;
@check_changes = ($changes[0]);
ok $engine->check, 'Check one change';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__ 'Check successful'],
], 'Success should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef]
], 'Should have called deployed_changes and latest_change_id';
# Let's change a script hash and have it fail.
@check_changes = (clone($changes[0]));
$mock_change = Test::MockObject::Extends->new($plan->change_at(0));
$mock_change->mock('script_hash', sub { '42' });
$count = 1;
throws_ok { $engine->check } 'App::Sqitch::X',
'Should get error for one divergent script hash';
is $@->ident, 'check', 'Failed check ident should be "check"';
is $@->exitval, 1, 'No planned changes exitval should be 1';
is $@->message, __ 'Failed one check',
'Failed check message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__x 'Script signatures diverge at change {change}',
change => $check_changes[0]->format_name_with_tags],
], 'Divergent change info should be emitted';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef]
], 'Should have called deployed_changes and latest_change_id';
$mock_plan->unmock('index_of');
$mock_change->unmock('script_hash');
# Let's change the second script hash and have it fail there.
@check_changes = ($changes[0], clone($changes[1]));
$mock_change = Test::MockObject::Extends->new($check_changes[1]);
$mock_change->mock('script_hash', sub { '42' });
$count = 1;
throws_ok { $engine->check } 'App::Sqitch::X',
'Should get error for one divergent script hash';
is $@->ident, 'check', 'Failed check ident should be "check"';
is $@->exitval, 1, 'No planned changes exitval should be 1';
is $@->message, __ 'Failed one check',
'Failed check message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__x 'Script signatures diverge at change {change}',
change => $check_changes[1]->format_name_with_tags],
], 'Divergent change info should be emitted';
is_deeply $engine->seen, [
["deployed_changes", undef],
["latest_change_id", undef]
], 'Should have called deployed_changes and latest_change_id';
# The check should be fine if we stop at the first change
# (check should honor the `to` argument)
push @resolved => $changes[0]->id;
ok $engine->check(
undef,
$changes[0]->format_name_with_tags,
),
'Check one change with to arg';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__ 'Check successful'],
], 'Success should be emitted';
is_deeply +MockOutput->get_comment, [], 'Should have no comments';
is_deeply $engine->seen, [
["deployed_changes", undef],
["change_id_for", {
change_id => undef,
change => 'roles',
tag => undef,
project => 'sql',
}],
["change_id_offset_from_id", ['0539182819c1f0cb50dc4558f4f80b1a538a01b2', 0]],
], 'Should have searched offsets';
# The check should be fine if we start at the second change
# (check should honor the `from` argument)
push @resolved => $changes[1]->id;
throws_ok {
$engine->check(
$changes[1]->format_name_with_tags,
undef,
)
} 'App::Sqitch::X', 'Should get error for one divergent script hash with from arg';
is $@->ident, 'check', 'Failed check ident should be "check"';
is $@->exitval, 1, 'No planned changes exitval should be 1';
is $@->message, __ 'Failed one check',
'Failed check message should be correct';
is_deeply +MockOutput->get_info, [
[__x 'Checking {destination}', destination => $engine->destination],
], 'Notification of the check should be emitted';
is_deeply +MockOutput->get_emit, [
[__x 'Script signatures diverge at change {change}',
change => $check_changes[1]->format_name_with_tags],
], 'Divergent change info should be emitted';
is_deeply $engine->seen, [
["deployed_changes", undef],
["change_id_for", {
change_id => undef,
change => 'users ',
tag => 'alpha',
project => 'sql',
}],
["change_id_offset_from_id", ['25cfff05d28c898f5c37263e2559fe75e239003c', 0]],
["latest_change_id", undef],
], 'Should have searched offsets and the latest change ID';
##############################################################################
# Test lock_destination().
# Test check().
$mock_engine->unmock('lock_destination');
can_ok $engine, 'lock_destination';
is $engine->lock_timeout, 60, 'Lock timeout should be 60 seconds';
# First let the try lock succeed.
$try_lock_ret = 1;
$engine->_locked(0);
ok $engine->lock_destination, 'Lock destination';
is $engine->_locked, 1, 'Should be locked';
is_deeply $engine->seen, [], 'wait_lock should not have been called';
is_deeply +MockOutput->get_info, [], 'Should have emitted no info';
# Now let the lock fail and fall back on waiting for the lock.
$try_lock_ret = 0;
$wait_lock_ret = 1;
$engine->_locked(0);
ok $engine->lock_destination, 'Lock destination';
is $engine->_locked, 1, 'Should be locked again';
is_deeply $engine->seen, ['wait_lock'], 'wait_lock should have been called';
is_deeply +MockOutput->get_info, [[__x(
'Blocked by another instance of Sqitch working on {dest}; waiting {secs} seconds...',
dest => $engine->destination,
secs => $engine->lock_timeout,
)]], 'Should have notified user of waiting for lock';
# Another attempt to lock should be a no-op.
ok $engine->lock_destination, 'Lock destination again';
is_deeply $engine->seen, [], 'wait_lock should not have been called';
is_deeply +MockOutput->get_info, [], 'Should again have emitted no info';
# Now have it time out.
$try_lock_ret = 0;
$wait_lock_ret = 0;
$engine->_locked(0);
$engine->lock_timeout(0.1);
throws_ok { $engine->lock_destination } 'App::Sqitch::X',
'Should get error for lock timeout';
is $@->ident, 'engine', 'Lock timeout error ident should be "engine"';
is $@->exitval, 2, 'Lock timeout error exitval should be 2';
is $@->message, __x(
'Timed out waiting {secs} seconds for another instance of Sqitch to finish work on {dest}',
dest => $engine->destination,
secs => $engine->lock_timeout,
), 'Lock timeout error message should be correct';
is_deeply +MockOutput->get_info, [[__x(
'Blocked by another instance of Sqitch working on {dest}; waiting {secs} seconds...',
dest => $engine->destination,
secs => $engine->lock_timeout,
)]], 'Should have notified user of waiting for lock';
is_deeply $engine->seen, ['wait_lock'], 'wait_lock should have been called';
##############################################################################
# Test _to_idx()
$mock_whu->mock(latest_change_id => 2);
is $engine->_to_idx, $plan->count-1,
'Should get last index when there is a latest change ID';
$mock_whu->unmock('latest_change_id');
##############################################################################
# Test _handle_lookup_index() with change names not in the plan.
throws_ok { $engine->_handle_lookup_index('foo', [qw(x y)]) } 'App::Sqitch::X',
'Should die on too many IDs';
is $@->ident, 'engine', 'Too many IDs ident should be "engine"';
is $@->message, __('Change Lookup Failed'),
'Too many IDs message should be correct';
is_deeply +MockOutput->get_vent, [
[__x(
'Change "{change}" is ambiguous. Please specify a tag-qualified change:',
change => 'foo',
)],
[ ' * ', 'bugaboo' ],
[ ' * ', 'bugaboo' ],
], 'Too many IDs error should have been vented';
##############################################################################
# Test planned_deployed_common_ancestor_id.
is $engine->planned_deployed_common_ancestor_id,
'0539182819c1f0cb50dc4558f4f80b1a538a01b2',
'Test planned_deployed_common_ancestor_id';
##############################################################################
# Test default implementations.
is $engine->key, 'whu', 'Should have key';
is $engine->driver, $engine->key, 'Driver should be the same as engine';
ok $CLASS->try_lock, 'Default try_lock should return true by default';
is $CLASS->begin_work, $CLASS, 'Default begin_work should return self';
is $CLASS->finish_work, $CLASS, 'Default finish_work should return self';
__END__
diag $_->format_name_with_tags for @changes;
diag '======';
diag $_->format_name_with_tags for $plan->changes;
rebase.t 100755 001751 000166 62065 15004170404 15623 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Path::Class qw(dir file);
use App::Sqitch::X qw(hurl);
use Locale::TextDomain qw(App-Sqitch);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::rebase';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
new
onto_change
upto_change
modified
log_only
lock_timeout
execute
deploy_variables
revert_variables
does
_collect_deploy_vars
_collect_revert_vars
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(RevertDeployCommand ConnectingCommand ContextCommand);
is_deeply [$CLASS->options], [qw(
onto-change|onto=s
upto-change|upto=s
modified|m
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
target|t=s
mode=s
verify!
set|s=s%
set-deploy|e=s%
set-revert|r=s%
log-only
lock-timeout=i
y
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
verify => 0,
mode => 'all',
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have empty default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
}), {
no_prompt => 0,
prompt_accept => 1,
verify => 0,
mode => 'all',
deploy_variables => { foo => 'bar' },
revert_variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have set option';
is_deeply $CLASS->configure($config, {
y => 1,
set_deploy => { foo => 'bar' },
log_only => 1,
lock_timeout => 30,
verify => 1,
mode => 'tag',
}), {
mode => 'tag',
no_prompt => 1,
prompt_accept => 1,
deploy_variables => { foo => 'bar' },
verify => 1,
log_only => 1,
lock_timeout => 30,
_params => [],
_cx => [],
}, 'Should have mode, deploy_variables, verify, no_prompt, log_only, & lock_timeout';
is_deeply $CLASS->configure($config, {
y => 0,
set_revert => { foo => 'bar' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
revert_variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have set_revert option and no_prompt false';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { foo => 'dep', hi => 'you' },
set_revert => { foo => 'rev', hi => 'me' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'dep', hi => 'you' },
revert_variables => { foo => 'rev', hi => 'me' },
_params => [],
_cx => [],
}, 'set_deploy and set_revert should overrid set';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { hi => 'you' },
set_revert => { hi => 'me' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'bar', hi => 'you' },
revert_variables => { foo => 'bar', hi => 'me' },
_params => [],
_cx => [],
}, 'set_deploy and set_revert should merge with set';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { hi => 'you' },
set_revert => { my => 'yo' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'bar', hi => 'you' },
revert_variables => { foo => 'bar', my => 'yo' },
_params => [],
_cx => [],
}, 'set_revert should merge with set_deploy';
CONFIG: {
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'deploy.variables' => { foo => 'bar', hi => 21 },
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
verify => 0,
mode => 'all',
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have deploy configuration';
# Try setting variables.
is_deeply $CLASS->configure($config, {
onto_change => 'whu',
set => { foo => 'yo', yo => 'stellar' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'yo', yo => 'stellar' },
revert_variables => { foo => 'yo', yo => 'stellar' },
onto_change => 'whu',
_params => [],
_cx => [],
}, 'Should have merged variables';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Make sure we can override mode, prompting, and verify.
$config->replace(
'core.engine' => 'sqlite',
'revert.no_prompt' => 1,
'revert.prompt_accept' => 0,
'deploy.verify' => 1,
'deploy.mode' => 'tag',
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 1,
prompt_accept => 0,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have no_prompt true';
# Rebase option takes precendence
$config->update(
'rebase.no_prompt' => 0,
'rebase.prompt_accept' => 1,
'rebase.verify' => 0,
'rebase.mode' => 'change',
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 0,
mode => 'change',
_params => [],
_cx => [],
}, 'Should have false no_prompt, verify, and true prompt_accept from rebase config';
$config->update(
'revert.no_prompt' => undef,
'revert.prompt_accept' => undef,
'rebase.verify' => undef,
'rebase.mode' => undef,
'rebase.no_prompt' => 1,
'rebase.prompt_accept' => 0,
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 1,
prompt_accept => 0,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have true no_prompt, verify, and false prompt_accept from rebase from deploy';
# But option should override.
is_deeply $CLASS->configure($config, {y => 0, verify => 0, mode => 'all'}), {
no_prompt => 0,
verify => 0,
mode => 'all',
prompt_accept => 0,
_params => [],
_cx => [],
}, 'Should have no_prompt, prompt_accept false and mode all again';
$config->update(
'revert.no_prompt' => 0,
'revert.prompt_accept' => 1,
'rebase.no_prompt' => undef,
'rebase.prompt_accept' => undef,
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have no_prompt false and prompt_accept true for revert config';
is_deeply $CLASS->configure($config, {y => 1}), {
no_prompt => 1,
prompt_accept => 1,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have no_prompt true with -y';
# Should die in strict mode.
for my $cfg (
['revert.strict', 1],
['rebase.strict', 1],
) {
throws_ok {
$CLASS->configure(TestConfig->new(@{$ cfg}))
} 'App::Sqitch::X', "$cfg->[0] should die";
is $@->ident, 'rebase', 'Strict err ident should be "rebase"';
is $@->message, __x(
'"{command}" cannot be used in strict mode.\n'.
'Use explicity revert and deploy commands instead.',
command => 'rebase',
), 'Should have corect strict error message'
}
lives_ok { $CLASS->configure(
TestConfig->new('revert.strict', 1, 'rebase.strict', 0)
) } 'App::Sqitch::X';
}
##############################################################################
# Test accessors.
isa_ok my $rebase = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
), $CLASS, 'new status with target';
is $rebase->target, 'foo', 'Should have target "foo"';
isa_ok $rebase = $CLASS->new(sqitch => $sqitch), $CLASS;
is $rebase->target, undef, 'Should have undef target';
is $rebase->onto_change, undef, 'onto_change should be undef';
is $rebase->upto_change, undef, 'upto_change should be undef';
ok !$rebase->modified, 'modified should be false';
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my @dep_args;
$mock_engine->mock(deploy => sub { shift; @dep_args = @_ });
my @rev_args;
$mock_engine->mock(revert => sub { shift; @rev_args = @_ });
my @vars;
$mock_engine->mock(set_variables => sub { shift; push @vars => [@_] });
my $common_ancestor_id;
$mock_engine->mock(planned_deployed_common_ancestor_id => sub { return $common_ancestor_id; });
##############################################################################
# Test _collect_deploy_vars and _collect_revert_vars.
$config->replace(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $rebase->_collect_deploy_vars($target) }, {},
'Should collect no variables for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {},
'Should collect no variables for revert';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core deploy vars for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core revert vars for revert';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars for revert';
# Add revert variables.
$config->update('revert.variables' => { dance => 'disco', lunch => 'pizza' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Deploy vars should be unaffected by revert vars';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with revert vars for revert';
# Add engine variables.
$config->update('engine.pg.variables' => { lunch => 'burrito', drink => 'whiskey', priv => 'UP' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override deploy vars with engine vars for deploy';
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override rebase vars with engine vars for revert';
# Add target variables.
$config->update('target.foo.variables' => { drink => 'scotch', status => 'winning' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with deploy vars for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with target vars for revert';
# Add --set variables.
my %opts = (
set => { status => 'tired', herb => 'oregano' },
);
$rebase = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set vars for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set variables for revert';
# Add --set-deploy-vars
$opts{set_deploy} = { herb => 'basil', color => 'black' };
$rebase = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'basil',
color => 'black',
}, 'Should override --set vars with --set-deploy variables for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should not override --set vars with --set-deploy variables for revert';
# Add --set-revert-vars
$opts{set_revert} = { herb => 'garlic', color => 'red' };
$rebase = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $rebase->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'basil',
color => 'black',
}, 'Should not override --set vars with --set-revert variables for deploy';
is_deeply { $rebase->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'garlic',
color => 'red',
}, 'Should override --set vars with --set-revert variables for revert';
$config->replace(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
);
##############################################################################
# Test execute().
$rebase = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, {}) },
);
my $mock_cmd = Test::MockModule->new($CLASS);
my $orig_method;
$mock_cmd->mock(parse_args => sub {
my @ret = shift->$orig_method(@_);
$target = $ret[0][0];
@ret;
});
$orig_method = $mock_cmd->original('parse_args');
ok $rebase->execute('@alpha'), 'Execute to "@alpha"';
is_deeply \@dep_args, [undef, 'all'],
'undef, and "all" should be passed to the engine deploy';
is_deeply \@vars, [[], []],
'No vars should have been passed through to the engine';
is_deeply \@rev_args, ['@alpha', 1, 1],
'"@alpha" should be passed to the engine revert';
ok !$target->engine->log_only, 'Engine should no be log only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The lock timeout should be set to the default';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass a target.
@vars = ();
ok $rebase->execute('db:sqlite:yow'), 'Execute with target';
is_deeply \@dep_args, [undef, 'all'],
'undef, and "all" should be passed to the engine deploy';
is_deeply \@rev_args, [undef, 1, 1],
'undef should be passed to the engine revert';
is_deeply \@vars, [[], []],
'No vars should have been passed through to the engine';
ok !$target->engine->log_only, 'Engine should no be log only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The lock timeout should be set to the default';
is $target->name, 'db:sqlite:yow', 'The target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass both.
@vars = ();
ok $rebase->execute('db:sqlite:yow', 'widgets'), 'Execute with onto and target';
is_deeply \@dep_args, [undef, 'all'],
'undef, and "all" should be passed to the engine deploy';
is_deeply \@rev_args, ['widgets', 1, 1],
'"widgets" should be passed to the engine revert';
is_deeply \@vars, [[], []],
'No vars should have been passed through to the engine';
ok !$target->engine->log_only, 'Engine should no be log only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The lock timeout should be set to the default';
is $target->name, 'db:sqlite:yow', 'The target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass all three!
@vars = ();
ok $rebase->execute('db:sqlite:yow', 'roles', 'widgets'),
'Execute with three args';
is_deeply \@dep_args, ['widgets', 'all'],
'"widgets", and "all" should be passed to the engine deploy';
is_deeply \@rev_args, ['roles', 1, 1],
'"roles" should be passed to the engine revert';
is_deeply \@vars, [[], []],
'No vars should have been passed through to the engine';
ok !$target->engine->log_only, 'Engine should no be log only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The lock timeout should be set to the default';
is $target->name, 'db:sqlite:yow', 'The target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass no args.
@vars = @dep_args = @rev_args = ();
ok $rebase->execute, 'Execute';
is_deeply \@dep_args, [undef, 'all'],
'undef and "all" should be passed to the engine deploy';
is_deeply \@rev_args, [undef, 1, 1],
'undef and = should be passed to the engine revert';
is_deeply \@vars, [[], []],
'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Test --modified
$common_ancestor_id = '42';
isa_ok $rebase = $CLASS->new(
target => 'db:sqlite:lolwut',
no_prompt => 1,
prompt_accept => 1,
log_only => 1,
lock_timeout => 30,
verify => 1,
sqitch => $sqitch,
modified => 1,
), $CLASS, 'Object with to and variables';
@vars = @dep_args = @rev_args = ();
ok $rebase->execute, 'Execute again';
is $target->name, 'db:sqlite:lolwut', 'Target name should be from option';
ok $target->engine->log_only, 'Engine should be log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
ok $target->engine->with_verify, 'Engine should verify';
is_deeply \@rev_args, [$common_ancestor_id, '', 1], 'the common ancestor id should be passed to the engine revert';
# Mix it up with options.
isa_ok $rebase = $CLASS->new(
target => 'db:sqlite:lolwut',
no_prompt => 1,
prompt_accept => 1,
log_only => 1,
lock_timeout => 30,
verify => 1,
sqitch => $sqitch,
mode => 'tag',
onto_change => 'foo',
upto_change => 'bar',
deploy_variables => { foo => 'bar', one => 1 },
revert_variables => { hey => 'there' },
), $CLASS, 'Object with to and variables';
@vars = @dep_args = @rev_args = ();
ok $rebase->execute, 'Execute again';
is $target->name, 'db:sqlite:lolwut', 'Target name should be from option';
ok $target->engine->log_only, 'Engine should be log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
ok $target->engine->with_verify, 'Engine should verify';
is_deeply \@dep_args, ['bar', 'tag'],
'"bar", "tag", and 1 should be passed to the engine deploy';
is_deeply \@rev_args, ['foo', '', 1], '"foo" should be passed to the engine revert';
is @vars, 2, 'Variables should have been passed to the engine twice';
is_deeply { @{ $vars[0] } }, { hey => 'there' },
'The revert vars should have been passed first';
is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 },
'The deploy vars should have been next';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Make sure we get warnings for too many things.
@dep_args = @rev_args, @vars = ();
ok $rebase->execute('db:sqlite:yow', 'roles', 'widgets'),
'Execute with three args';
is $target->name, 'db:sqlite:lolwut', 'Target name should be from option';
ok $target->engine->log_only, 'Engine should be log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
ok $target->engine->with_verify, 'Engine should verify';
is_deeply \@dep_args, ['bar', 'tag'],
'"bar", "tag", and 1 should be passed to the engine deploy';
is_deeply \@rev_args, ['foo', '', 1], '"foo" should be passed to the engine revert';
is @vars, 2, 'Variables should have been passed to the engine twice';
is_deeply { @{ $vars[0] } }, { hey => 'there' },
'The revert vars should have been passed first';
is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 },
'The deploy vars should have been next';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => 'db:sqlite:lolwut',
)], [__x(
'Too many changes specified; rebasing onto "{onto}" up to "{upto}"',
onto => 'foo',
upto => 'bar',
)]], 'Should have two warnings';
# Make sure we get an exception for unknown args.
throws_ok { $rebase->execute(qw(greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'rebase', 'Unknown arg ident should be "rebase"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exception for two unknown arg';
throws_ok { $rebase->execute(qw(greg jon)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'rebase', 'Unknown args ident should be "rebase"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, jon',
), 'Should get an exception for two unknown args';
# If nothing is deployed, or we are already at the revert target, the revert
# should be skipped.
@dep_args = @rev_args = @vars = ();
$mock_engine->mock(revert => sub { hurl { ident => 'revert', message => 'foo', exitval => 1 } });
ok $rebase->execute, 'Execute once more';
is_deeply \@dep_args, ['bar', 'tag'],
'"bar", "tag", and 1 should be passed to the engine deploy';
is @vars, 2, 'Variables should have been passed to the engine twice';
is_deeply { @{ $vars[0] } }, { hey => 'there' },
'The revert vars should have been passed first';
is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 },
'The deploy vars should have been next';
is_deeply +MockOutput->get_info, [['foo']],
'Should have emitted info for non-fatal revert exception';
# Should die for fatal, unknown, or confirmation errors.
for my $spec (
[ confirm => App::Sqitch::X->new(ident => 'revert:confirm', message => 'foo', exitval => 1) ],
[ fatal => App::Sqitch::X->new(ident => 'revert', message => 'foo', exitval => 2) ],
[ unknown => bless { } => __PACKAGE__ ],
) {
$mock_engine->mock(revert => sub { die $spec->[1] });
throws_ok { $rebase->execute } ref $spec->[1],
"Should rethrow $spec->[0] exception";
}
done_testing;
rework.t 100644 001751 000166 111134 15004170404 15700 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 256;
# use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::Exception;
use Test::Warn;
use App::Sqitch::Command::add;
use Path::Class;
use Test::File qw(file_not_exists_ok file_exists_ok);
use Test::File::Contents qw(file_contents_identical file_contents_is files_eq);
use File::Path qw(make_path remove_tree);
use Test::NoWarnings;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::rework';
my $test_dir = dir 'test-rework';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => $test_dir->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
isa_ok my $rework = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'rework',
config => $config,
}), $CLASS, 'rework command';
my $target = $rework->default_target;
sub dep($) {
my $dep = App::Sqitch::Plan::Depend->new(
conflicts => 0,
%{ App::Sqitch::Plan::Depend->parse(shift) },
plan => $rework->default_target->plan,
);
$dep->project;
return $dep;
}
can_ok $CLASS, qw(
change_name
requires
conflicts
note
execute
does
);
ok $CLASS->does("App::Sqitch::Role::ContextCommand"),
"$CLASS does ContextCommand";
is_deeply [$CLASS->options], [qw(
change-name|change|c=s
requires|r=s@
conflicts|x=s@
all|a!
note|n|m=s@
open-editor|edit|e!
plan-file|f=s
top-dir=s
)], 'Options should be set up';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), { _cx => [] },
'Should have default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
requires => [qw(foo bar)],
conflicts => ['baz'],
note => [qw(hi there)],
}), {
requires => [qw(foo bar)],
conflicts => ['baz'],
note => [qw(hi there)],
_cx => [],
}, 'Should have get requires, conflicts, and note options';
# open_editor handling
CONFIG: {
my $config = TestConfig->from(local => File::Spec->catfile(qw(t rework.conf)));
is_deeply $CLASS->configure($config, {}), { _cx => []},
'Grabs nothing from config';
ok my $sqitch = App::Sqitch->new(config => $config), 'Load Sqitch project';
isa_ok my $rework = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'rework',
config => $config,
}), $CLASS, 'rework command';
ok $rework->open_editor, 'Coerces rework.open_editor from config string boolean';
}
##############################################################################
# Test attributes.
is_deeply $rework->requires, [], 'Requires should be an arrayref';
is_deeply $rework->conflicts, [], 'Conflicts should be an arrayref';
is_deeply $rework->note, [], 'Note should be an arrayref';
##############################################################################
# Test execute().
make_path $test_dir->stringify;
END { remove_tree $test_dir->stringify if -e $test_dir->stringify };
my $plan_file = $target->plan_file;
my $fh = $plan_file->open('>') or die "Cannot open $plan_file: $!";
say $fh "%project=empty\n\n";
$fh->close or die "Error closing $plan_file: $!";
my $plan = $target->plan;
throws_ok { $rework->execute('foo') } 'App::Sqitch::X',
'Should get an example for nonexistent change';
is $@->ident, 'plan', 'Nonexistent change error ident should be "plan"';
is $@->message, __x(
qq{Change "{change}" does not exist in {file}.\n}
. 'Use "sqitch add {change}" to add it to the plan',
change => 'foo',
file => $plan->file,
), 'Fail message should say the step does not exist';
# Use the add command to create a step.
my $deploy_file = file qw(test-rework deploy foo.sql);
my $revert_file = file qw(test-rework revert foo.sql);
my $verify_file = file qw(test-rework verify foo.sql);
my $change_mocker = Test::MockModule->new('App::Sqitch::Plan::Change');
my %request_params;
$change_mocker->mock(request_note => sub {
my $self = shift;
%request_params = @_;
return $self->note;
});
# Use the same plan.
my $mock_plan = Test::MockModule->new(ref $target);
$mock_plan->mock(plan => $plan);
ok my $add = App::Sqitch::Command::add->new(
sqitch => $sqitch,
change_name => 'foo',
template_directory => Path::Class::dir(qw(etc templates))
), 'Create another add with template_directory';
file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file);
ok $add->execute, 'Execute with the --change option';
file_exists_ok($_) for ($deploy_file, $revert_file, $verify_file);
ok my $foo = $plan->get('foo'), 'Get the "foo" change';
throws_ok { $rework->execute('foo') } 'App::Sqitch::X',
'Should get an example for duplicate change';
is $@->ident, 'plan', 'Duplicate change error ident should be "plan"';
is $@->message, __x(
qq{Cannot rework "{change}" without an intervening tag.\n}
. 'Use "sqitch tag" to create a tag and try again',
change => 'foo',
), 'Fail message should say a tag is needed';
# Tag it, and *then* it should work.
ok $plan->tag( name => '@alpha' ), 'Tag it';
my $deploy_file2 = file qw(test-rework deploy foo@alpha.sql);
my $revert_file2 = file qw(test-rework revert foo@alpha.sql);
my $verify_file2 = file qw(test-rework verify foo@alpha.sql);
MockOutput->get_info;
file_not_exists_ok($_) for ($deploy_file2, $revert_file2, $verify_file2);
ok $rework->execute('foo'), 'Rework "foo"';
# The files should have been copied.
file_exists_ok($_) for ($deploy_file, $revert_file, $verify_file);
file_exists_ok($_) for ($deploy_file2, $revert_file2, $verify_file2);
file_contents_identical($deploy_file2, $deploy_file);
file_contents_identical($verify_file2, $verify_file);
file_contents_identical($revert_file, $deploy_file);
file_contents_is($revert_file2, <<'EOF', 'New revert should revert');
-- Revert empty:foo from sqlite
BEGIN;
-- XXX Add DDLs here.
COMMIT;
EOF
# The note should have been required.
is_deeply \%request_params, {
for => __ 'rework',
scripts => [$deploy_file, $revert_file, $verify_file],
}, 'It should have prompted for a note';
# The plan file should have been updated.
ok $plan->load, 'Reload the plan file';
ok my @steps = $plan->changes, 'Get the steps';
is @steps, 2, 'Should have two steps';
is $steps[0]->name, 'foo', 'First step should be "foo"';
is $steps[1]->name, 'foo', 'Second step should also be "foo"';
is_deeply [$steps[1]->requires], [dep 'foo@alpha'],
'Reworked step should require the previous step';
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'foo [foo@alpha]',
file => $target->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
3,
)],
[" * $deploy_file"],
[" * $revert_file"],
[" * $verify_file"],
], 'And the info message should suggest editing the old files';
is_deeply +MockOutput->get_debug, [
[' ', __x 'Created {file}', file => dir qw(test-rework deploy) ],
[' ', __x 'Created {file}', file => dir qw(test-rework revert) ],
[' ', __x 'Created {file}', file => dir qw(test-rework verify) ],
[__x(
'Copied {src} to {dest}',
dest => $deploy_file2,
src => $deploy_file,
)],
[__x(
'Copied {src} to {dest}',
dest => $revert_file2,
src => $revert_file,
)],
[__x(
'Copied {src} to {dest}',
dest => $verify_file2,
src => $verify_file,
)],
[__x(
'Copied {src} to {dest}',
dest => $revert_file,
src => $deploy_file,
)],
], 'Debug should show file copying';
##############################################################################
# Let's do that again. This time with more dependencies and fewer files.
$deploy_file = file qw(test-rework deploy bar.sql);
$revert_file = file qw(test-rework revert bar.sql);
$verify_file = file qw(test-rework verify bar.sql);
ok $add = App::Sqitch::Command::add->new(
sqitch => $sqitch,
template_directory => Path::Class::dir(qw(etc templates)),
with_scripts => { revert => 0, verify => 0 },
), 'Create another add with template_directory';
file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file);
$add->execute('bar');
file_exists_ok($deploy_file);
file_not_exists_ok($_) for ($revert_file, $verify_file);
ok $plan->tag( name => '@beta' ), 'Tag it with @beta';
my $deploy_file3 = file qw(test-rework deploy bar@beta.sql);
my $revert_file3 = file qw(test-rework revert bar@beta.sql);
my $verify_file3 = file qw(test-rework verify bar@beta.sql);
MockOutput->get_info;
isa_ok $rework = App::Sqitch::Command::rework->new(
sqitch => $sqitch,
command => 'rework',
config => $config,
requires => ['foo'],
note => [qw(hi there)],
conflicts => ['dr_evil'],
), $CLASS, 'rework command with requirements and conflicts';
# Check the files.
file_not_exists_ok($_) for ($deploy_file3, $revert_file3, $verify_file3);
ok $rework->execute('bar'), 'Rework "bar"';
file_exists_ok($deploy_file);
file_not_exists_ok($_) for ($revert_file, $verify_file);
file_exists_ok($deploy_file3);
file_not_exists_ok($_) for ($revert_file3, $verify_file3);
# The note should have been required.
is_deeply \%request_params, {
for => __ 'rework',
scripts => [$deploy_file],
}, 'It should have prompted for a note';
# The plan file should have been updated.
ok $plan->load, 'Reload the plan file again';
ok @steps = $plan->changes, 'Get the steps';
is @steps, 4, 'Should have four steps';
is $steps[0]->name, 'foo', 'First step should be "foo"';
is $steps[1]->name, 'foo', 'Second step should also be "foo"';
is $steps[2]->name, 'bar', 'First step should be "bar"';
is $steps[3]->name, 'bar', 'Second step should also be "bar"';
is_deeply [$steps[3]->requires], [dep 'bar@beta', dep 'foo'],
'Requires should have been passed to reworked change';
is_deeply [$steps[3]->conflicts], [dep '!dr_evil'],
'Conflicts should have been passed to reworked change';
is $steps[3]->note, "hi\n\nthere",
'Note should have been passed as comment';
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'bar [bar@beta foo !dr_evil]',
file => $target->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
1,
)],
[" * $deploy_file"],
], 'And the info message should show only the one file to modify';
is_deeply +MockOutput->get_debug, [
[__x(
'Copied {src} to {dest}',
dest => $deploy_file3,
src => $deploy_file,
)],
[__x(
'Skipped {dest}: {src} does not exist',
dest => $revert_file3,
src => $revert_file,
)],
[__x(
'Skipped {dest}: {src} does not exist',
dest => $verify_file3,
src => $verify_file,
)],
[__x(
'Skipped {dest}: {src} does not exist',
dest => $revert_file,
src => $revert_file3, # No previous revert, no need for new revert.
)],
], 'Should have debug oputput for missing files';
# Make sure --open-editor works
MOCKSHELL: {
my $sqitch_mocker = Test::MockModule->new('App::Sqitch');
my $shell_cmd;
$sqitch_mocker->mock(shell => sub { $shell_cmd = $_[1] });
$sqitch_mocker->mock(quote_shell => sub { shift; join ' ' => @_ });
ok $rework = $CLASS->new(
sqitch => $sqitch,
template_directory => Path::Class::dir(qw(etc templates)),
note => ['Testing --open-editor'],
open_editor => 1,
), 'Create another add with open_editor';
ok $plan->tag( name => '@gamma' ), 'Tag it';
my $rework_file = file qw(test-rework deploy bar.sql);
my $deploy_file = file qw(test-rework deploy bar@gamma.sql);
my $revert_file = file qw(test-rework revert bar@gamma.sql);
my $verify_file = file qw(test-rework verify bar@gamma.sql);
MockOutput->get_info;
file_not_exists_ok($_) for ($deploy_file, $revert_file, $verify_file);
ok $rework->execute('bar'), 'Rework "bar"';
# The files should have been copied.
file_exists_ok($_) for ($rework_file, $deploy_file);
file_not_exists_ok($_) for ($revert_file, $verify_file);
is $shell_cmd, join(' ', $sqitch->editor, $rework_file),
'It should have prompted to edit sql files';
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'bar [bar@gamma]',
file => $target->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
1,
)],
[" * $rework_file"],
], 'And the info message should suggest editing the old files';
MockOutput->get_debug; # empty debug.
};
# Make sure we properly handle a reworked directory.
$mock_plan->unmock('plan');
REWORKED_DIR: {
my $dstring = $test_dir->stringify;
remove_tree $dstring;
make_path $dstring;
END { remove_tree $dstring if -e $dstring };
chdir $dstring;
my $conf = file 'rework_dir.conf';
$conf->spew(join "\n",
'[core]',
'reworked_dir = _reworked',
'engine = sqlite',
);
file('sqitch.plan')->spew(join "\n",
'%project=rework', '',
'widgets 2012-07-16T17:25:07Z anna ',
'gadgets 2012-07-16T18:25:07Z anna ',
'@foo 2012-07-16T17:24:07Z julie ', '',
);
# Create the scripts.
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $dir = dir $type;
$dir->mkpath;
my $script = $dir->file('gadgets.sql');
$script->spew("-- $dir gadgets");
push @change => $script;
push @reworked => dir('_reworked', $type)->file('gadgets@foo.sql');
}
# We should have the change scripts but not yet reworked.
file_exists_ok $_ for @change;
file_not_exists_ok '_reworked';
file_not_exists_ok $_ for @reworked;
my $config = TestConfig->from(local => $conf);
my $sqitch = App::Sqitch->new(config => $config);
ok $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing reworked_dir'],
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another rework with custom reworked_dir config';
# Let's do this thing!
ok $rework->execute('gadgets'), 'Rework change "gadgets"';
my $target = $rework->default_target;
ok my $head = $target->plan->get('gadgets@HEAD'),
"Get gadgets\@HEAD from the plan";
ok my $foo = $target->plan->get('gadgets@foo'),
"Get gadgets\@foo from the plan";
cmp_ok $head->id, 'ne', $foo->id,
"The two gadgets should be different changes";
# All the files should exist, now.
file_exists_ok '_reworked';
file_exists_ok $_ for @change, @reworked;
is_deeply \%request_params, {
for => __ 'rework',
scripts => \@change,
}, 'Should have listed scripts in the note prompt';
# Should have info output.
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'gadgets [gadgets@foo]',
file => $target->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
3,
)],
map { [" * $_"] } @change,
], 'And the info message should suggest editing the old files';
# use Data::Dump; ddx +MockOutput->get_debug;
is_deeply +MockOutput->get_debug, [
[' ', __x 'Created {file}', file => dir qw(_reworked deploy) ],
[__x(
'Copied {src} to {dest}',
src => $change[0],
dest => $reworked[0],
)],
[' ', __x 'Created {file}', file => dir qw(_reworked revert) ],
[__x(
'Copied {src} to {dest}',
src => $change[1],
dest => $reworked[1],
)],
[' ', __x 'Created {file}', file => dir qw(_reworked verify) ],
[__x(
'Copied {src} to {dest}',
src => $change[2],
dest => $reworked[2],
)],
[__x(
'Copied {src} to {dest}',
src => $change[0],
dest => $change[1],
)],
], 'Debug should show directory creation and file copying';
chdir File::Spec->updir;
}
# Make sure a configuration with multiple plans works.
MULTIPLAN: {
my $dstring = $test_dir->stringify;
remove_tree $dstring;
make_path $dstring;
END { remove_tree $dstring if -e $dstring };
chdir $dstring;
my $conf = file 'multirework.conf';
$conf->spew(join "\n",
'[core]',
'engine = pg',
'[engine "pg"]',
'top_dir = pg',
'[engine "sqlite"]',
'top_dir = sqlite',
'[engine "mysql"]',
'top_dir = mysql',
);
# Create plan files and determine the scripts that to be created.
my %scripts = map {
my $dir = dir $_;
$dir->mkpath;
$dir->file('sqitch.plan')->spew(join "\n",
'%project=rework', '',
'widgets 2012-07-16T17:25:07Z anna ',
'gadgets 2012-07-16T18:25:07Z anna ',
'@foo 2012-07-16T17:24:07Z julie ', '',
);
# Make the script files.
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $subdir = $dir->subdir($type);
$subdir->mkpath;
my $script = $subdir->file('widgets.sql');
$script->spew("-- $subdir widgets");
push @change => $script;
push @reworked => $subdir->file('widgets@foo.sql');
}
# Return the scripts.
$_ => { change => \@change, reworked => \@reworked };
} qw(pg sqlite mysql);
# Load up the configuration for this project.
my $config = TestConfig->from(local => $conf);
my $sqitch = App::Sqitch->new(config => $config);
ok my $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another rework with custom multiplan config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 3, 'Should have three targets';
# Make sure the target list matches our script list order (by engine).
# pg always comes first, as primary engine, but the other two are random.
push @targets, splice @targets, 1, 1 if $targets[1]->engine_key ne 'sqlite';
# Let's do this thing!
ok $rework->execute('widgets'), 'Rework change "widgets" in all plans';
for my $target(@targets) {
my $ekey = $target->engine_key;
ok my $head = $target->plan->get('widgets@HEAD'),
"Get widgets\@HEAD from the $ekey plan";
ok my $foo = $target->plan->get('widgets@foo'),
"Get widgets\@foo from the $ekey plan";
cmp_ok $head->id, 'ne', $foo->id,
"The two $ekey widgets should be different changes";
}
# All the files should exist, now.
while (my ($k, $v) = each %scripts) {
file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked);
# Deploy and verify files should be the same.
files_eq $v->{change}[0], $v->{reworked}[0];
files_eq $v->{change}[2], $v->{reworked}[2];
# New revert should be the same as old deploy.
files_eq $v->{change}[1], $v->{reworked}[0];
}
# Make sure we see the proper output.
my $info = MockOutput->get_info;
my $note = $request_params{scripts};
my $ekey = $targets[1]->engine_key;
if ($info->[1][0] !~ /$ekey/) {
# Got the targets in a different order. So reorder results to match.
($info->[1], $info->[2]) = ($info->[2], $info->[1]);
push @{ $info } => splice @{ $info }, 7, 3;
push @{ $note } => splice @{ $note }, 3, 3;
}
is_deeply $note, [map { @{ $scripts{$_}{change} }} qw(pg sqlite mysql)],
'Should have listed the files in the note prompt';
is_deeply $info, [
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[0]->plan_file,
)],
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[1]->plan_file,
)],
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[2]->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
3,
)],
map {
map { [" * $_" ] } @{ $scripts{$_}{change} }
} qw(pg sqlite mysql)
], 'And the info message should show the two files to modify';
my $debug = +MockOutput->get_debug;
if ($debug->[4][0] !~ /$ekey/) {
# Got the targets in a different order. So reorder results to match.
push @{ $debug } => splice @{ $debug }, 4, 4;
}
is_deeply $debug, [
map {
my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)};
(
map { [__x(
'Copied {src} to {dest}',
src => $c->[$_],
dest => $r->[$_],
)] } (0..2)
),
[__x(
'Copied {src} to {dest}',
src => $c->[0],
dest => $c->[1],
)]
} qw(pg sqlite mysql)
], 'Should have debug oputput for all copied files';
# # Make sure we get an error using --all and a target arg.
throws_ok { $rework->execute('foo', 'pg' ) } 'App::Sqitch::X',
'Should get an error for --all and a target arg';
is $@->ident, 'rework', 'Mixed arguments error ident should be "rework"';
is $@->message, __(
'Cannot specify both --all and engine, target, or plan arugments'
), 'Mixed arguments error message should be correct';
# # Now try reworking a change to just one engine. Remove --all
%scripts = map {
my $dir = dir $_;
$dir->mkpath;
# Make the script files.
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $subdir = $dir->subdir($type);
$subdir->mkpath;
my $script = $subdir->file('gadgets.sql');
$script->spew("-- $subdir gadgets");
push @change => $script;
# Only SQLite is reworked.
push @reworked => $subdir->file('gadgets@foo.sql')
if $_ eq 'sqlite';
}
# Return the scripts.
$_ => { change => \@change, reworked => \@reworked };
} qw(pg sqlite mysql);
ok $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create yet another rework with custom multiplan config';
ok $rework->execute('gadgets', 'sqlite'),
'Rework change "gadgets" in the sqlite plan';
my %targets = map { $_->engine_key => $_ }
App::Sqitch::Target->all_targets(sqitch => $sqitch);
is keys %targets, 3, 'Should still have three targets';
for my $ekey(qw(pg mysql)) {
my $target = $targets{$ekey};
ok my $head = $target->plan->get('gadgets@HEAD'),
"Get gadgets\@HEAD from the $ekey plan";
ok my $foo = $target->plan->get('gadgets@foo'),
"Get gadgets\@foo from the $ekey plan";
cmp_ok $head->id, 'eq', $foo->id,
"The two $ekey gadgets should be the same change";
}
do {
my $ekey = 'sqlite';
my $target = $targets{$ekey};
ok my $head = $target->plan->get('gadgets@HEAD'),
"Get gadgets\@HEAD from the $ekey plan";
ok my $foo = $target->plan->get('gadgets@foo'),
"Get gadgets\@foo from the $ekey plan";
cmp_ok $head->id, 'ne', $foo->id,
"The two $ekey gadgets should be different changes";
};
# All the files should exist, now.
while (my ($k, $v) = each %scripts) {
file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked);
next if $k ne 'sqlite';
# Deploy and verify files should be the same.
files_eq $v->{change}[0], $v->{reworked}[0];
files_eq $v->{change}[2], $v->{reworked}[2];
# New revert should be the same as old deploy.
files_eq $v->{change}[1], $v->{reworked}[0];
}
is_deeply \%request_params, {
for => __ 'rework',
scripts => $scripts{sqlite}{change},
}, 'Should have listed SQLite scripts in the note prompt';
# Clear the output.
MockOutput->get_info;
MockOutput->get_debug;
chdir File::Spec->updir;
}
# Make sure we update only one plan but write out multiple target files.
MULTITARGET: {
my $dstring = $test_dir->stringify;
remove_tree $dstring;
make_path $dstring;
END { remove_tree $dstring if -e $dstring };
chdir $dstring;
my $conf = file 'multiadd.conf';
$conf->spew(join "\n",
'[core]',
'engine = pg',
'plan_file = sqitch.plan',
'[engine "pg"]',
'top_dir = pg',
'[engine "sqlite"]',
'top_dir = sqlite',
'[add]',
'all = true',
);
file('sqitch.plan')->spew(join "\n",
'%project=rework', '',
'widgets 2012-07-16T17:25:07Z anna ',
'gadgets 2012-07-16T18:25:07Z anna ',
'@foo 2012-07-16T17:24:07Z julie ', '',
);
# Create the scripts.
my %scripts = map {
my $dir = dir $_;
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $subdir = $dir->subdir($type);
$subdir->mkpath;
my $script = $subdir->file('widgets.sql');
$script->spew("-- $subdir widgets");
push @change => $script;
push @reworked => $subdir->file('widgets@foo.sql');
}
# Return the scripts.
$_ => { change => \@change, reworked => \@reworked };
} qw(pg sqlite);
# Load up the configuration for this project.
$config = TestConfig->from(local => $conf);
$sqitch = App::Sqitch->new(config => $config);
ok my $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another rework with custom multiplan config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
is $targets[0]->plan_file, $targets[1]->plan_file,
'Targets should use the same plan file';
my $target = $targets[0];
# Let's do this thing!
ok $rework->execute('widgets'), 'Rework change "widgets" in all plans';
ok my $head = $target->plan->get('widgets@HEAD'),
"Get widgets\@HEAD from the plan";
ok my $foo = $target->plan->get('widgets@foo'),
"Get widgets\@foo from the plan";
cmp_ok $head->id, 'ne', $foo->id,
"The two widgets should be different changes";
# All the files should exist, now.
while (my ($k, $v) = each %scripts) {
file_exists_ok $_ for map { @{ $v->{$_} } } qw(change reworked);
# Deploy and verify files should be the same.
files_eq $v->{change}[0], $v->{reworked}[0];
files_eq $v->{change}[2], $v->{reworked}[2];
# New revert should be the same as old deploy.
files_eq $v->{change}[1], $v->{reworked}[0];
}
is_deeply \%request_params, {
for => __ 'rework',
scripts => [ map {@{ $scripts{$_}{change} }} qw(pg sqlite)],
}, 'Should have listed all the files to edit in the note prompt';
# And the output should be correct.
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $target->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
3,
)],
map {
map { [" * $_" ] } @{ $scripts{$_}{change} }
} qw(pg sqlite)
], 'And the info message should show the two files to modify';
# As should the debug output
is_deeply +MockOutput->get_debug, [
map {
my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)};
(
map { [__x(
'Copied {src} to {dest}',
src => $c->[$_],
dest => $r->[$_],
)] } (0..2)
),
[__x(
'Copied {src} to {dest}',
src => $c->[0],
dest => $c->[1],
)]
} qw(pg sqlite)
], 'Should have debug oputput for all copied files';
chdir File::Spec->updir;
}
# Try two plans with different tags.
MULTITAG: {
my $dstring = $test_dir->stringify;
remove_tree $dstring;
make_path $dstring;
END { remove_tree $dstring if -e $dstring };
chdir $test_dir->stringify;
my $conf = file 'multirework.conf';
$conf->spew(join "\n",
'[core]',
'engine = pg',
'[engine "pg"]',
'top_dir = pg',
'[engine "sqlite"]',
'top_dir = sqlite',
);
# Create plan files and determine the scripts that to be created.
my %scripts = map {
my $dir = dir $_;
$dir->mkpath;
my $tag = $_ eq 'pg' ? 'foo' : 'bar';
$dir->file('sqitch.plan')->spew(join "\n",
'%project=rework', '',
'widgets 2012-07-16T17:25:07Z anna ',
"\@$tag 2012-07-16T17:24:07Z julie ", '',
);
# Make the script files.
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $subdir = $dir->subdir($type);
$subdir->mkpath;
my $script = $subdir->file('widgets.sql');
$script->spew("-- $subdir widgets");
push @change => $script;
push @reworked => $subdir->file("widgets\@$tag.sql");
}
# Return the scripts.
$_ => { change => \@change, reworked => \@reworked };
} qw(pg sqlite);
# Load up the configuration for this project.
$config = TestConfig->from(local => $conf);
$sqitch = App::Sqitch->new(config => $config);
ok my $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another rework with custom multiplan config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
# Let's do this thing!
ok $rework->execute('widgets'), 'Rework change "widgets" in all plans';
for my $target(@targets) {
my $ekey = $target->engine_key;
my $tag = $ekey eq 'pg' ? 'foo' : 'bar';
ok my $head = $target->plan->get('widgets@HEAD'),
"Get widgets\@HEAD from the $ekey plan";
ok my $prev = $target->plan->get("widgets\@$tag"),
"Get widgets\@$tag from the $ekey plan";
cmp_ok $head->id, 'ne', $prev->id,
"The two $ekey widgets should be different changes";
}
is_deeply \%request_params, {
for => __ 'rework',
scripts => [ map {@{ $scripts{$_}{change} }} qw(pg sqlite)],
}, 'Should have listed all the files to edit in the note prompt';
# And the output should be correct.
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[0]->plan_file,
)],
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@bar]',
file => $targets[1]->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
2,
)],
map {
map { [" * $_" ] } @{ $scripts{$_}{change} }
} qw(pg sqlite)
], 'And the info message should show the two files to modify';
# As should the debug output
is_deeply +MockOutput->get_debug, [
map {
my ($c, $r) = @{ $scripts{$_} }{qw(change reworked)};
(
map { [__x(
'Copied {src} to {dest}',
src => $c->[$_],
dest => $r->[$_],
)] } (0..2)
),
[__x(
'Copied {src} to {dest}',
src => $c->[0],
dest => $c->[1],
)]
} qw(pg sqlite)
], 'Should have debug oputput for all copied files';
chdir File::Spec->updir;
}
# Make sure we're okay with multiple plans sharing the same top dir.
ONETOP: {
remove_tree $test_dir->stringify;
make_path $test_dir->stringify;
END { remove_tree $test_dir->stringify };
chdir $test_dir->stringify;
my $conf = file 'multirework.conf';
$conf->spew(join "\n",
'[core]',
'engine = pg',
'[engine "pg"]',
'plan_file = pg.plan',
'[engine "sqlite"]',
'plan_file = sqlite.plan',
);
# Write the two plan files.
file("$_.plan")->spew(join "\n",
'%project=rework', '',
'widgets 2012-07-16T17:25:07Z anna ',
'@foo 2012-07-16T17:24:07Z julie ', '',
) for qw(pg sqlite);
# One set of scripts for both.
my (@change, @reworked);
for my $type (qw(deploy revert verify)) {
my $dir = dir $type;
$dir->mkpath;
my $script = $dir->file('widgets.sql');
$script->spew("-- $dir widgets");
push @change => $script;
push @reworked => $dir->file('widgets@foo.sql');
}
# Load up the configuration for this project.
$config = TestConfig->from(local => $conf);
$sqitch = App::Sqitch->new(config => $config);
ok my $rework = $CLASS->new(
sqitch => $sqitch,
note => ['Testing multiple plans'],
all => 1,
template_directory => dir->parent->subdir(qw(etc templates))
), 'Create another rework with custom multiplan config';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
ok $rework->execute('widgets'), 'Rework change "widgets" in all plans';
for my $target(@targets) {
my $ekey = $target->engine_key;
ok my $head = $target->plan->get('widgets@HEAD'),
"Get widgets\@HEAD from the $ekey plan";
ok my $foo = $target->plan->get('widgets@foo'),
"Get widgets\@foo from the $ekey plan";
cmp_ok $head->id, 'ne', $foo->id,
"The two $ekey widgets should be different changes";
}
# Make sure the files were written properly.
file_exists_ok $_ for (@change, @reworked);
# Deploy and verify files should be the same.
files_eq $change[0], $reworked[0];
files_eq $change[2], $reworked[2];
# New revert should be the same as old deploy.
files_eq $change[1], $reworked[0];
is_deeply \%request_params, {
for => __ 'rework',
scripts => \@change,
}, 'Should have listed the files to edit in the note prompt';
# And the output should be correct.
is_deeply +MockOutput->get_info, [
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[0]->plan_file,
)],
[__x(
'Added "{change}" to {file}.',
change => 'widgets [widgets@foo]',
file => $targets[1]->plan_file,
)],
[__n(
'Modify this file as appropriate:',
'Modify these files as appropriate:',
2,
)],
map { [" * $_" ] } @change,
], 'And the info message should show the two files to modify';
# As should the debug output
is_deeply +MockOutput->get_debug, [
(
map { [__x(
'Copied {src} to {dest}',
src => $change[$_],
dest => $reworked[$_],
)] } (0..2)
),
[__x(
'Copied {src} to {dest}',
src => $change[0],
dest => $change[1],
)],
], 'Should have debug oputput for all copied files';
chdir File::Spec->updir;
}
revert.t 100755 001751 000166 32571 15004170404 15670 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Path::Class qw(dir file);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::revert';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
new
to_change
modified
log_only
lock_timeout
execute
variables
does
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(ContextCommand ConnectingCommand);
is_deeply [$CLASS->options], [qw(
target|t=s
to-change|to|change=s
set|s=s%
log-only
lock-timeout=i
modified|m
y
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
);
my $sqitch = App::Sqitch->new(config => $config);
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have empty default configuration with no config or opts';
is_deeply $CLASS->configure($config, {
y => 1,
set => { foo => 'bar' },
}), {
no_prompt => 1,
prompt_accept => 1,
variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have set option';
CONFIG: {
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'revert.variables' => { foo => 'bar', hi => 21 },
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have no_prompt false, prompt_accept true';
# Make sure we can override prompting.
$config->update(
'revert.no_prompt' => 1,
'revert.prompt_accept' => 0,
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 1,
prompt_accept => 0,
_params => [],
_cx => [],
}, 'Should have no_prompt true, prompt_accept false';
# But option should override.
is_deeply $CLASS->configure($config, {
y => 0,
log_only => 1,
lock_timeout => 30,
}), {
no_prompt => 0,
prompt_accept => 0,
log_only => 1,
lock_timeout => 30,
_params => [],
_cx => [],
}, 'Should have no_prompt false again';
$config->update(
'revert.no_prompt' => 0,
'revert.prompt_accept' => 1,
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have no_prompt false for false config';
is_deeply $CLASS->configure($config, {y => 1}), {
no_prompt => 1,
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have no_prompt true with -y';
}
##############################################################################
# Test construction.
isa_ok my $revert = $CLASS->new(
sqitch => $sqitch,
target => 'foo',
no_prompt => 1,
), $CLASS, 'new revert with target';
is $revert->target, 'foo', 'Should have target "foo"';
is $revert->to_change, undef, 'to_change should be undef';
ok !$revert->modified, 'modified should be false';
isa_ok $revert = $CLASS->new(sqitch => $sqitch, no_prompt => 1), $CLASS;
is $revert->target, undef, 'Should have undef default target';
is $revert->to_change, undef, 'to_change should be undef';
ok !$revert->modified, 'modified should be false';
##############################################################################
# Test _collect_vars.
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $revert->_collect_vars($target) }, {}, 'Should collect no variables';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core vars';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars';
# Add revert variables.
$config->update('revert.variables' => { dance => 'disco', lunch => 'pizza' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with revert vars';
# Add engine variables.
$config->update('engine.pg.variables' => { lunch => 'burrito', drink => 'whiskey' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override revert vars with engine vars';
# Add target variables.
$config->update('target.foo.variables' => { drink => 'scotch', status => 'winning' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with target vars';
# Add --set variables.
$revert = $CLASS->new(
sqitch => $sqitch,
variables => { status => 'tired', herb => 'oregano' },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $revert->_collect_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set variables';
$config->replace(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
);
$revert = $CLASS->new( sqitch => $sqitch, no_prompt => 1);
##############################################################################
# Test execution.
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my @args;
$mock_engine->mock(revert => sub { shift; @args = @_ });
my @vars;
$mock_engine->mock(set_variables => sub { shift; @vars = @_ });
my $common_ancestor_id;
$mock_engine->mock(planned_deployed_common_ancestor_id => sub { return $common_ancestor_id; });
my $mock_cmd = Test::MockModule->new($CLASS);
my $orig_method;
$mock_cmd->mock(parse_args => sub {
my @ret = shift->$orig_method(@_);
$target = $ret[0][0];
@ret;
});
$orig_method = $mock_cmd->original('parse_args');
# Pass the change.
ok $revert->execute('@alpha'), 'Execute to "@alpha"';
ok !$target->engine->log_only, 'Engine should not be log_only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The engine should have the default lock_timeout';
is_deeply \@args, ['@alpha', '', undef],
'"@alpha" should be passed to the engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass nothing.
@args = ();
ok $revert->execute, 'Execute';
is_deeply \@args, [undef, '', undef],
'undef should be passed to the engine';
is_deeply {@vars}, { },
'No vars should have been passed through to the engine';
is_deeply +MockOutput->get_warn, [], 'Should still have no warnings';
# Pass the target.
ok $revert->execute('db:sqlite:hi'), 'Execute to target';
ok !$target->engine->log_only, 'Engine should not be log_only';
is_deeply \@args, [undef, '', undef],
'undef" should be passed to the engine';
is $target->name, 'db:sqlite:hi', 'Target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Pass them both!
ok $revert->execute('db:sqlite:lol', 'widgets'), 'Execute with change and target';
ok !$target->engine->log_only, 'Engine should not be log_only';
is_deeply \@args, ['widgets', '', undef],
'"widgets" should be passed to the engine';
is $target->name, 'db:sqlite:lol', 'Target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# And reverse them.
ok $revert->execute('db:sqlite:lol', 'widgets'), 'Execute with target and change';
ok !$target->engine->log_only, 'Engine should not be log_only';
is_deeply \@args, ['widgets', '', undef],
'"widgets" should be passed to the engine';
is $target->name, 'db:sqlite:lol', 'Target name should be as passed';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Now specify options.
isa_ok $revert = $CLASS->new(
sqitch => $sqitch,
target => 'db:sqlite:welp',
to_change => 'foo',
log_only => 1,
lock_timeout => 30,
variables => { foo => 'bar', one => 1 },
), $CLASS, 'Object with to and variables';
@args = ();
ok $revert->execute, 'Execute again';
ok $target->engine->log_only, 'Engine should be log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is_deeply \@args, ['foo', 1, undef],
'"foo" and 1 should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is $target->name, 'db:sqlite:welp', 'Target name should be from option';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Try also passing the target and change.
ok $revert->execute('db:sqlite:lol', '@alpha'), 'Execute with options and args';
ok $target->engine->log_only, 'Engine should be log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is_deeply \@args, ['foo', 1, undef],
'"foo" and 1 should be passed to the engine';
is_deeply {@vars}, { foo => 'bar', one => 1 },
'Vars should have been passed through to the engine';
is $target->name, 'db:sqlite:welp', 'Target name should be from option';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => 'db:sqlite:welp',
)], [__x(
'Too many changes specified; reverting to "{change}"',
change => 'foo',
)]], 'Should have two warnings';
# Make sure we get an exception for unknown args.
throws_ok { $revert->execute(qw(greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'revert', 'Unknown arg ident should be "revert"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exeption for two unknown arg';
throws_ok { $revert->execute(qw(greg jon)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'revert', 'Unknown args ident should be "revert"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, jon',
), 'Should get an exeption for two unknown args';
# Now specify --modified.
isa_ok $revert = $CLASS->new(
sqitch => $sqitch,
target => 'db:sqlite:welp',
modified => 1,
), $CLASS, 'Object with to and variables';
ok $revert->modified, 'modified should be true';
$common_ancestor_id = 42;
@args = ();
ok $revert->execute, 'Execute again';
is $target->name, 'db:sqlite:welp', 'Target name should be from option';
is_deeply \@args, [$common_ancestor_id, 1, undef], 'the common ancestor id should be passed to the engine revert';
# Test strict mode
$config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir(qw(t sql))->stringify,
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'revert.strict' => 1
);
$sqitch = App::Sqitch->new(config => $config);
isa_ok $revert = $CLASS->new(
sqitch => $sqitch,
target => 'db:sqlite:welp',
no_prompt => 1,
), $CLASS, 'new revert with target';
throws_ok { $revert->execute }
'App::Sqitch::X',
'In strict mode, cannot revert without a specified change';
is $@->ident, 'revert:strict',
'No change in strict mode ident should be "revert:strict"';
is $@->message, __ 'Must specify a target revision in strict mode',
'Should have expected message for no changes in strict mode error';
# Too many targets also fatal in strict mode.
$ENV{FOO}= 1;
throws_ok { $revert->execute('@alpha', '@beta') }
'App::Sqitch::X',
'In strict mode, too many targets is fatal';
is $@->ident, 'revert:strict',
'Too many targets ident should be "revert:strict"';
is $@->message, __ 'Too many changes specified',
'Should have expected message for too many targets error';
done_testing;
user.conf 100644 001751 000166 1021 15004170404 15760 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [user]
name = Michael Stonebraker
email = michael@example.com
[engine "pg"]
client = /opt/local/pgsql/bin/psql
target = db:pg://postgres@localhost/thingies
registry = meta
[engine "mysql"]
client = /opt/local/mysql/bin/mysql
registry = meta
[engine "mysql.variables"]
prefix = foo_
[engine "sqlite"]
client = /opt/local/bin/sqlite3
registry = meta
target = db:sqlite:my.db
[engine "firebird"]
client = /opt/firebird/bin/isql
registry = meta
tag_cmd.t 100644 001751 000166 30631 15004170404 15747 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 86;
#use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::Exception;
use Test::Warn;
use Test::NoWarnings;
use Path::Class qw(file dir);
use File::Path qw(make_path remove_tree);
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::tag';
my $dir = dir 'test-tag_cmd';
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => $dir->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
isa_ok my $tag = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'tag',
config => $config,
}), $CLASS, 'tag command';
ok !$tag->all, 'The all attribute should be false by default';
can_ok $CLASS, qw(
options
configure
note
execute
does
);
ok $CLASS->does("App::Sqitch::Role::ContextCommand"),
"$CLASS does ContextCommand";
is_deeply [$CLASS->options], [qw(
tag-name|tag|t=s
change-name|change|c=s
all|a!
note|n|m=s@
plan-file|f=s
top-dir=s
)], 'Should have note option';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
##############################################################################
# Test configure().
my (@params, $orig_get);
my $cmock = TestConfig->mock(
get => sub { my $c = shift; push @params, \@_; $orig_get->($c, @_) },
);
$orig_get = $cmock->original('get');
is_deeply $CLASS->configure($config, {}), { _cx => [] },
'Should get empty hash for no config or options';
is_deeply \@params, [], 'Should not have fetched boolean tag.all config';
@params = ();
is_deeply $CLASS->configure(
$config,
{ tag_name => 'foo', change_name => 'bar', all => 1 }
),
{ tag_name => 'foo', change_name => 'bar', all => 1, _cx => [] },
'Should get populated hash for no all options';
is_deeply \@params, [], 'Should not have fetched boolean tag.all config';
@params = ();
$cmock->unmock_all;
##############################################################################
# Test tagging a single plan.
make_path $dir->stringify;
END { remove_tree $dir->stringify };
my $plan_file = $tag->default_target->plan_file;
$plan_file->spew("%project=empty\n\n");
# Override request_note().
my $tag_mocker = Test::MockModule->new('App::Sqitch::Plan::Tag');
my %request_params;
$tag_mocker->mock(request_note => sub {
my $self = shift;
%request_params = @_;
$self->note;
});
my $reload = sub {
my $plan = shift;
$plan->_plan( $plan->load);
delete $plan->{$_} for qw(_changes _lines project uri);
1;
};
my $plan = $tag->default_target->plan;
ok $plan->add( name => 'foo' ), 'Add change "foo"';
$plan->write_to( $plan->file );
# Tag it.
isa_ok $tag = App::Sqitch::Command::tag->new({ sqitch => $sqitch }),
$CLASS, 'new tag command';
ok $tag->execute('alpha'), 'Tag @alpha';
ok $reload->($plan), 'Reload plan';
is $plan->get('@alpha')->name, 'foo', 'Should have tagged "foo"';
is $plan->get('@alpha')->name, 'foo', 'New tag should have been written';
is [$plan->tags]->[-1]->note, '', 'New tag should have empty note';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'foo',
tag => '@alpha',
file => $plan->file,
]
], 'The info message should be correct';
# With no arg, should get a list of tags.
ok $tag->execute, 'Execute with no arg';
is_deeply +MockOutput->get_info, [
['@alpha'],
], 'The one tag should have been listed';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
# Add a tag.
ok $plan->tag( name => '@beta' ), 'Add tag @beta';
$plan->write_to( $plan->file );
ok $tag->execute, 'Execute with no arg again';
is_deeply +MockOutput->get_info, [
['@alpha'],
['@beta'],
], 'Both tags should have been listed';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
# Set a note and a name.
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
note => [qw(hello there)],
tag_name => 'gamma',
}), $CLASS, 'tag command with note';
$plan = $tag->default_target->plan;
ok $tag->execute, 'Tag @gamma';
is $plan->get('@gamma')->name, 'foo', 'Gamma tag should be on change "foo"';
is [$plan->tags]->[-1]->note, "hello\n\nthere", 'Gamma tag should have note';
ok $reload->($plan), 'Reload plan';
is $plan->get('@gamma')->name, 'foo', 'Gamma tag should have been written';
is [$plan->tags]->[-1]->note, "hello\n\nthere", 'Written tag should have note';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'foo',
tag => '@gamma',
file => $plan->file,
]
], 'The gamma note should be correct';
# Tag a specific change.
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
note => ['here we go'],
}), $CLASS, 'tag command with note';
$plan = $tag->default_target->plan;
ok $plan->add( name => 'bar' ), 'Add change "bar"';
ok $plan->add( name => 'baz' ), 'Add change "baz"';
$plan->write_to( $plan->file );
ok $tag->execute('delta', 'bar'), 'Tag change "bar" with @delta';
ok $reload->($plan), 'Reload plan';
is $plan->get('@delta')->name, 'bar', 'Should have tagged "bar"';
ok $reload->($plan), 'Reload plan';
is $plan->get('@delta')->name, 'bar', 'New tag should have been written';
is [$plan->tags]->[-1]->note, 'here we go', 'New tag should have the proper note';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'bar',
tag => '@delta',
file => $plan->file,
]
], 'The info message should be correct';
# Use --change to tage a specific change.
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
change_name => 'bar',
note => ['here we go'],
}), $CLASS, 'tag command with change name';
$plan = $tag->default_target->plan;
ok $tag->execute('zeta'), 'Tag change "bar" with @zeta';
is $plan->get('@zeta')->name, 'bar', 'Should have tagged "bar" with @zeta';
ok $reload->($plan), 'Reload plan';
is $plan->get('@zeta')->name, 'bar', 'Tag @zeta should have been written';
is [$plan->tags]->[-1]->note, 'here we go', 'Tag @zeta should have the proper note';
is_deeply \%request_params, { for => __ 'tag' }, 'Should have requested a note';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'bar',
tag => '@zeta',
file => $plan->file,
]
], 'The zeta info message should be correct';
##############################################################################
# Let's deal with multiple engines.
$config->replace(
'core.engine' => 'sqlite',
'engine.pg.plan_file' => $plan->file->stringify,
'engine.sqlite.plan_file' => $plan->file->stringify,
'engine.mysql.plan_file' => $plan->file->stringify,
);
ok $sqitch = App::Sqitch->new(config => $config),
'Load another sqitch sqitch object';
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
all => 1,
note => ['here we go again'],
}), $CLASS, 'another tag command';
$plan = $tag->default_target->plan;
ok $tag->execute('whacko'), 'Tag with @whacko';
is $plan->get('@whacko')->name, 'baz', 'Should have tagged "baz" with @whacko';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'baz',
tag => '@whacko',
file => $plan->file,
]
], 'The whacko info message should be correct';
# With --all and args, should get an error.
throws_ok { $tag->execute('fred', 'pg') } 'App::Sqitch::X',
'Should get an error for --all and a target arg';
is $@->ident, 'tag', 'Mixed arguments error ident should be "tag"';
is $@->message, __(
'Cannot specify both --all and engine, target, or plan arugments'
), 'Mixed arguments error message should be correct';
# Great. Now try two plans!
(my $pg = $dir->file('pg.plan')->stringify) =~ s{\\}{\\\\}g;
(my $sqlite = $dir->file('sqlite.plan')->stringify) =~ s{\\}{\\\\}g;
$dir->file("$_.plan")->spew(
"%project=tag\n\n${_}_change 2012-07-16T17:25:07Z Hi \n"
) for qw(pg sqlite);
$config->replace(
'core.engine' => 'pg',
'core.top_dir' => $dir->stringify,
'engine.pg.plan_file' => $pg,
'engine.sqlite.plan_file' => $sqlite,
'tag.all' => 1,
);
ok $sqitch = App::Sqitch->new(config => $config),
'Load another sqitch sqitch object';
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
note => ['here we go again'],
}), $CLASS, 'yet another tag command';
ok $tag->execute('dubdub'), 'Tag with @dubdub';
my @targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should have two targets';
is $targets[0]->plan->get('@dubdub')->name, 'pg_change',
'Should have tagged pg plan change "pg_change" with @dubdub';
is $targets[1]->plan->get('@dubdub')->name, 'sqlite_change',
'Should have tagged sqlite plan change "sqlite_change" with @dubdub';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'pg_change',
tag => '@dubdub',
file => $targets[0]->plan_file,
],
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'sqlite_change',
tag => '@dubdub',
file => $targets[1]->plan_file,
],
], 'The dubdub info message should show both plans tagged';
# With tag.all and an argument, we should just get the argument.
ok $tag->execute('shoot', 'sqlite'), 'Tag sqlite plan with @shoot';
@targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should still have two targets';
ok !$targets[0]->plan->get('@shoot'),
'Should not have tagged pg plan change "sqlite_change" with @shoot';
is $targets[1]->plan->get('@shoot')->name, 'sqlite_change',
'Should have tagged sqlite plan change "sqlite_change" with @shoot';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'sqlite_change',
tag => '@shoot',
file => $targets[1]->plan_file,
],
], 'The shoot info message should the sqlite plan getting tagged';
# Without --all or tag.all, we should just get the default target.
$config->replace(
'core.engine' => 'pg',
'core.to_dir' => $dir->stringify,
'engine.pg.plan_file' => $pg,
'engine.sqlite.plan_file' => $sqlite,
);
$sqitch = App::Sqitch->new(config => $config);
isa_ok $tag = App::Sqitch::Command::tag->new({
sqitch => $sqitch,
note => ['here we go again'],
}), $CLASS, 'yet another tag command';
ok $tag->execute('huwah'), 'Tag with @huwah';
@targets = App::Sqitch::Target->all_targets(sqitch => $sqitch);
is @targets, 2, 'Should still have two targets';
is $targets[0]->plan->get('@huwah')->name, 'pg_change',
'Should have tagged pg plan change "pg_change" with @huwah';
ok !$targets[1]->plan->get('@huwah'),
'Should not have tagged sqlite plan change "sqlite_change" with @huwah';
is_deeply +MockOutput->get_info, [
[__x
'Tagged "{change}" with {tag} in {file}',
change => 'pg_change',
tag => '@huwah',
file => $targets[0]->plan_file,
],
], 'The huwah info message should the pg plan getting tagged';
# Make sure we die if the passed name conflicts with a target.
TARGET: {
my $mock_add = Test::MockModule->new($CLASS);
$mock_add->mock(parse_args => sub {
return undef, undef, [$tag->default_target];
});
$mock_add->mock(name => 'blog');
my $mock_target = Test::MockModule->new('App::Sqitch::Target');
$mock_target->mock(name => 'blog');
throws_ok { $tag->execute('blog') } 'App::Sqitch::X',
'Should get an error for conflict with target name';
is $@->ident, 'tag', 'Conflicting target error ident should be "tag"';
is $@->message, __x(
'Name "{name}" identifies a target; use "--tag {name}" to use it for the tag name',
name => 'blog',
), 'Conflicting target error message should be correct';
}
options.t 100644 001751 000166 16361 15004170404 16050 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More;
use Test::MockModule;
use Test::Exception;
use Test::Exit;
use Capture::Tiny 0.12 ':all';
use Locale::TextDomain qw(App-Sqitch);
use lib 't/lib';
use TestConfig;
my ($catch_chdir, $chdir_to, $chdir_fail);
BEGIN {
$catch_chdir = 0;
# Stub out chdir.
*CORE::GLOBAL::chdir = sub {
return CORE::chdir(@_) unless $catch_chdir;
$chdir_to = shift;
return !$chdir_fail;
};
}
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch';
use_ok $CLASS or die;
}
is_deeply [$CLASS->_core_opts], [qw(
chdir|cd|C=s
etc-path
no-pager
quiet
verbose|V|v+
help
man
version
)], 'Options should be correct';
##############################################################################
# Test _find_cmd.
can_ok $CLASS, '_find_cmd';
CMD: {
# Mock output methods.
my $mocker = Test::MockModule->new($CLASS);
my $pod;
$mocker->mock(_pod2usage => sub { $pod = $_[1]; undef });
my @vent;
$mocker->mock(vent => sub { shift; push @vent => \@_ });
# Try no args.
my @args = ();
is $CLASS->_find_cmd(\@args), undef, 'Should find no command for no args';
is $pod, 'sqitchcommands', 'Should have passed "sqitchcommands" to _pod2usage';
is_deeply \@vent, [], 'Should have vented nothing';
($pod, @vent) = ();
# Try an invalid command.
@args = qw(barf);
is $CLASS->_find_cmd(\@args), undef, 'Should find no command for invalid command';
is $pod, 'sqitchcommands', 'Should have passed "sqitchcommands" to _pod2usage';
is_deeply \@vent, [
[__x '"{command}" is not a valid command', command => 'barf'],
], 'Should have vented an invalid command message';
($pod, @vent) = ();
# Obvious options should be ignored.
for my $opt (qw(
--foo
--client=psql
-R
-X=yup
)) {
@args = ($opt, 'crack');
is $CLASS->_find_cmd(\@args), undef,
"Should find no command with option $opt";
is $pod, 'sqitchcommands', 'Should have passed "sqitchcommands" to _pod2usage';
is_deeply \@vent, [
[__x '"{command}" is not a valid command', command => 'crack'],
], qq{Should not have reported $opt as invalid command};
($pod, @vent) = ();
}
# Lone -- should cancel processing.
@args = ('--', 'tag');
is $CLASS->_find_cmd(\@args), undef, 'Should find no command after --';
is $pod, 'sqitchcommands', 'Should have passed "sqitchcommands" to _pod2usage';
is_deeply \@vent, [], 'Should have vented nothing';
($pod, @vent) = ();
# Valid command should be removed from args.
for my $cmd (qw(bundle config help plan show tag)) {
@args = (qw(--foo=bar -xy), $cmd, qw(--quack back -x y -z));
my $class = "App::Sqitch::Command::$cmd";
is $CLASS->_find_cmd(\@args), $class, qq{Should find class for "$cmd"};
is $pod, undef, 'Should not have called _pod2usage';
is_deeply \@vent, [], 'Should have vented nothing';
is_deeply \@args, [qw(--foo=bar -xy --quack back -x y -z)],
qq{Should have removed "$cmd" from args};
($pod, @vent) = ();
@args = (qw(--foo=bar), $cmd, qw(verify -x));
is $CLASS->_find_cmd(\@args), $class, qq{Should find class for "$cmd" again};
is $pod, undef, 'Should not have called _pod2usage';
is_deeply \@vent, [], 'Should have vented nothing';
is_deeply \@args, [qw(--foo=bar verify -x)],
qq{Should have left subsequent valid command after "$cmd" in args};
($pod, @vent) = ();
}
}
##############################################################################
# Test _parse_core_opts
can_ok $CLASS, '_parse_core_opts';
is_deeply $CLASS->_parse_core_opts([]), {},
'Should have default config for no options';
# Make sure we can get help.
HELP: {
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(_pod2usage => sub { @args = @_} );
ok $CLASS->_parse_core_opts(['--help']), 'Ask for help';
is_deeply \@args, [ $CLASS, 'sqitchcommands', '-exitval', 0, '-verbose', 2 ],
'Should have been helped';
ok $CLASS->_parse_core_opts(['--man']), 'Ask for man';
is_deeply \@args, [ $CLASS, 'sqitch', '-exitval', 0, '-verbose', 2 ],
'Should have been manned';
}
# Make sure we get the version and etc path.
EXITING: {
my $mocker = Test::MockModule->new($CLASS);
my @emit;
$mocker->mock(emit => sub { shift; push @emit => @_ });
$mocker->mock(VERSION => sub { '1.2.3-testing' });
exits_ok { $CLASS->_parse_core_opts(['--version']) }
'Should have exited on --version';
is_deeply \@emit, ['options.t', ' (', $CLASS, ') ', '1.2.3-testing'],
'Should have emitted the version';
@emit = ();
exits_ok { $CLASS->_parse_core_opts(['--etc-path']) }
'Should have exited on --etc-path';
is_deeply \@emit, [App::Sqitch::Config->system_dir],
'Should have emitted the etc path';
}
# Silence warnings.
my $mock = Test::MockModule->new($CLASS);
$mock->mock(warn => undef);
##############################################################################
# Try lots of options.
my $opts = $CLASS->_parse_core_opts([
'--verbose', '--verbose',
'--no-pager',
]);
is_deeply $opts, {
verbosity => 2,
no_pager => 1,
}, 'Should parse lots of options';
# Make sure --quiet trumps --verbose.
is_deeply $CLASS->_parse_core_opts([
'--verbose', '--verbose', '--quiet'
]), { verbosity => 0 }, '--quiet should trump verbosity.';
##############################################################################
# Try short options.
is_deeply $CLASS->_parse_core_opts([
'-VVV',
]), {
verbosity => 3,
}, 'Short options should work';
USAGE: {
my $mock = Test::MockModule->new('Pod::Usage');
my %args;
$mock->mock(pod2usage => sub { %args = @_} );
ok $CLASS->_pod2usage('sqitch-add', foo => 'bar'), 'Run _pod2usage';
is_deeply \%args, {
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-verbose' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-add'),
'-exitval' => 2,
'foo' => 'bar',
}, 'Proper args should have been passed to Pod::Usage';
}
# Test --chdir.
$catch_chdir = 1;
ok $opts = $CLASS->_parse_core_opts(['--chdir', 'foo/bar']),
'Parse --chdir';
is $chdir_to, 'foo/bar', 'Should have changed to foo/bar';
is_deeply $opts, {}, 'Should have preserved no opts';
ok $opts = $CLASS->_parse_core_opts(['--cd', 'go/dir']), 'Parse --cd';
is $chdir_to, 'go/dir', 'Should have changed to go/dir';
is_deeply $opts, {}, 'Should have preserved no opts';
ok $opts = $CLASS->_parse_core_opts(['-C', 'hi crampus']), 'Parse -C';
is $chdir_to, 'hi crampus', 'Should have changed to hi cramus';
is_deeply $opts, {}, 'Should have preserved no opts';
# Make sure it fails properly.
CHDIE: {
$catch_chdir = 0;
my $exp_err = do { chdir 'nonesuch'; $! };
throws_ok { $CLASS->_parse_core_opts(['-C', 'nonesuch']) }
'App::Sqitch::X', 'Should get error when chdir fails';
is $@->ident, 'fs', 'Error ident should be "fs"';
is $@->message, __x(
'Cannot change to directory {directory}: {error}',
directory => 'nonesuch',
error => $exp_err,
), 'Error message should be correct';
}
done_testing;
upgrade.t 100644 001751 000166 7536 15004170404 15770 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 25;
#use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use Test::Warn;
use Test::MockModule;
use Path::Class;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::upgrade';
require_ok $CLASS;
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir->new('test-upgrade')->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
isa_ok my $upgrade = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'upgrade',
config => $config,
}), $CLASS, 'upgrade command';
can_ok $upgrade, qw(
target
options
execute
configure
does
);
ok $CLASS->does("App::Sqitch::Role::ConnectingCommand"),
"$CLASS does ConnectingCommand";
is_deeply [ $CLASS->options ], [qw(
target|t=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
# Start with the engine up-to-date.
my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my $registry_version = App::Sqitch::Engine->registry_release;
my $upgrade_called = 0;
$engine_mocker->mock(registry_version => sub { $registry_version });
$engine_mocker->mock(upgrade_registry => sub { $upgrade_called = 1 });
ok $upgrade->execute, 'Execute upgrade';
ok !$upgrade_called, 'Upgrade should not have been called';
is_deeply +MockOutput->get_info, [[__x(
'Registry {registry} is up-to-date at version {version}',
registry => 'db:sqlite:',
version => App::Sqitch::Engine->registry_release,
)]], 'Should get output for up-to-date registry';
# Pass in a different target.
ok $upgrade->execute('db:sqlite:foo.db'), 'Execute upgrade with target';
ok !$upgrade_called, 'Upgrade should again not have been called';
is_deeply +MockOutput->get_info, [[__x(
'Registry {registry} is up-to-date at version {version}',
registry => 'db:sqlite:sqitch.db',
version => App::Sqitch::Engine->registry_release,
)]], 'Should get output for up-to-date registry with target';
# Pass in an engine.
ok $upgrade->execute('sqlite'), 'Execute upgrade with engine';
ok !$upgrade_called, 'Upgrade should again not have been called';
is_deeply +MockOutput->get_info, [[__x(
'Registry {registry} is up-to-date at version {version}',
registry => 'db:sqlite:',
version => App::Sqitch::Engine->registry_release,
)]], 'Should get output for up-to-date registry with target';
# Specify a target as an option.
isa_ok $upgrade = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'upgrade',
config => $config,
args => [qw(--target db:sqlite:my.sqlite)],
}), $CLASS, 'upgrade command with target';
ok $upgrade->execute, 'Execute upgrade with target option';
ok !$upgrade_called, 'Upgrade should still not have been called';
is_deeply +MockOutput->get_info, [[__x(
'Registry {registry} is up-to-date at version {version}',
registry => 'db:sqlite:sqitch.sqlite',
version => App::Sqitch::Engine->registry_release,
)]], 'Should get output for up-to-date registry with target option';
# Now make it upgrade.
$registry_version = 0.1;
ok $upgrade->execute, 'Execute upgrade with out-of-date registry';
ok $upgrade_called, 'Upgrade should now have been called';
is_deeply +MockOutput->get_info, [[__x(
'Upgrading registry {registry} to version {version}',
registry => 'db:sqlite:sqitch.sqlite',
version => App::Sqitch::Engine->registry_release,
)]], 'Should get output for the upgrade';
core.conf 100644 001751 000166 27 15004170404 15677 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
engine = pg
vertica.t 100644 001751 000166 33607 15004170404 16014 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# To test against a live Vertica database, you must set the SQITCH_TEST_VSQL_URI
# environment variable. this is a stanard URI::db URI, and should look something
# like this:
#
# export SQITCH_TEST_VSQL_URI=db:vertica://dbadmin:password@localhost:5433/dbadmin?Driver=Vertica
#
# Note that it must include the `?Driver=$driver` bit so that DBD::ODBC loads
# the proper driver.
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::Target;
use App::Sqitch::Plan;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
delete $ENV{"VSQL_$_"} for qw(USER PASSWORD DATABASE HOST PORT);
BEGIN {
$CLASS = 'App::Sqitch::Engine::vertica';
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:vertica:');
my $config = TestConfig->new('core.engine' => 'vertica');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => $uri,
);
isa_ok my $vta = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $vta->key, 'vertica', 'Key should be "vertica"';
is $vta->name, 'Vertica', 'Name should be "Vertica"';
my $client = 'vsql' . (App::Sqitch::ISWIN ? '.exe' : '');
is $vta->client, $client, 'client should default to vsql';
is $vta->registry, 'sqitch', 'registry default should be "sqitch"';
is $vta->uri, $uri, 'DB URI should be "db:vertica:"';
my $dest_uri = $uri->clone;
$dest_uri->dbname($ENV{VSQL_DATABASE} || $ENV{VSQL_USER} || $sqitch->sysuser);
is $vta->destination, $dest_uri->as_string,
'Destination should fall back on environment variables';
is $vta->registry_destination, $vta->destination,
'Registry destination should be the same as destination';
my @std_opts = (
'--quiet',
'--no-vsqlrc',
'--no-align',
'--tuples-only',
'--set' => 'ON_ERROR_STOP=1',
'--set' => 'registry=sqitch',
);
is_deeply [$vta->vsql], [$client, '--username', $sqitch->sysuser, @std_opts],
'vsql command should be username and std opts-only';
isa_ok $vta = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
ok $vta->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'),
'Set some variables';
is_deeply [$vta->vsql], [
$client,
'--username', $sqitch->sysuser,
'--set' => 'foo=baz',
'--set' => 'whu=hi there',
'--set' => 'yo=stellar',
@std_opts,
], 'Variables should be passed to vsql via --set';
##############################################################################
# Test other configs for the target.
ENV: {
# Make sure we override system-set vars.
local $ENV{VSQL_DATABASE};
local $ENV{VSQL_USER};
local $ENV{VSQL_PASSWORD};
for my $env (qw(VSQL_DATABASE VSQL_USER VSQL_PASSWORD)) {
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => $uri->clone,
);
my $vta = $CLASS->new(sqitch => $sqitch, target => $target);
local $ENV{$env} = "\$ENV=whatever";
is $vta->target->name, "db:vertica:", "Target name should not read \$$env";
is $vta->registry_destination, $vta->destination,
'Registry target should be the same as destination';
is $vta->username, $ENV{VSQL_USER} || $sqitch->sysuser,
"Should have username when $env set";
is $vta->password, $ENV{VSQL_PASSWORD},
"Should have password when $env set";
is $vta->_dsn, 'dbi:ODBC:' . ($ENV{VSQL_DATABASE} ? "DSN=$ENV{VSQL_DATABASE}" : ''),
'DSN should have database name when $env set';
}
my $mocker = Test::MockModule->new('App::Sqitch');
$mocker->mock(sysuser => 'sysuser=whatever');
my $vta = $CLASS->new(sqitch => $sqitch, target => $target);
is $vta->target->name, 'db:vertica:',
'Target name should not fall back on sysuser';
is $vta->registry_destination, $vta->destination,
'Registry target should be the same as destination';
$ENV{VSQL_DATABASE} = 'mydb';
$vta = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target);
is $vta->target->name, 'db:vertica:', 'Target name should be the default';
is $vta->registry_destination, $vta->destination,
'Registry target should be the same as destination';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.vertica.client' => '/path/to/vsql',
'engine.vertica.target' => 'db:vertica://localhost/try',
'engine.vertica.registry' => 'meta',
);
$std_opts[-1] = 'registry=meta';
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $vta = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another vertica';
is $vta->client, '/path/to/vsql', 'client should be as configured';
is $vta->uri->as_string, 'db:vertica://localhost/try',
'uri should be as configured';
is $vta->registry, 'meta', 'registry should be as configured';
is_deeply [$vta->vsql], [
'/path/to/vsql',
'--username', $sqitch->sysuser,
'--dbname', 'try',
'--host', 'localhost',
@std_opts
], 'vsql command should be configured from URI config';
##############################################################################
# Test _run(), _capture(), _spool(), and _prob()
can_ok $vta, qw(_run _capture _spool _probe);
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my (@run, $exp_pass);
$mock_sqitch->mock(run => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@run = @_;
if (defined $exp_pass) {
is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist';
}
});
my @capture;
$mock_sqitch->mock(capture => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@capture = @_;
if (defined $exp_pass) {
is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist';
}
});
my @spool;
$mock_sqitch->mock(spool => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@spool = @_;
if (defined $exp_pass) {
is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist';
}
});
my @probe;
$mock_sqitch->mock(probe => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@probe = @_;
if (defined $exp_pass) {
is $ENV{VSQL_PASSWORD}, $exp_pass, qq{VSQL_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{VSQL_PASSWORD}, 'VSQL_PASSWORD should not exist';
}
});
$exp_pass = 's3cr3t';
$target->uri->password($exp_pass);
ok $vta->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@run, [$vta->vsql, qw(foo bar baz)],
'Command should be passed to run()';
ok $vta->_spool('FH'), 'Call _spool';
is_deeply \@spool, ['FH', $vta->vsql],
'Command should be passed to spool()';
ok $vta->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [$vta->vsql, qw(foo bar baz)],
'Command should be passed to capture()';
ok $vta->_probe(qw(hi there)), 'Call _probe';
is_deeply \@probe, [$vta->vsql, qw(hi there)],
'Should have expected arguments to _probe';
# Without password.
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $vta = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a vertica with sqitch with no pw';
$exp_pass = undef;
ok $vta->_run(qw(foo bar baz)), 'Call _run again';
is_deeply \@run, [$vta->vsql, qw(foo bar baz)],
'Command should be passed to run() again';
ok $vta->_spool('FH'), 'Call _spool again';
is_deeply \@spool, ['FH', $vta->vsql],
'Command should be passed to spool() again';
ok $vta->_capture(qw(foo bar baz)), 'Call _capture again';
is_deeply \@capture, [$vta->vsql, qw(foo bar baz)],
'Command should be passed to capture() again';
ok $vta->_probe(qw(go there)), 'Call _probe again';
is_deeply \@probe, [$vta->vsql, qw(go there)],
'Should again have expected arguments to _probe';
##############################################################################
# Test file and handle running.
ok $vta->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, [$vta->vsql, '--file', 'foo/bar.sql'],
'File should be passed to run()';
ok $vta->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, ['FH', $vta->vsql],
'Handle should be passed to spool()';
# Verify should go to capture unless verosity is > 1.
ok $vta->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
is_deeply \@capture, [$vta->vsql, '--file', 'foo/bar.sql'],
'Verify file should be passed to capture()';
$mock_sqitch->mock(verbosity => 2);
ok $vta->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, [$vta->vsql, '--file', 'foo/bar.sql'],
'Verifile file should be passed to run() for high verbosity';
$mock_sqitch->unmock_all;
##############################################################################
# Test DateTime formatting and other database stuff.
ok my $ts2char = $CLASS->can('_ts2char_format'), "$CLASS->can('_ts2char_format')";
is sprintf($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_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 $vta->_listagg_format, undef, 'Should have no listagg format';
##############################################################################
# Test table error methods.
DBI: {
local *DBI::state;
ok !$vta->_no_table_error, 'Should have no table error';
ok !$vta->_no_column_error, 'Should have no column error';
$DBI::state = '42V01';
ok $vta->_no_table_error, 'Should now have table error';
ok !$vta->_no_column_error, 'Still should have no column error';
$DBI::state = '42703';
ok !$vta->_no_table_error, 'Should again have no table error';
ok $vta->_no_column_error, 'Should now have no column error';
}
##############################################################################
# Test current state error handling.
CS: {
my $mock_engine = Test::MockModule->new($CLASS);
$mock_engine->mock(_select_state => sub { die 'OW' });
throws_ok { $vta->current_state } qr/OW/,
"current_state should propagate an error when it's not a column error";
}
##############################################################################
# Test _cid error handling.
CID: {
my $mock_engine = Test::MockModule->new($CLASS);
$mock_engine->mock(dbh => sub { die 'OH NO' });
throws_ok { $vta->_cid } qr/OH NO/,
"_cid should propagate an error when it's not a table or column error";
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($vta->key);
##############################################################################
# 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->{RaiseError} = 0;
$dbh->{PrintError} = 1;
$dbh->do($_) for (
'DROP SCHEMA sqitch CASCADE',
'DROP SCHEMA __sqitchtest CASCADE',
);
}
$uri = URI->new(
$ENV{SQITCH_TEST_VSQL_URI} ||
$ENV{VSQL_URI} ||
'db:vertica://dbadmin:password@localhost/dbadmin'
);
# Try to connect.
my $err;
for my $i (1..30) {
$err = try {
$vta->use_driver;
$dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $vta->error_handler,
});
undef;
} catch {
$_
};
# Sleep if it failed but Vertica is still starting up.
# SQL-57V03: `failed: FATAL 4149: Node startup/recovery in progress. Not yet ready to accept connections`
# SQL-08001: `failed: [Vertica][DSI] An error occurred while attempting to retrieve the error message for key 'VConnectFailed' and component ID 101: Could not open error message files`
last unless $err && (($DBI::state || '') eq '57V03' || $err->message =~ /VConnectFailed/);
sleep 1 if $i < 30;
}
DBIEngineTest->run(
class => $CLASS,
version_query => 'SELECT version()',
target_params => [ uri => $uri ],
alt_target_params => [ uri => $uri, registry => '__sqitchtest' ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have vsql and can connect to the database.
my $version = $self->sqitch->capture( $self->client, '--version' );
say "# Detected $version";
$self->_capture('--command' => 'SELECT version()');
},
engine_err_regex => qr/\bERROR \d+:/,
init_error => __x(
'Sqitch schema "{schema}" already exists',
schema => '__sqitchtest',
),
test_dbh => sub {
my $dbh = shift;
# Make sure the sqitch schema is the first in the search path.
is $dbh->selectcol_arrayref('SELECT current_schema')->[0],
'__sqitchtest', 'The Sqitch schema should be the current schema';
},
);
done_testing;
command.t 100644 001751 000166 72610 15004170404 15772 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 199;
#use Test::More 'no_plan';
use Test::NoWarnings;
use List::Util qw(first);
use lib 't/lib';
use TestConfig;
my $catch_exit;
BEGIN {
$catch_exit = 0;
# Stub out exit.
*CORE::GLOBAL::exit = sub {
die 'EXITED: ' . (@_ ? shift : 0) if $catch_exit;
CORE::exit(@_);
};
}
use App::Sqitch;
use App::Sqitch::Target;
use Test::Exception;
use Test::NoWarnings;
use Test::MockModule;
use Test::Dir;
use File::Path qw(make_path remove_tree);
use Locale::TextDomain qw(App-Sqitch);
use Capture::Tiny 0.12 ':all';
use Path::Class;
use lib 't/lib';
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Command';
use_ok $CLASS or die;
}
can_ok $CLASS, qw(
load
class_for
create
new
options
configure
command
prompt
ask_y_n
parse_args
target_params
default_target
);
COMMAND: {
# Stub out a couple of commands.
package App::Sqitch::Command::whu;
use Moo;
extends 'App::Sqitch::Command';
has foo => (is => 'ro');
has feathers => (is => 'ro');
$INC{'App/Sqitch/Command/whu.pm'} = __FILE__;
sub options {
return qw(
foo
hi-there|h
icky-foo!
feathers=s
);
}
package App::Sqitch::Command::wah_hoo;
use Moo;
extends 'App::Sqitch::Command';
$INC{'App/Sqitch/Command/wah_hoo.pm'} = __FILE__;
}
my $config = TestConfig->new;
ok my $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
##############################################################################
# Test new().
throws_ok { $CLASS->new }
qr/\QMissing required arguments: sqitch/,
'Should get an exception for missing sqitch param';
my $array = [];
throws_ok { $CLASS->new({ sqitch => $array }) }
qr/\QReference [] did not pass type constraint "Sqitch"/,
'Should get an exception for array sqitch param';
throws_ok { $CLASS->new({ sqitch => 'foo' }) }
qr/\QValue "foo" did not pass type constraint "Sqitch"/,
'Should get an exception for string sqitch param';
isa_ok $CLASS->new({sqitch => $sqitch}), $CLASS;
##############################################################################
# Test configure.
my $subclass = 'App::Sqitch::Command::whu';
is_deeply $subclass->configure($config, {}), {},
'Should get empty hash for no config or options';
$config->update('whu.foo' => 'hi');
is_deeply $subclass->configure($config, {}), {foo => 'hi'},
'Should get config with no options';
is_deeply $subclass->configure($config, {foo => 'yo'}), {foo => 'yo'},
'Options should override config';
is_deeply $subclass->configure($config, {'foo_bar' => 'yo'}),
{foo => 'hi', foo_bar => 'yo'},
'Options keys should have dashes changed to underscores';
##############################################################################
# Test class_for().
is $CLASS->class_for($sqitch, 'whu'), 'App::Sqitch::Command::whu',
'Should find class for "whu"';
is $CLASS->class_for($sqitch, 'wah-hoo'), 'App::Sqitch::Command::wah_hoo',
'Should find class for "wah-hoo"';
is $CLASS->class_for($sqitch, 'help'), 'App::Sqitch::Command::help',
'Should find class for "help"';
# Make sure it logs debugging for unkonwn classes.
DEBUG: {
my $smock = Test::MockModule->new('App::Sqitch');
my $debug;
$smock->mock(debug => sub { $debug = $_[1] });
is $CLASS->class_for($sqitch, '_nonesuch'), undef,
'Should find no class for "_nonesush"';
like $debug, qr{^Can't locate App/Sqitch/Command/_nonesuch\.pm in \@INC},
'Should have sent error to debug';
}
##############################################################################
# Test ENGINES.
my $dir = Path::Class::Dir->new(
Path::Class::File->new($INC{"App/Sqitch.pm"})->dir,
qw(Sqitch Engine),
);
my @exp = sort grep { s/\.pm$// } map { $_->basename } $dir->children;
is_deeply [sort $CLASS->ENGINES], \@exp, 'ENGINES should include all engines';
##############################################################################
# Test load().
ok $sqitch = App::Sqitch->new(config => $config), 'Load a sqitch object';
ok my $cmd = $CLASS->load({
command => 'whu',
sqitch => $sqitch,
config => $config,
args => []
}), 'Load a "whu" command';
isa_ok $cmd, 'App::Sqitch::Command::whu';
is $cmd->sqitch, $sqitch, 'The sqitch attribute should be set';
is $cmd->command, 'whu', 'The command method should return "whu"';
$config->update('whu.foo' => 'hi');
ok $cmd = $CLASS->load({
command => 'whu',
sqitch => $sqitch,
config => $config,
args => []
}), 'Load a "whu" command with "foo" config';
is $cmd->foo, 'hi', 'The "foo" attribute should be set';
# Test handling of nonexistent commands.
throws_ok { $CLASS->load({ command => 'nonexistent', sqitch => $sqitch }) }
'App::Sqitch::X', 'Should exit';
is $@->ident, 'command', 'Nonexistent command error ident should be "config"';
is $@->message, __x(
'"{command}" is not a valid command',
command => 'nonexistent',
), 'Should get proper mesage for nonexistent command';
is $@->exitval, 1, 'Nonexistent command should yield exitval of 1';
# Test command that evals to a syntax error.
throws_ok {
local $SIG{__WARN__} = sub { } if $] < 5.11; # Warns on 5.10.
$CLASS->load({ command => 'foo.bar', sqitch => $sqitch })
} 'App::Sqitch::X', 'Should die on bad command';
is $@->ident, 'command', 'Bad command error ident should be "config"';
is $@->message, __x(
'"{command}" is not a valid command',
command => 'foo.bar',
), 'Should get proper mesage for bad command';
is $@->exitval, 1, 'Bad command should yield exitval of 1';
NOCOMMAND: {
# Test handling of no command.
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(usage => sub { @args = @_; die 'USAGE' });
throws_ok { $CLASS->load({ command => '', sqitch => $sqitch }) }
qr/USAGE/, 'No command should yield usage';
is_deeply \@args, [$CLASS], 'No args should be passed to usage';
}
# Test handling a bad command implementation.
throws_ok { $CLASS->load({ command => 'bad', sqitch => $sqitch }) }
'App::Sqitch::X', 'Should die on broken command module';
is $@->ident, 'command', 'Broken command error ident should be "config"';
is $@->message, __x(
'"{command}" is not a valid command',
command => 'bad',
), 'Should get proper mesage for broken command';
is $@->exitval, 1, 'Broken command should yield exitval of 1';
# Test options processing.
$config->update('whu.feathers' => 'yes');
ok $cmd = $CLASS->load({
command => 'whu',
sqitch => $sqitch,
config => $config,
args => ['--feathers' => 'no']
}), 'Load a "whu" command with "--feathers" option';
is $cmd->feathers, 'no', 'The "feathers" attribute should be set';
# Test command with a dash in its name.
ok $cmd = $CLASS->load({
command => 'wah-hoo',
sqitch => $sqitch,
config => $config,
}), 'Load a "wah-hoo" command';
isa_ok $cmd, "$CLASS\::wah_hoo", 'It';
is $cmd->command, 'wah-hoo', 'command() should return hyphenated name';
##############################################################################
# Test create().
my $pkg = $CLASS . '::whu';
$config->replace;
ok $cmd = $pkg->create({
sqitch => $sqitch,
config => $config,
args => []
}), 'Create a "whu" command';
isa_ok $cmd, 'App::Sqitch::Command::whu';
is $cmd->sqitch, $sqitch, 'The sqitch attribute should be set';
is $cmd->command, 'whu', 'The command method should return "whu"';
# Test config merging.
$config->update('whu.foo' => 'hi');
ok $cmd = $pkg->create({
sqitch => $sqitch,
config => $config,
args => []
}), 'Create a "whu" command with "foo" config';
is $cmd->foo, 'hi', 'The "foo" attribute should be set';
# Test options processing.
$config->update('whu.feathers' => 'yes');
ok $cmd = $pkg->create({
sqitch => $sqitch,
config => $config,
args => ['--feathers' => 'no']
}), 'Create a "whu" command with "--feathers" option';
is $cmd->feathers, 'no', 'The "feathers" attribute should be set';
##############################################################################
# Test default_target.
ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create an $CLASS object";
isa_ok my $target = $cmd->default_target, 'App::Sqitch::Target',
'default target';
is $target->name, 'db:', 'Default target name should be "db:"';
is $target->uri, URI->new('db:'), 'Default target URI should be "db:"';
# Track what gets passed to Config->get().
my (@get_keys, $orig_get);
my $cmock = TestConfig->mock(get => sub {
my ($self, %p) = @_;
push @get_keys => $p{key};
$orig_get->($self, %p);
});
$orig_get = $cmock->original('get');
# Make sure the core.engine config option gets used.
$config->update('core.engine' => 'sqlite');
ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create an $CLASS object";
isa_ok $target = $cmd->default_target, 'App::Sqitch::Target',
'default target';
is $target->name, 'db:sqlite:', 'Default target name should be "db:sqlite:"';
is $target->uri, URI->new('db:sqlite:'), 'Default target URI should be "db:sqlite:"';
is_deeply \@get_keys,
[qw(core.engine core.target core.engine engine.sqlite.target)],
'Should have fetched config stuff';
# We should get stuff from the engine section of the config.
$config->update(
'core.engine' => 'pg',
'engine.pg.target' => 'db:pg:foo',
);
@get_keys = ();
ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create an $CLASS object";
isa_ok $target = $cmd->default_target, 'App::Sqitch::Target',
'default target';
is $target->name, 'db:pg:foo', 'Default target name should be "db:pg:foo"';
is $target->uri, URI->new('db:pg:foo'), 'Default target URI should be "db:pg:foo"';
is_deeply \@get_keys,
[qw(core.engine core.target core.engine engine.pg.target)],
'Should have fetched config stuff again';
# Cleanup.
$cmock->unmock('get');
##############################################################################
# Test command and execute.
can_ok $CLASS, 'execute';
ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create an $CLASS object";
is $CLASS->command, '', 'Base class command should be ""';
is $cmd->command, '', 'Base object command should be ""';
throws_ok { $cmd->execute } 'App::Sqitch::X',
'Should get an error calling execute on command base class';
is $@->ident, 'DEV', 'Execute exception ident should be "DEV"';
is $@->message, "The execute() method must be called from a subclass of $CLASS",
'The execute() error message should be correct';
ok $cmd = App::Sqitch::Command::whu->new({sqitch => $sqitch}),
'Create a subclass command object';
is $cmd->command, 'whu', 'Subclass oject command should be "whu"';
is +App::Sqitch::Command::whu->command, 'whu', 'Subclass class command should be "whu"';
throws_ok { $cmd->execute } 'App::Sqitch::X',
'Should get an error for un-overridden execute() method';
is $@->ident, 'DEV', 'Un-overidden execute() exception ident should be "DEV"';
is $@->message, "The execute() method has not been overridden in $CLASS\::whu",
'The unoverridden execute() error message should be correct';
##############################################################################
# Test options parsing.
can_ok $CLASS, 'options', '_parse_opts';
ok $cmd = $CLASS->new({ sqitch => $sqitch }), "Create an $CLASS object again";
is_deeply $cmd->_parse_opts, {}, 'Base _parse_opts should return an empty hash';
ok $cmd = App::Sqitch::Command::whu->new({sqitch => $sqitch}),
'Create a subclass command object again';
is_deeply $cmd->_parse_opts, {}, 'Subclass should return an empty hash for no args';
is_deeply $cmd->_parse_opts([1]), {}, 'Subclass should use options spec';
my $args = [qw(
--foo
--h
--no-icky-foo
--feathers down
whatever
)];
is_deeply $cmd->_parse_opts($args), {
'foo' => 1,
'hi_there' => 1,
'icky_foo' => 0,
'feathers' => 'down',
}, 'Subclass should parse options spec';
is_deeply $args, ['whatever'], 'Args array should be cleared of options';
PARSEOPTSERR: {
# Make sure that invalid options trigger an error.
my $mock = Test::MockModule->new($CLASS);
my @args;
$mock->mock(usage => sub { @args = @_; });
my @warn; local $SIG{__WARN__} = sub { @warn = @_ };
$cmd->_parse_opts(['--dont-do-this']);
is_deeply \@warn, ["Unknown option: dont-do-this\n"],
'Should get warning for unknown option';
is_deeply \@args, [$cmd], 'Should call _pod2usage on options parse failure';
# Try it with a command with no options.
@args = @warn = ();
isa_ok $cmd = App::Sqitch::Command->load({
command => 'good',
sqitch => $sqitch,
config => $config,
}), 'App::Sqitch::Command::good', 'Good command object';
$cmd->_parse_opts(['--dont-do-this']);
is_deeply \@warn, ["Unknown option: dont-do-this\n"],
'Should get warning for unknown option when there are no options';
is_deeply \@args, [$cmd], 'Should call _pod2usage on no options parse failure';
}
##############################################################################
# Test target_params.
is_deeply [$cmd->target_params], [sqitch => $sqitch],
'Should get sqitch param from target_params';
##############################################################################
# Test argument parsing.
ARGS: {
my $config = TestConfig->from(local => file qw(t local.conf) );
$config->update(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t plans multi.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify
);
ok $sqitch = App::Sqitch->new(config => $config),
'Load Sqitch with config and plan';
ok my $cmd = $CLASS->load({
sqitch => $sqitch,
config => $config,
command => 'whu',
}), 'Load cmd with config and plan';
my $parsem = sub {
my @ret = $cmd->parse_args(@_);
# Targets are always second to last.
$ret[-2] = [ map { $_->name } @{ $ret[-2] } ];
return \@ret;
};
my $msg = sub {
__nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
scalar @_,
arg => join ', ', @_
)
};
is_deeply $parsem->(), [['devdb'], []],
'Parsing no args should return default target';
throws_ok { $parsem->( args => ['foo'] ) } 'App::Sqitch::X',
'Single unknown arg raise an error';
is $@->ident, 'whu', 'Unknown error ident should be "whu"';
is $@->message, $msg->('foo'), 'Unknown error message should be correct';
throws_ok { $parsem->( args => ['Changes'] ) } 'App::Sqitch::X',
'Single invavlid fiile arg raise an error';
is $@->ident, 'whu', 'Unknown error ident should be "whu"';
is $@->message, $msg->('Changes'), 'Unknown file error message should be correct';
is_deeply $parsem->( args => ['hey'] ), [['devdb'], ['hey']],
'Single change should be recognized as change';
is_deeply $parsem->( args => ['devdb'] ), [['devdb'], []],
'Single target should be recognized as target';
is_deeply $parsem->(args => ['db:pg:']), [['db:pg:'], []],
'URI target should be recognized as target, too';
is_deeply $parsem->(args => ['devdb', 'hey']), [['devdb'], ['hey']],
'Target and change should be recognized';
is_deeply $parsem->(args => ['hey', 'devdb']), [['devdb'], ['hey']],
'Change and target should be recognized';
is_deeply $parsem->(args => ['mydb', 'users']), [['mydb'], ['users']],
'Alternate Target and change should be recognized';
is_deeply $parsem->(args => ['hey', 'mydb']), [['mydb'], ['hey']],
'Change and alternate target should be recognized';
is_deeply $parsem->(args => ['hey', 'devdb', 'foo'], names => [undef]),
['foo', ['devdb'], ['hey']],
'Change, target, and unknown name should be recognized';
is_deeply $parsem->(args => ['hey', 'devdb', 'foo', 'hey-there'], names => [0]),
['foo', ['devdb'], ['hey', 'hey-there']],
'Multiple changes, target, and unknown name should be recognized';
is_deeply $parsem->(args => ['yuck', 'hey', 'devdb', 'foo'], names => [0, 0]),
['yuck', 'foo', ['devdb'], ['hey']],
'Multiple names should be recognized';
throws_ok {
$parsem->(args => ['yuck', 'hey', 'devdb'], names => ['hi']);
} 'App::Sqitch::X', 'Should get an error with name and unknown';
is $@->ident, 'whu', 'Unknown error ident should be "whu"';
is $@->message, $msg->('yuck'), 'Unknown error message should be correct';
throws_ok {
$parsem->(args => ['yuck', 'hey', 'devdb', 'foo'], names => ['hi']);
} 'App::Sqitch::X', 'Should get an error with name and two unknowns';
is $@->ident, 'whu', 'Two unknowns error ident should be "whu"';
is $@->message, $msg->('yuck', 'foo'),
'Two unknowns error message should be correct';
# Make sure changes are found in previously-passed target.
$config->update('core.top_dir' => dir(qw(t sql))->stringify);
ok $sqitch = App::Sqitch->new(config => $config),
'Load Sqitch with config';
ok $cmd = $CLASS->load({
sqitch => $sqitch,
command => 'whu',
config => $config,
}), 'Load cmd with config';
is_deeply $parsem->(args => ['mydb', 'add_user']),
[['mydb'], ['add_user']],
'Change following target should be recognized from target plan';
# Now pass a target.
is_deeply $parsem->(target => 'devdb'), [['devdb'], []],
'Passed target should always be returned';
is_deeply $parsem->(target => 'devdb', args => ['mydb']),
[['devdb', 'mydb'], []],
'Passed and specified targets should always be returned';
throws_ok {
$parsem->(target => 'devdb', args => ['users'])
} 'App::Sqitch::X', 'Change unknown to passed target should error';
is $@->ident, 'whu', 'Change unknown error ident should be "whu"';
is $@->message, $msg->('users'),
'Change unknown error message should be correct';
$config->update('core.plan_file' => undef);
is_deeply $parsem->(args => ['sqlite', 'widgets', '@beta']),
[['devdb'], ['widgets', '@beta']],
'Should get known changes from default target (t/sql/sqitch.plan)';
throws_ok {
$parsem->(args => ['sqlite', 'widgets', 'mydb', 'foo', '@beta']);
} 'App::Sqitch::X', 'Change seen after target should error if not in that target';
is $@->ident, 'whu', 'Change after target error ident should be "whu"';
is $@->message, $msg->('foo', '@beta'),
'Change after target error message should be correct';
# Make sure a plan file name is recognized as pointing to a target.
is_deeply $parsem->(args => [file(qw(t plans dependencies.plan))->stringify]),
[['mydb'], []], 'Should resolve plan file to a target';
# Should work for default plan file, too.
is_deeply $parsem->(args => [file(qw(t sql sqitch.plan))->stringify]),
[['devdb'], []], 'SHould resolve default plan file to target';
# Should also recognize an engine argument.
is_deeply $parsem->(args => ['pg']), [['mydb'], []],
'Should resolve engine "pg" file to its target';
is_deeply $parsem->(args => ['sqlite']), [['devdb'], []],
'Should resolve engine "sqlite" file to its target';
# Try a bad target.
throws_ok {
$parsem->(args => [target => 'db:']);
} 'App::Sqitch::X', 'Bad target should trigger error';
is $@->ident, 'target', 'Bad target error ident should be "target"';
is $@->message, __x(
'No engine specified by URI {uri}; URI must start with "db:$engine:"',
uri => 'db:',
), 'Should have bad target error message';
# Make sure we don't get an error when the default target has no plan file.
NOPLAN: {
my $mock_target = Test::MockModule->new('App::Sqitch::Target');
$mock_target->mock(plan_file => file 'no-such-file.txt');
is_deeply $parsem->( args => ['devdb'] ), [['devdb'], []],
'Should recognize target when default target has no plan file';
}
# Make sure we get an error when no engine is specified.
NOENGINE: {
my $config = TestConfig->new(
'core.plan_file' => file(qw(t plans multi.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
ok $sqitch = App::Sqitch->new(config => $config),
'Load Sqitch without engine';
ok $cmd = $CLASS->load({
sqitch => $sqitch,
config => $config,
command => 'whu',
}), 'Load cmd without engine';
throws_ok { $parsem->() } 'App::Sqitch::X',
'Should have error for no engine or target';
is $@->ident, 'target', 'Should have target ident';
is $@->message, __(
'No project configuration found. Run the "init" command to initialize a project',
), 'Should have message about no config';
# But it should be okay if we pass an engine or valid target.
is_deeply $parsem->(args => ['pg']),
[['db:pg:'], []],
'Engine arg should override core target error';
is_deeply $parsem->(args => ['db:sqlite:foo']),
[['db:sqlite:foo'], []],
'Target arg should override core target error';
}
}
##############################################################################
# Test _pod2usage().
POD2USAGE: {
my $mock = Test::MockModule->new('Pod::Usage');
my %args;
$mock->mock(pod2usage => sub { %args = @_} );
$cmd = $CLASS->new({ sqitch => $sqitch });
ok $cmd->_pod2usage, 'Call _pod2usage on base object';
is_deeply \%args, {
'-verbose' => 99,
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-exitval' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1}, 'sqitch'),
}, 'Default params should be passed to Pod::Usage';
$cmd = App::Sqitch::Command::whu->new({ sqitch => $sqitch });
ok $cmd->_pod2usage, 'Call _pod2usage on "whu" command object';
is_deeply \%args, {
'-verbose' => 99,
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-exitval' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1}, 'sqitch'),
}, 'Default params should be passed to Pod::Usage';
isa_ok $cmd = App::Sqitch::Command->load({
command => 'config',
sqitch => $sqitch,
config => $config,
}), 'App::Sqitch::Command::config', 'Config command object';
ok $cmd->_pod2usage, 'Call _pod2usage on "config" command object';
is_deeply \%args, {
'-verbose' => 99,
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-exitval' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch-config'),
}, 'Should find sqitch-config docs to pass to Pod::Usage';
isa_ok $cmd = App::Sqitch::Command->load({
command => 'good',
sqitch => $sqitch,
config => $config,
}), 'App::Sqitch::Command::good', 'Good command object';
ok $cmd->_pod2usage, 'Call _pod2usage on "good" command object';
is_deeply \%args, {
'-verbose' => 99,
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-exitval' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch'),
}, 'Should find App::Sqitch::Command::good docs to pass to Pod::Usage';
# Test usage(), too.
can_ok $cmd, 'usage';
$cmd->usage('Hello ', 'gorgeous');
is_deeply \%args, {
'-verbose' => 99,
'-sections' => '(?i:(Usage|Synopsis|Options))',
'-exitval' => 2,
'-input' => Pod::Find::pod_where({'-inc' => 1 }, 'sqitch'),
'-message' => 'Hello gorgeous',
}, 'Should find App::Sqitch::Command::good docs to pass to Pod::Usage';
}
##############################################################################
# Test verbosity.
can_ok $CLASS, 'verbosity';
is $cmd->verbosity, $sqitch->verbosity, 'Verbosity should be from sqitch';
$sqitch->{verbosity} = 3;
is $cmd->verbosity, $sqitch->verbosity, 'Verbosity should change with sqitch';
##############################################################################
# Test message levels. Start with trace.
$sqitch->{verbosity} = 3;
is capture_stdout { $cmd->trace('This ', "that\n", 'and the other') },
"trace: This that\ntrace: and the other\n",
'trace should work';
$sqitch->{verbosity} = 2;
is capture_stdout { $cmd->trace('This ', "that\n", 'and the other') },
'', 'Should get no trace output for verbosity 2';
# Trace literal.
$sqitch->{verbosity} = 3;
is capture_stdout { $cmd->trace_literal('This ', "that\n", 'and the other') },
"trace: This that\ntrace: and the other",
'trace_literal should work';
$sqitch->{verbosity} = 2;
is capture_stdout { $cmd->trace_literal('This ', "that\n", 'and the other') },
'', 'Should get no trace_literal output for verbosity 2';
# Debug.
$sqitch->{verbosity} = 2;
is capture_stdout { $cmd->debug('This ', "that\n", 'and the other') },
"debug: This that\ndebug: and the other\n",
'debug should work';
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->debug('This ', "that\n", 'and the other') },
'', 'Should get no debug output for verbosity 1';
# Debug literal.
$sqitch->{verbosity} = 2;
is capture_stdout { $cmd->debug_literal('This ', "that\n", 'and the other') },
"debug: This that\ndebug: and the other",
'debug_literal should work';
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->debug_literal('This ', "that\n", 'and the other') },
'', 'Should get no debug_literal output for verbosity 1';
# Info.
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->info('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'info should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $cmd->info('This ', "that\n", 'and the other') },
'', 'Should get no info output for verbosity 0';
# Info literal.
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->info_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'info_literal should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $cmd->info_literal('This ', "that\n", 'and the other') },
'', 'Should get no info_literal output for verbosity 0';
# Comment.
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->comment('This ', "that\n", 'and the other') },
"# This that\n# and the other\n",
'comment should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $sqitch->comment('This ', "that\n", 'and the other') },
"# This that\n# and the other\n",
'comment should work with verbosity 0';
# Comment literal.
$sqitch->{verbosity} = 1;
is capture_stdout { $cmd->comment_literal('This ', "that\n", 'and the other') },
"# This that\n# and the other",
'comment_literal should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $sqitch->comment_literal('This ', "that\n", 'and the other') },
"# This that\n# and the other",
'comment_literal should work with verbosity 0';
# Emit.
is capture_stdout { $cmd->emit('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'emit should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $cmd->emit('This ', "that\n", 'and the other') },
"This that\nand the other\n",
'emit should work even with verbosity 0';
# Emit literal.
is capture_stdout { $cmd->emit_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'emit_literal should work';
$sqitch->{verbosity} = 0;
is capture_stdout { $cmd->emit_literal('This ', "that\n", 'and the other') },
"This that\nand the other",
'emit_literal should work even with verbosity 0';
# Warn.
is capture_stderr { $cmd->warn('This ', "that\n", 'and the other') },
"warning: This that\nwarning: and the other\n",
'warn should work';
# Warn literal.
is capture_stderr { $cmd->warn_literal('This ', "that\n", 'and the other') },
"warning: This that\nwarning: and the other",
'warn_literal should work';
# Usage.
$catch_exit = 1;
like capture_stderr {
throws_ok { $cmd->usage('Invalid whozit') } qr/EXITED: 2/
}, qr/Invalid whozit/, 'usage should work';
like capture_stderr {
throws_ok { $cmd->usage('Invalid whozit') } qr/EXITED: 2/
}, qr/\Qsqitch [options] [command-options] [args]/,
'usage should prefer sqitch-$command-usage';
##############################################################################
# Test _mkpath.
require MockOutput;
my $path = dir 'delete.me';
dir_not_exists_ok $path, "Path $path should not exist";
END { remove_tree $path->stringify if -e $path }
ok $cmd->_mkpath($path), "Create $path";
dir_exists_ok $path, "Path $path should now exist";
is_deeply +MockOutput->get_debug, [[' ', __x 'Created {file}', file => $path]],
'The mkdir info should have been output';
# Create it again.
ok $cmd->_mkpath($path), "Create $path again";
dir_exists_ok $path, "Path $path should still exist";
is_deeply +MockOutput->get_debug, [], 'Nothing should have been emitted';
# Handle errors.
FSERR: {
# Make mkpath to insert an error.
my $mock = Test::MockModule->new('File::Path');
$mock->mock( mkpath => sub {
my ($file, $p) = @_;
${ $p->{error} } = [{ $file => 'Permission denied yo'}];
return;
});
throws_ok { $cmd->_mkpath('foo') } 'App::Sqitch::X',
'Should fail on permission issue';
is $@->ident, 'good', 'Permission error should have ident "good"';
is $@->message, __x(
'Error creating {path}: {error}',
path => 'foo',
error => 'Permission denied yo',
), 'The permission error should be formatted properly';
# Try an error with no path.
throws_ok { $cmd->_mkpath('') } 'App::Sqitch::X',
'Should fail on nonexistent file';
is $@->ident, 'good', 'Nonexistant path error should have ident "good"';
is $@->message, 'Permission denied yo',
'Nonexistant path error should be the message';
}
lib 000755 001751 000166 0 15004170404 14547 5 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t LC.pm 100644 001751 000166 607 15004170404 15526 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t/lib package LC;
our $TIME = do {
if ($^O eq 'MSWin32') {
require Win32::Locale;
Win32::Locale::get_locale();
} else {
require POSIX;
POSIX::setlocale( POSIX::LC_TIME() );
}
};
# https://github.com/sqitchers/sqitch/issues/230#issuecomment-103946451
# https://rt.cpan.org/Ticket/Display.html?id=104574
$TIME = 'en_US_POSIX' if $TIME eq 'C.UTF-8';
1;
plan_cmd.t 100644 001751 000166 66722 15004170404 16140 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 234;
# use Test::More 'no_plan';
use App::Sqitch;
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use Test::Warn;
use Test::MockModule;
use Path::Class;
use Term::ANSIColor qw(color);
use Encode;
use lib 't/lib';
use MockOutput;
use TestConfig;
use LC;
local $ENV{TZ} = 'Asia/Tokyo';
my $CLASS = 'App::Sqitch::Command::plan';
require_ok $CLASS;
my $config = TestConfig->new(
'core.engine' => 'sqlite',
'core.top_dir' => dir('test-plan_cmd')->stringify,
'core.plan_file' => file(qw(t plans dependencies.plan))->stringify,
);
ok my $sqitch = App::Sqitch->new(config => $config),
'Load a sqitch sqitch object';
isa_ok my $cmd = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'plan',
config => $config,
}), $CLASS, 'plan command';
can_ok $cmd, qw(
target
change_pattern
planner_pattern
max_count
skip
reverse
format
options
execute
configure
headers
);
is_deeply [$CLASS->options], [qw(
event=s
target|t=s
change-pattern|change=s
planner-pattern|planner=s
format|f=s
date-format|date=s
max-count|n=i
skip=i
reverse!
color=s
no-color
abbrev=i
oneline
headers!
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
##############################################################################
# Test configure().
my $configured = $CLASS->configure($config, {});
isa_ok delete $configured->{formatter}, 'App::Sqitch::ItemFormatter', 'Formatter';
is_deeply $configured, {},
'Should get empty hash for no config or options';
# Test date_format validation.
$config->update('plan.date_format' => 'nonesuch');
throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X',
'Should get error for invalid date format in config';
is $@->ident, 'datetime',
'Invalid date format error ident should be "datetime"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'nonesuch',
), 'Invalid date format error message should be correct';
throws_ok { $CLASS->configure($config, { date_format => 'non'}), {} }
'App::Sqitch::X',
'Should get error for invalid date format in optsions';
is $@->ident, 'datetime',
'Invalid date format error ident should be "plan"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'non',
), 'Invalid date format error message should be correct';
# Test format validation.
$config = TestConfig->new('plan.format' => 'nonesuch');
throws_ok { $CLASS->configure($config, {}), {} } 'App::Sqitch::X',
'Should get error for invalid format in config';
is $@->ident, 'plan',
'Invalid format error ident should be "plan"';
is $@->message, __x(
'Unknown plan format "{format}"',
format => 'nonesuch',
), 'Invalid format error message should be correct';
throws_ok { $CLASS->configure($config, { format => 'non'}), {} }
'App::Sqitch::X',
'Should get error for invalid format in optsions';
is $@->ident, 'plan',
'Invalid format error ident should be "plan"';
is $@->message, __x(
'Unknown plan format "{format}"',
format => 'non',
), 'Invalid format error message should be correct';
# Test color configuration.
$config = TestConfig->new;
$configured = $CLASS->configure( $config, { no_color => 1 } );
is $configured->{formatter}->color, 'never',
'Configuration should respect --no-color, setting "never"';
# Test oneline configuration.
$configured = $CLASS->configure( $config, { oneline => 1 });
is $configured->{format}, '%{:event}C%h %l%{reset}C %n%{cyan}C%t%{reset}C',
'--oneline should set format';
is $configured->{formatter}{abbrev}, 6, '--oneline should set abbrev to 6';
$configured = $CLASS->configure( $config, { oneline => 1, format => 'format:foo', abbrev => 5 });
is $configured->{format}, 'foo', '--oneline should not override --format';
is $configured->{formatter}{abbrev}, 5, '--oneline should not overrride --abbrev';
$config->update('plan.color' => 'auto');
$configured = $CLASS->configure( $config, { no_color => 1 } );
is $configured->{formatter}->color, 'never',
'Configuration should respect --no-color even when configure is set';
NEVER: {
my $configured = $CLASS->configure( $config, { color => 'never' } );
is $configured->{formatter}->color, 'never',
'Configuration should respect color option';
# Try it with config.
$config->update('plan.color' => 'never');
$configured = $CLASS->configure( $config, {} );
is $configured->{formatter}->color, 'never',
'Configuration should respect color config';
}
ALWAYS: {
my $configured = $CLASS->configure( $config, { color => 'always' } );
is_deeply $configured->{formatter}->color, 'always',
'Configuration should respect color option';
# Try it with config.
$config->update('plan.color' => 'always');
$configured = $CLASS->configure( $config, {} );
is_deeply $configured->{formatter}->color, 'always',
'Configuration should respect color config';
}
AUTO: {
for my $enabled (0, 1) {
$config->update('plan.color' => 'always');
my $configured = $CLASS->configure( $config, { color => 'auto' } );
is_deeply $configured->{formatter}->color, 'auto',
'Configuration should respect color option';
# Try it with config.
$config->update('plan.color' => 'auto');
$configured = $CLASS->configure( $config, {} );
is_deeply $configured->{formatter}->color, 'auto',
'Configuration should respect color config';
}
}
###############################################################################
# Test named formats.
my $cdt = App::Sqitch::DateTime->now;
my $pdt = $cdt->clone->subtract(days => 1);
my $change = {
event => 'deploy',
project => 'planit',
change_id => '000011112222333444',
change => 'lolz',
tags => [ '@beta', '@gamma' ],
planner_name => 'damian',
planner_email => 'damian@example.com',
planned_at => $pdt,
note => "For the LOLZ.\n\nYou know, funny stuff and cute kittens, right?",
requires => [qw(foo bar)],
conflicts => []
};
my $piso = $pdt->as_string( format => 'iso' );
my $praw = $pdt->as_string( format => 'raw' );
for my $spec (
[ raw => "deploy 000011112222333444 (\@beta, \@gamma)\n"
. "name lolz\n"
. "project planit\n"
. "requires foo, bar\n"
. "planner damian \n"
. "planned $praw\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ full => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n"
. __('Name: ') . " lolz\n"
. __('Project: ') . " planit\n"
. __('Requires: ') . " foo, bar\n"
. __('Planner: ') . " damian \n"
. __('Planned: ') . " __PDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ long => __('Deploy') . " 000011112222333444 (\@beta, \@gamma)\n"
. __('Name: ') . " lolz\n"
. __('Project: ') . " planit\n"
. __('Planner: ') . " damian \n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ medium => __('Deploy') . " 000011112222333444\n"
. __('Name: ') . " lolz\n"
. __('Planner: ') . " damian \n"
. __('Date: ') . " __PDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ short => __('Deploy') . " 000011112222333444\n"
. __('Name: ') . " lolz\n"
. __('Planner: ') . " damian \n\n"
. " For the LOLZ.\n",
],
[ oneline => '000011112222333444 ' . __('deploy') . ' lolz @beta, @gamma' ],
) {
local $ENV{ANSI_COLORS_DISABLED} = 1;
my $configured = $CLASS->configure( $config, { format => $spec->[0] } );
my $format = $configured->{format};
ok my $cmd = $CLASS->new( sqitch => $sqitch, %{ $configured } ),
qq{Instantiate with format "$spec->[0]"};
(my $exp = $spec->[1]) =~ s/__PDATE__/$piso/;
is $cmd->formatter->format( $cmd->format, $change ), $exp,
qq{Format "$spec->[0]" should output correctly};
if ($spec->[1] =~ /__PDATE__/) {
# Test different date formats.
for my $date_format (qw(rfc long medium)) {
ok my $cmd = $CLASS->new(
sqitch => $sqitch,
format => $format,
formatter => App::Sqitch::ItemFormatter->new(date_format => $date_format),
), qq{Instantiate with format "$spec->[0]" and date format "$date_format"};
my $date = $pdt->as_string( format => $date_format );
(my $exp = $spec->[1]) =~ s/__PDATE__/$date/;
is $cmd->formatter->format( $cmd->format, $change ), $exp,
qq{Format "$spec->[0]" and date format "$date_format" should output correctly};
}
}
if ($spec->[1] =~ s/\s+[(]?[@]beta,\s+[@]gamma[)]?//) {
# Test without tags.
local $change->{tags} = [];
(my $exp = $spec->[1]) =~ s/__PDATE__/$piso/;
is $cmd->formatter->format( $cmd->format, $change ), $exp,
qq{Format "$spec->[0]" should output correctly without tags};
}
}
###############################################################################
# Test all formatting characters.
my $local_pdt = $pdt->clone;
$local_pdt->set_time_zone('local');
$local_pdt->set_locale($LC::TIME);
my $formatter = $cmd->formatter;
for my $spec (
['%e', { event => 'deploy' }, 'deploy' ],
['%e', { event => 'revert' }, 'revert' ],
['%e', { event => 'fail' }, 'fail' ],
['%L', { event => 'deploy' }, __ 'Deploy' ],
['%L', { event => 'revert' }, __ 'Revert' ],
['%L', { event => 'fail' }, __ 'Fail' ],
['%l', { event => 'deploy' }, __ 'deploy' ],
['%l', { event => 'revert' }, __ 'revert' ],
['%l', { event => 'fail' }, __ 'fail' ],
['%{event}_', {}, __ 'Event: ' ],
['%{change}_', {}, __ 'Change: ' ],
['%{planner}_', {}, __ 'Planner: ' ],
['%{by}_', {}, __ 'By: ' ],
['%{date}_', {}, __ 'Date: ' ],
['%{planned}_', {}, __ 'Planned: ' ],
['%{name}_', {}, __ 'Name: ' ],
['%{email}_', {}, __ 'Email: ' ],
['%{requires}_', {}, __ 'Requires: ' ],
['%{conflicts}_', {}, __ 'Conflicts:' ],
['%H', { change_id => '123456789' }, '123456789' ],
['%h', { change_id => '123456789' }, '123456789' ],
['%{5}h', { change_id => '123456789' }, '12345' ],
['%{7}h', { change_id => '123456789' }, '1234567' ],
['%n', { change => 'foo' }, 'foo'],
['%n', { change => 'bar' }, 'bar'],
['%o', { project => 'foo' }, 'foo'],
['%o', { project => 'bar' }, 'bar'],
['%F', { deploy_file => 'deploy/change_file.sql' }, 'deploy/change_file.sql'],
['%F', { deploy_file => 'deploy/change_file_with_tag@tag.sql' }, 'deploy/change_file_with_tag@tag.sql'],
['%p', { planner_name => 'larry', planner_email => 'larry@example.com' }, 'larry '],
['%{n}p', { planner_name => 'damian' }, 'damian'],
['%{name}p', { planner_name => 'chip' }, 'chip'],
['%{e}p', { planner_email => 'larry@example.com' }, 'larry@example.com'],
['%{email}p', { planner_email => 'damian@example.com' }, 'damian@example.com'],
['%{date}p', { planned_at => $pdt }, $pdt->as_string( format => 'iso' ) ],
['%{date:rfc}p', { planned_at => $pdt }, $pdt->as_string( format => 'rfc' ) ],
['%{d:long}p', { planned_at => $pdt }, $pdt->as_string( format => 'long' ) ],
["%{d:cldr:HH'h' mm'm'}p", { planned_at => $pdt }, $local_pdt->format_cldr( q{HH'h' mm'm'} ) ],
["%{d:strftime:%a at %H:%M:%S}p", { planned_at => $pdt }, $local_pdt->strftime('%a at %H:%M:%S') ],
['%t', { tags => [] }, '' ],
['%t', { tags => ['@foo'] }, ' @foo' ],
['%t', { tags => ['@foo', '@bar'] }, ' @foo, @bar' ],
['%{|}t', { tags => [] }, '' ],
['%{|}t', { tags => ['@foo'] }, ' @foo' ],
['%{|}t', { tags => ['@foo', '@bar'] }, ' @foo|@bar' ],
['%T', { tags => [] }, '' ],
['%T', { tags => ['@foo'] }, ' (@foo)' ],
['%T', { tags => ['@foo', '@bar'] }, ' (@foo, @bar)' ],
['%{|}T', { tags => [] }, '' ],
['%{|}T', { tags => ['@foo'] }, ' (@foo)' ],
['%{|}T', { tags => ['@foo', '@bar'] }, ' (@foo|@bar)' ],
['%r', { requires => [] }, '' ],
['%r', { requires => ['foo'] }, ' foo' ],
['%r', { requires => ['foo', 'bar'] }, ' foo, bar' ],
['%{|}r', { requires => [] }, '' ],
['%{|}r', { requires => ['foo'] }, ' foo' ],
['%{|}r', { requires => ['foo', 'bar'] }, ' foo|bar' ],
['%R', { requires => [] }, '' ],
['%R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ],
['%R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo, bar\n" ],
['%{|}R', { requires => [] }, '' ],
['%{|}R', { requires => ['foo'] }, __('Requires: ') . " foo\n" ],
['%{|}R', { requires => ['foo', 'bar'] }, __('Requires: ') . " foo|bar\n" ],
['%x', { conflicts => [] }, '' ],
['%x', { conflicts => ['foo'] }, ' foo' ],
['%x', { conflicts => ['foo', 'bax'] }, ' foo, bax' ],
['%{|}x', { conflicts => [] }, '' ],
['%{|}x', { conflicts => ['foo'] }, ' foo' ],
['%{|}x', { conflicts => ['foo', 'bax'] }, ' foo|bax' ],
['%X', { conflicts => [] }, '' ],
['%X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ],
['%X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo, bar\n" ],
['%{|}X', { conflicts => [] }, '' ],
['%{|}X', { conflicts => ['foo'] }, __('Conflicts:') . " foo\n" ],
['%{|}X', { conflicts => ['foo', 'bar'] }, __('Conflicts:') . " foo|bar\n" ],
['%{yellow}C', {}, '' ],
['%{:event}C', { event => 'deploy' }, '' ],
['%v', {}, "\n" ],
['%%', {}, '%' ],
['%s', { note => 'hi there' }, 'hi there' ],
['%s', { note => "hi there\nyo" }, 'hi there' ],
['%s', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, 'subject line' ],
['%{ }s', { note => 'hi there' }, ' hi there' ],
['%{xx}s', { note => 'hi there' }, 'xxhi there' ],
['%b', { note => 'hi there' }, '' ],
['%b', { note => "hi there\nyo" }, 'yo' ],
['%b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "first graph\n\nsecond graph\n\n" ],
['%{ }b', { note => 'hi there' }, '' ],
['%{xxx }b', { note => "hi there\nyo" }, "xxx yo" ],
['%{x}b', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xfirst graph\nx\nxsecond graph\nx\n" ],
['%{ }b', { note => "hi there\r\nyo" }, " yo" ],
['%B', { note => 'hi there' }, 'hi there' ],
['%B', { note => "hi there\nyo" }, "hi there\nyo" ],
['%B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "subject line\n\nfirst graph\n\nsecond graph\n\n" ],
['%{ }B', { note => 'hi there' }, ' hi there' ],
['%{xxx }B', { note => "hi there\nyo" }, "xxx hi there\nxxx yo" ],
['%{x}B', { note => "subject line\n\nfirst graph\n\nsecond graph\n\n" }, "xsubject line\nx\nxfirst graph\nx\nxsecond graph\nx\n" ],
['%{ }B', { note => "hi there\r\nyo" }, " hi there\r\n yo" ],
['%{change}a', $change, "change $change->{change}\n" ],
['%{change_id}a', $change, "change_id $change->{change_id}\n" ],
['%{event}a', $change, "event $change->{event}\n" ],
['%{tags}a', $change, 'tags ' . join(', ', @{ $change->{tags} }) . "\n" ],
['%{requires}a', $change, 'requires ' . join(', ', @{ $change->{requires} }) . "\n" ],
['%{conflicts}a', $change, '' ],
) {
local $ENV{ANSI_COLORS_DISABLED} = 1;
(my $desc = encode_utf8 $spec->[2]) =~ s/\n/[newline]/g;
is $formatter->format( $spec->[0], $spec->[1] ), $spec->[2],
qq{Format "$spec->[0]" should output "$desc"};
}
throws_ok { $formatter->format( '%_', {} ) } 'App::Sqitch::X',
'Should get exception for format "%_"';
is $@->ident, 'format', '%_ error ident should be "format"';
is $@->message, __ 'No label passed to the _ format',
'%_ error message should be correct';
throws_ok { $formatter->format( '%{foo}_', {} ) } 'App::Sqitch::X',
'Should get exception for unknown label in format "%_"';
is $@->ident, 'format', 'Invalid %_ label error ident should be "format"';
is $@->message, __x(
'Unknown label "{label}" passed to the _ format',
label => 'foo'
), 'Invalid %_ label error message should be correct';
ok $cmd = $CLASS->new(
sqitch => $sqitch,
formatter => App::Sqitch::ItemFormatter->new(abbrev => 4)
), 'Instantiate with abbrev => 4';
is $cmd->formatter->format( '%h', { change_id => '123456789' } ),
'1234', '%h should respect abbrev';
is $cmd->formatter->format( '%H', { change_id => '123456789' } ),
'123456789', '%H should not respect abbrev';
ok $cmd = $CLASS->new(
sqitch => $sqitch,
formatter => App::Sqitch::ItemFormatter->new(date_format => 'rfc')
), 'Instantiate with date_format => "rfc"';
is $cmd->formatter->format( '%{date}p', { planned_at => $cdt } ),
$cdt->as_string( format => 'rfc' ),
'%{date}p should respect the date_format attribute';
is $cmd->formatter->format( '%{d:iso}p', { planned_at => $cdt } ),
$cdt->as_string( format => 'iso' ),
'%{iso}p should override the date_format attribute';
throws_ok { $formatter->format( '%{foo}a', {}) } 'App::Sqitch::X',
'Should get exception for unknown attribute passed to %a';
is $@->ident, 'format', '%a error ident should be "format"';
is $@->message, __x(
'{attr} is not a valid change attribute', attr => 'foo'
), '%a error message should be correct';
delete $ENV{ANSI_COLORS_DISABLED};
for my $color (qw(yellow red blue cyan magenta)) {
is $formatter->format( "%{$color}C", {} ), color($color),
qq{Format "%{$color}C" should output }
. color($color) . $color . color('reset');
}
for my $spec (
[ ':event', { event => 'deploy' }, 'green', 'deploy' ],
[ ':event', { event => 'revert' }, 'blue', 'revert' ],
[ ':event', { event => 'fail' }, 'red', 'fail' ],
) {
is $formatter->format( "%{$spec->[0]}C", $spec->[1] ), color($spec->[2]),
qq{Format "%{$spec->[0]}C" on "$spec->[3]" should output }
. color($spec->[2]) . $spec->[2] . color('reset');
}
# Make sure other colors work.
my $yellow = color('yellow') . '%s' . color('reset');
my $green = color('green') . '%s' . color('reset');
my $cyan = color('cyan') . ' %s' . color('reset');
$change->{conflicts} = [qw(dr_evil)];
for my $spec (
[ full => sprintf($green, __ ('Deploy') . ' 000011112222333444')
. " (\@beta, \@gamma)\n"
. __ ('Name: ') . " lolz\n"
. __ ('Project: ') . " planit\n"
. __ ('Requires: ') . " foo, bar\n"
. __ ('Conflicts:') . " dr_evil\n"
. __ ('Planner: ') . " damian \n"
. __ ('Planned: ') . " __PDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ long => sprintf($green, __ ('Deploy') . ' 000011112222333444')
. " (\@beta, \@gamma)\n"
. __ ('Name: ') . " lolz\n"
. __ ('Project: ') . " planit\n"
. __ ('Planner: ') . " damian \n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ medium => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n"
. __ ('Name: ') . " lolz\n"
. __ ('Planner: ') . " damian \n"
. __ ('Date: ') . " __PDATE__\n\n"
. " For the LOLZ.\n \n You know, funny stuff and cute kittens, right?\n"
],
[ short => sprintf($green, __ ('Deploy') . ' 000011112222333444') . "\n"
. __ ('Name: ') . " lolz\n"
. __ ('Planner: ') . " damian \n\n"
. " For the LOLZ.\n",
],
[ oneline => sprintf "$green %s$cyan", '000011112222333444' . ' '
. __('deploy'), 'lolz', '@beta, @gamma',
],
) {
my $format = $CLASS->configure( $config, { format => $spec->[0] } )->{format};
ok my $cmd = $CLASS->new( sqitch => $sqitch, format => $format ),
qq{Instantiate with format "$spec->[0]" again};
(my $exp = $spec->[1]) =~ s/__PDATE__/$piso/;
is $cmd->formatter->format( $cmd->format, $change ), $exp,
qq{Format "$spec->[0]" should output correctly with color};
}
throws_ok { $formatter->format( '%{BLUELOLZ}C', {} ) } 'App::Sqitch::X',
'Should get an error for an invalid color';
is $@->ident, 'format', 'Invalid color error ident should be "format"';
is $@->message, __x(
'{color} is not a valid ANSI color', color => 'BLUELOLZ'
), 'Invalid color error message should be correct';
##############################################################################
# Test execute().
my $pmock = Test::MockModule->new('App::Sqitch::Plan');
# First, test for no changes.
$pmock->mock(count => 0);
my $plan = $cmd->default_target->plan;
throws_ok { $cmd->execute } 'App::Sqitch::X',
'Should get error for no changes';
is $@->ident, 'plan', 'no changes error ident should be "plan"';
is $@->exitval, 1, 'no changes exit val should be 1';
is $@->message, __x(
'No changes in {file}',
file => $plan->file,
), 'no changes error message should be correct';
$pmock->unmock('count');
# Okay, let's see some changes.
my @changes;
my $iter = sub { shift @changes };
my $search_args;
$pmock->mock(search_changes => sub {
shift;
$search_args = [@_];
return $iter;
});
$change = $plan->change_at(0);
push @changes => $change;
ok $cmd->execute, 'Execute plan';
is_deeply $search_args, [
operation => undef,
name => undef,
planner => undef,
limit => undef,
offset => undef,
direction => 'ASC'
], 'The proper args should have been passed to search_events';
my $fmt_params = {
event => $change->is_deploy ? 'deploy' : 'revert',
project => $change->project,
change_id => $change->id,
change => $change->name,
note => $change->note,
deploy_file => $change->deploy_file,
tags => [ map { $_->format_name } $change->tags ],
requires => [ map { $_->as_string } $change->requires ],
conflicts => [ map { $_->as_string } $change->conflicts ],
planned_at => $change->timestamp,
planner_name => $change->planner_name,
planner_email => $change->planner_email,
};
is_deeply +MockOutput->get_page, [
['# ', __x 'Project: {project}', project => $plan->project ],
['# ', __x 'File: {file}', file => $plan->file ],
[''],
[ $cmd->formatter->format( $cmd->format, $fmt_params ) ],
], 'The event should have been paged';
# Set attributes and add more events.
isa_ok $cmd = $CLASS->new(
sqitch => $sqitch,
event => 'deploy',
change_pattern => '.+',
project_pattern => '.+',
planner_pattern => '.+',
max_count => 10,
skip => 5,
reverse => 1,
headers => 0,
), $CLASS, 'plan with attributes';
$plan = $cmd->default_target->plan;
$change = $plan->change_at(0);
my $change2 = $plan->change_at(1);
push @changes => $change, $change2;
ok $cmd->execute, 'Execute plan with attributes';
is_deeply $search_args, [
operation => 'deploy',
name => '.+',
planner => '.+',
limit => 10,
offset => 5,
direction => 'DESC'
], 'All params should have been passed to search_events';
my $fmt_params2 = {
event => $change2->is_deploy ? 'deploy' : 'revert',
project => $change2->project,
change_id => $change2->id,
change => $change2->name,
note => $change2->note,
deploy_file => $change2->deploy_file,
tags => [ map { $_->format_name } $change2->tags ],
requires => [ map { $_->as_string } $change2->requires ],
conflicts => [ map { $_->as_string } $change2->conflicts ],
planned_at => $change2->timestamp,
planner_name => $change2->planner_name,
planner_email => $change2->planner_email,
};
is_deeply +MockOutput->get_page, [
[ $cmd->formatter->format( $cmd->format, $fmt_params ) ],
[ $cmd->formatter->format( $cmd->format, $fmt_params2 ) ],
], 'Both events should have been paged without headers';
# Now try raw format of all the changes.
my $cfg = $CLASS->configure( $config, { format => 'raw' } );
ok $cmd = $CLASS->new( sqitch => $sqitch, %{ $cfg } ),
'Create command with raw format';
$plan = $cmd->default_target->plan;
push @changes => $plan->changes;
ok $cmd->execute, 'Execute plan with all changes';
is_deeply +MockOutput->get_page, [
['# ', __x 'Project: {project}', project => $plan->project ],
['# ', __x 'File: {file}', file => $plan->file ],
[''],
map { [ $cmd->formatter->format( $cmd->format, {
event => $_->is_deploy ? 'deploy' : 'revert',
project => $_->project,
change_id => $_->id,
change => $_->name,
note => $_->note,
deploy_file => $_->deploy_file,
tags => [ map { $_->format_name } $_->tags ],
requires => [ map { $_->as_string } $_->requires ],
conflicts => [ map { $_->as_string } $_->conflicts ],
planned_at => $_->timestamp,
planner_name => $_->planner_name,
planner_email => $_->planner_email,
} ) ] } $plan->changes
], 'Should have paged all changes';
# Make sure we catch bad format codes.
isa_ok $cmd = $CLASS->new(
sqitch => $sqitch,
format => '%Z',
), $CLASS, 'plan with bad format';
$plan = $cmd->default_target->plan;
$change = $plan->change_at(0);
push @changes, $change;
throws_ok { $cmd->execute } 'App::Sqitch::X',
'Should get an exception for a bad format code';
is $@->ident, 'format',
'bad format code format error ident should be "format"';
is $@->message, __x(
'Unknown format code "{code}"', code => 'Z',
), 'bad format code format error message should be correct';
# Gotta make sure params are parsed.
my $mock_cmd = Test::MockModule->new($CLASS);
my (@params, $orig_parse);
$mock_cmd->mock(parse_args => sub {
my $self = shift;
@params = @_;
$self->$orig_parse(@_);
});
$orig_parse = $mock_cmd->original('parse_args');
# Try specifying an unknown target.
ok $cmd = $CLASS->new( sqitch => $sqitch, target => 'foo'),
'Create plan command with unknown target option';
throws_ok { $cmd->execute } 'App::Sqitch::X',
'Should get error for unknown target';
is $@->ident, 'target', 'Unknown target error ident should be "plan"';
is $@->exitval, 2, 'Unknown target changes exit val should be 2';
is $@->message, __x('Cannot find target "{target}"', target => 'foo'),
'Unknown target error message should be correct';
is_deeply \@params, [ target => 'foo', args => [] ],
'Should have passed target for parsing';
# Try passing an engine target.
ok $cmd = $CLASS->new( sqitch => $sqitch),
'Create plan command with target option';
ok $cmd->execute('sqlite'), 'Execute with engine arg';
is_deeply \@params, [ target => undef, args => [qw(sqlite)] ],
'Should have passed engine for parsing';
# Try both --target and arg..
ok $cmd = $CLASS->new( sqitch => $sqitch, target => 'db:pg:'),
'Create plan command with target option';
ok $cmd->execute('sqlite'), 'Execute with multiple targets';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; using {target}',
target => 'db:pg:',
)]], 'Should have got warning for two targets';
checkout.t 100755 001751 000166 56532 15004170404 16171 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use utf8;
use Path::Class qw(dir file);
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::X qw(hurl);
use Test::MockModule;
use Test::Exception;
use Test::Warn;
use lib 't/lib';
use MockOutput;
use TestConfig;
my $CLASS = 'App::Sqitch::Command::checkout';
require_ok $CLASS or die;
isa_ok $CLASS, 'App::Sqitch::Command';
can_ok $CLASS, qw(
target
options
configure
log_only
lock_timeout
execute
deploy_variables
revert_variables
_collect_deploy_vars
_collect_revert_vars
does
);
ok $CLASS->does("App::Sqitch::Role::$_"), "$CLASS does $_"
for qw(RevertDeployCommand ConnectingCommand ContextCommand);
is_deeply [$CLASS->options], [qw(
plan-file|f=s
top-dir=s
registry=s
client|db-client=s
db-name|d=s
db-user|db-username|u=s
db-host|h=s
db-port|p=i
target|t=s
mode=s
verify!
set|s=s%
set-deploy|e=s%
set-revert|r=s%
log-only
lock-timeout=i
y
)], 'Options should be correct';
warning_is {
Getopt::Long::Configure(qw(bundling pass_through));
ok Getopt::Long::GetOptionsFromArray(
[], {}, App::Sqitch->_core_opts, $CLASS->options,
), 'Should parse options';
} undef, 'Options should not conflict with core options';
ok my $sqitch = App::Sqitch->new(
config => TestConfig->new(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
),
), 'Load a sqitch object';
my $config = $sqitch->config;
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 0,
mode => 'all',
_params => [],
_cx => [],
}, 'Check default configuration';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
}), {
verify => 0,
no_prompt => 0,
prompt_accept => 1,
mode => 'all',
deploy_variables => { foo => 'bar' },
revert_variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have set option';
is_deeply $CLASS->configure($config, {
y => 1,
set_deploy => { foo => 'bar' },
log_only => 1,
lock_timeout => 30,
verify => 1,
mode => 'tag',
}), {
mode => 'tag',
no_prompt => 1,
prompt_accept => 1,
deploy_variables => { foo => 'bar' },
verify => 1,
log_only => 1,
lock_timeout => 30,
_params => [],
_cx => [],
}, 'Should have mode, deploy_variables, verify, no_prompt, log_only, & lock_timeout';
is_deeply $CLASS->configure($config, {
y => 0,
set_revert => { foo => 'bar' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
revert_variables => { foo => 'bar' },
_params => [],
_cx => [],
}, 'Should have set_revert option and no_prompt false';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { foo => 'dep', hi => 'you' },
set_revert => { foo => 'rev', hi => 'me' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'dep', hi => 'you' },
revert_variables => { foo => 'rev', hi => 'me' },
_params => [],
_cx => [],
}, 'set_deploy and set_revert should overrid set';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { hi => 'you' },
set_revert => { hi => 'me' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'bar', hi => 'you' },
revert_variables => { foo => 'bar', hi => 'me' },
_params => [],
_cx => [],
}, 'set_deploy and set_revert should merge with set';
is_deeply $CLASS->configure($config, {
set => { foo => 'bar' },
set_deploy => { hi => 'you' },
set_revert => { my => 'yo' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'bar', hi => 'you' },
revert_variables => { foo => 'bar', my => 'yo' },
_params => [],
_cx => [],
}, 'set_revert should merge with set_deploy';
CONFIG: {
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 0,
mode => 'all',
_params => [],
_cx => [],
}, 'Should have deploy configuration';
# Try setting variables.
is_deeply $CLASS->configure($config, {
set => { foo => 'yo', yo => 'stellar' },
}), {
mode => 'all',
no_prompt => 0,
prompt_accept => 1,
verify => 0,
deploy_variables => { foo => 'yo', yo => 'stellar' },
revert_variables => { foo => 'yo', yo => 'stellar' },
_params => [],
_cx => [],
}, 'Should have merged variables';
# Make sure we can override mode, prompting, and verify.
$config->replace(
'core.engine' => 'sqlite',
'revert.no_prompt' => 1,
'revert.prompt_accept' => 0,
'deploy.verify' => 1,
'deploy.mode' => 'tag',
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 1,
prompt_accept => 0,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have no_prompt and prompt_accept from revert config';
# Checkout option takes precendence
$config->update(
'checkout.no_prompt' => 0,
'checkout.prompt_accept' => 1,
'checkout.verify' => 0,
'checkout.mode' => 'change',
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 0,
mode => 'change',
_params => [],
_cx => [],
}, 'Should have false log_only, verify, true prompt_accept from checkout config';
$config->update(
'checkout.no_prompt' => 1,
map { $_ => undef } qw(
revert.no_prompt
revert.prompt_accept
checkout.verify
checkout.mode
)
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 1,
prompt_accept => 1,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have log_only, prompt_accept true from checkout and verify from deploy';
# But option should override.
is_deeply $CLASS->configure($config, {y => 0, verify => 0, mode => 'all'}), {
no_prompt => 0,
verify => 0,
mode => 'all',
prompt_accept => 1,
_params => [],
_cx => [],
}, 'Should have log_only false and mode all again';
$config->update(
'checkout.no_prompt' => 0,
'checkout.prompt_accept' => 1,
);
is_deeply $CLASS->configure($config, {}), {
no_prompt => 0,
prompt_accept => 1,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have log_only false for false config';
is_deeply $CLASS->configure($config, {y => 1}), {
no_prompt => 1,
prompt_accept => 1,
verify => 1,
mode => 'tag',
_params => [],
_cx => [],
}, 'Should have no_prompt true with -y';
# Should die in strict mode.
for my $cfg (
['revert.strict', 1],
['checkout.strict', 1],
) {
throws_ok {
$CLASS->configure(TestConfig->new(@{$ cfg}))
} 'App::Sqitch::X', "$cfg->[0] should die";
is $@->ident, 'checkout', 'Strict err ident should be "checkout"';
is $@->message, __x(
'"{command}" cannot be used in strict mode.\n'.
'Use explicity revert and deploy commands instead.',
command => 'checkout',
), 'Should have corect strict error message'
}
lives_ok { $CLASS->configure(
TestConfig->new('revert.strict', 1, 'checkout.strict', 0)
) } 'App::Sqitch::X';
}
##############################################################################
# Test _collect_deploy_vars and _collect_revert_vars.
$config->replace(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
my $checkout = $CLASS->new( sqitch => $sqitch);
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $checkout->_collect_deploy_vars($target) }, {},
'Should collect no variables for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {},
'Should collect no variables for revert';
# Add core variables.
$config->update('core.variables' => { prefix => 'widget', priv => 'SELECT' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core deploy vars for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'SELECT',
}, 'Should collect core revert vars for revert';
# Add deploy variables.
$config->update('deploy.variables' => { dance => 'salsa', priv => 'UPDATE' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Should override core vars with deploy vars for revert';
# Add revert variables.
$config->update('revert.variables' => { dance => 'disco', lunch => 'pizza' });
$target = App::Sqitch::Target->new(sqitch => $sqitch);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'salsa',
}, 'Deploy vars should be unaffected by revert vars';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UPDATE',
dance => 'disco',
lunch => 'pizza',
}, 'Should override deploy vars with revert vars for revert';
# Add engine variables.
$config->update('engine.pg.variables' => { lunch => 'burrito', drink => 'whiskey', priv => 'UP' });
my $uri = URI::db->new('db:pg:');
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => $uri);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override deploy vars with engine vars for deploy';
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'whiskey',
}, 'Should override checkout vars with engine vars for revert';
# Add target variables.
$config->update('target.foo.variables' => { drink => 'scotch', status => 'winning' });
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with deploy vars for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'winning',
}, 'Should override engine vars with target vars for revert';
# Add --set variables.
my %opts = (
set => { status => 'tired', herb => 'oregano' },
);
$checkout = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set vars for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should override target vars with --set variables for revert';
# Add --set-deploy-vars
$opts{set_deploy} = { herb => 'basil', color => 'black' };
$checkout = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'basil',
color => 'black',
}, 'Should override --set vars with --set-deploy variables for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'oregano',
}, 'Should not override --set vars with --set-deploy variables for revert';
# Add --set-revert-vars
$opts{set_revert} = { herb => 'garlic', color => 'red' };
$checkout = $CLASS->new(
sqitch => $sqitch,
%{ $CLASS->configure($config, { %opts }) },
);
$target = App::Sqitch::Target->new(sqitch => $sqitch, name => 'foo', uri => $uri);
is_deeply { $checkout->_collect_deploy_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'salsa',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'basil',
color => 'black',
}, 'Should not override --set vars with --set-revert variables for deploy';
is_deeply { $checkout->_collect_revert_vars($target) }, {
prefix => 'widget',
priv => 'UP',
dance => 'disco',
lunch => 'burrito',
drink => 'scotch',
status => 'tired',
herb => 'garlic',
color => 'red',
}, 'Should override --set vars with --set-revert variables for revert';
$config->replace(
'core.engine' => 'sqlite',
'core.plan_file' => file(qw(t sql sqitch.plan))->stringify,
'core.top_dir' => dir(qw(t sql))->stringify,
);
##############################################################################
# Test execute().
my $mock_sqitch = Test::MockModule->new(ref $sqitch);
my (@probe_args, $probed, $orig_method);
$mock_sqitch->mock(probe => sub { shift; @probe_args = @_; $probed });
my $mock_cmd = Test::MockModule->new($CLASS);
$mock_cmd->mock(parse_args => sub {
my @ret = shift->$orig_method(@_);
$target = $ret[1][0];
@ret;
});
$orig_method = $mock_cmd->original('parse_args');
my @run_args;
$mock_sqitch->mock(run => sub { shift; @run_args = @_ });
# Try rebasing to the current branch.
isa_ok $checkout = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'checkout',
config => $config,
}), $CLASS, 'checkout command';
my $client = $checkout->client;
$probed = 'fixdupes';
throws_ok { $checkout->execute($probed) } 'App::Sqitch::X',
'Should get an error current branch';
is $@->ident, 'checkout', 'Current branch error ident should be "checkout"';
is $@->message, __x('Already on branch {branch}', branch => $probed),
'Should get proper error for current branch error';
is_deeply \@probe_args, [$client, qw(rev-parse --abbrev-ref HEAD)],
'The proper args should have been passed to rev-parse';
@probe_args = ();
# Try a plan with nothing in common with the current branch's plan.
my (@capture_args, $captured);
$mock_sqitch->mock(capture => sub { shift; @capture_args = @_; $captured });
$captured = q{%project=sql
foo 2012-07-16T17:25:07Z Barack Obama
bar 2012-07-16T17:25:07Z Barack Obama
};
throws_ok { $checkout->execute('main') } 'App::Sqitch::X',
'Should get an error for plans without a common change';
is $@->ident, 'checkout',
'The no common change error ident should be "checkout"';
is $@->message, __x(
'Branch {branch} has no changes in common with current branch {current}',
branch => 'main',
current => $probed,
), 'The no common change error message should be correct';
# Show usage when no branch name specified.
my @args;
$mock_cmd->mock(usage => sub { @args = @_; die 'USAGE' });
throws_ok { $checkout->execute } qr/USAGE/,
'No branch arg should yield usage';
is_deeply \@args, [$checkout], 'No args should be passed to usage';
@args = ();
throws_ok { $checkout->execute('') } qr/USAGE/,
'Empty branch arg should yield usage';
is_deeply \@args, [$checkout], 'No args should be passed to usage';
$mock_cmd->unmock('usage');
# Mock the engine interface.
my $mock_engine = Test::MockModule->new('App::Sqitch::Engine::sqlite');
my (@dep_args, @dep_changes);
$mock_engine->mock(deploy => sub {
@dep_changes = map { $_->name } shift->plan->changes;
@dep_args = @_;
});
my (@rev_args, @rev_changes);
$mock_engine->mock(revert => sub {
@rev_changes = map { $_->name } shift->plan->changes;
@rev_args = @_;
});
my @vars;
$mock_engine->mock(set_variables => sub { shift; push @vars => [@_] });
# Load up the plan file without decoding and change the plan.
$captured = file(qw(t sql sqitch.plan))->slurp;
{
no utf8;
$captured =~ s/widgets/thingíes/;
}
# Checkout with options.
isa_ok $checkout = $CLASS->new(
log_only => 1,
lock_timeout => 30,
verify => 1,
sqitch => $sqitch,
mode => 'tag',
deploy_variables => { foo => 'bar', one => 1 },
revert_variables => { hey => 'there' },
), $CLASS, 'Object with to and variables';
ok $checkout->execute('main'), 'Checkout main';
is_deeply \@probe_args, [$client, qw(rev-parse --abbrev-ref HEAD)],
'The proper args should again have been passed to rev-parse';
is_deeply \@capture_args, [$client, 'show', 'main:'
. File::Spec->catfile(File::Spec->curdir, $checkout->default_target->plan_file)
], 'Should have requested the plan file contents as of main';
is_deeply \@run_args, [$client, qw(checkout main)], 'Should have checked out other branch';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
is_deeply +MockOutput->get_info, [[__x(
'Last change before the branches diverged: {last_change}',
last_change => 'users @alpha',
)]], 'Should have emitted info identifying the last common change';
# Did it revert?
is_deeply \@rev_args, [$checkout->default_target->plan->get('users')->id, 1, undef],
'"users" ID and 1 should be passed to the engine revert';
is_deeply \@rev_changes, [qw(roles users widgets)],
'Should have had the current changes for revision';
# Did it deploy?
is_deeply \@dep_args, [undef, 'tag'],
'undef, "tag", and 1 should be passed to the engine deploy';
is_deeply \@dep_changes, [qw(roles users thingíes)],
'Should have had the other branch changes (decoded) for deploy';
ok $target->engine->with_verify, 'Engine should verify';
ok $target->engine->log_only, 'The engine should be set to log_only';
is $target->engine->lock_timeout, 30, 'The lock timeout should be set to 30';
is @vars, 2, 'Variables should have been passed to the engine twice';
is_deeply { @{ $vars[0] } }, { hey => 'there' },
'The revert vars should have been passed first';
is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 },
'The deploy vars should have been next';
# Try passing a target.
@vars = ();
ok $checkout->execute('main', 'db:sqlite:foo'), 'Checkout main with target';
is $target->name, 'db:sqlite:foo', 'Target should be passed to engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# If nothing is deployed, or we are already at the revert target, the revert
# should be skipped.
isa_ok $checkout = $CLASS->new(
target => 'db:sqlite:hello',
log_only => 0,
verify => 0,
sqitch => $sqitch,
mode => 'tag',
deploy_variables => { foo => 'bar', one => 1 },
revert_variables => { hey => 'there' },
), $CLASS, 'Object with to and variables';
$mock_engine->mock(revert => sub { hurl { ident => 'revert', message => 'foo', exitval => 1 } });
@dep_args = @rev_args = @vars = ();
ok $checkout->execute('main'), 'Checkout main again';
is $target->name, 'db:sqlite:hello', 'Target should be passed to engine';
is_deeply +MockOutput->get_warn, [], 'Should have no warnings';
# Did it deploy?
ok !$target->engine->log_only, 'The engine should not be set to log_only';
is $target->engine->lock_timeout, App::Sqitch::Engine::default_lock_timeout(),
'The lock timeout should be set to the default';
ok !$target->engine->with_verify, 'The engine should not be set with_verfy';
is_deeply \@dep_args, [undef, 'tag'],
'undef, "tag", and 1 should be passed to the engine deploy again';
is_deeply \@dep_changes, [qw(roles users thingíes)],
'Should have had the other branch changes (decoded) for deploy again';
is @vars, 2, 'Variables should again have been passed to the engine twice';
is_deeply { @{ $vars[0] } }, { hey => 'there' },
'The revert vars should again have been passed first';
is_deeply { @{ $vars[1] } }, { foo => 'bar', one => 1 },
'The deploy vars should again have been next';
# Should get a warning for two targets.
ok $checkout->execute('main', 'db:sqlite:'), 'Checkout main again with target';
is $target->name, 'db:sqlite:hello', 'Target should be passed to engine';
is_deeply +MockOutput->get_warn, [[__x(
'Too many targets specified; connecting to {target}',
target => 'db:sqlite:hello',
)]], 'Should have warning about two targets';
# Make sure we get an exception for unknown args.
throws_ok { $checkout->execute(qw(main greg)) } 'App::Sqitch::X',
'Should get an exception for unknown arg';
is $@->ident, 'checkout', 'Unknown arg ident should be "checkout"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
1,
arg => 'greg',
), 'Should get an exception for two unknown arg';
throws_ok { $checkout->execute(qw(main greg widgets)) } 'App::Sqitch::X',
'Should get an exception for unknown args';
is $@->ident, 'checkout', 'Unknown args ident should be "checkout"';
is $@->message, __nx(
'Unknown argument "{arg}"',
'Unknown arguments: {arg}',
2,
arg => 'greg, widgets',
), 'Should get an exception for two unknown args';
# Should die for fatal, unknown, or confirmation errors.
for my $spec (
[ confirm => App::Sqitch::X->new(ident => 'revert:confirm', message => 'foo', exitval => 1) ],
[ fatal => App::Sqitch::X->new(ident => 'revert', message => 'foo', exitval => 2) ],
[ unknown => bless { } => __PACKAGE__ ],
) {
$mock_engine->mock(revert => sub { die $spec->[1] });
throws_ok { $checkout->execute('main') } ref $spec->[1],
"Should rethrow $spec->[0] exception";
}
done_testing;
local.conf 100644 001751 000166 340 15004170404 16057 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
engine = pg
[engine "pg"]
target = mydb
[engine "sqlite"]
target = devdb
[target "devdb"]
uri = db:sqlite:
[target "mydb"]
uri = db:pg:mydb
plan_file = t/plans/dependencies.plan
linelist.t 100644 001751 000166 5613 15004170404 16156 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 28;
#use Test::More 'no_plan';
use Test::NoWarnings;
use Test::Exception;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use lib 't/lib';
use TestConfig;
BEGIN { require_ok 'App::Sqitch::Plan::LineList' or die }
my $sqitch = App::Sqitch->new(config => TestConfig->new('core.engine' => 'sqlite'));
my $target = App::Sqitch::Target->new(sqitch => $sqitch);
my $plan = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
my $foo = App::Sqitch::Plan::Change->new(plan => $plan, name => 'foo');
my $bar = App::Sqitch::Plan::Change->new(plan => $plan, name => 'bar');
my $baz = App::Sqitch::Plan::Change->new(plan => $plan, name => 'baz');
my $yo1 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo');
my $yo2 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo');
my $blank = App::Sqitch::Plan::Blank->new(plan => $plan);
my $alpha = App::Sqitch::Plan::Tag->new(
plan => $plan,
change => $yo1,
name => 'alpha',
);
my $lines = App::Sqitch::Plan::LineList->new(
$foo,
$bar,
$yo1,
$alpha,
$blank,
$baz,
$yo2,
);
is $lines->count, 7, 'Count should be six';
is_deeply [$lines->items], [$foo, $bar, $yo1, $alpha, $blank, $baz, $yo2],
'Lines should be in order';
is $lines->item_at(0), $foo, 'Should have foo at 0';
is $lines->item_at(1), $bar, 'Should have bar at 1';
is $lines->item_at(2), $yo1, 'Should have yo1 at 2';
is $lines->item_at(3), $alpha, 'Should have @alpha at 3';
is $lines->item_at(4), $blank, 'Should have blank at 4';
is $lines->item_at(5), $baz, 'Should have baz at 5';
is $lines->item_at(6), $yo2, 'Should have yo2 at 6';
is $lines->index_of('non'), undef, 'Should not find "non"';
is $lines->index_of($foo), 0, 'Should find foo at 0';
is $lines->index_of($bar), 1, 'Should find bar at 1';
is $lines->index_of($yo1), 2, 'Should find yo1 at 2';
is $lines->index_of($alpha), 3, 'Should find @alpha at 3';
is $lines->index_of($blank), 4, 'Should find blank at 4';
is $lines->index_of($baz), 5, 'Should find baz at 5';
is $lines->index_of($yo2), 6, 'Should find yo2 at 6';
my $hi = App::Sqitch::Plan::Change->new(plan => $plan, name => 'hi');
ok $lines->append($hi), 'Append hi';
is $lines->count, 8, 'Count should now be eight';
is_deeply [$lines->items], [$foo, $bar, $yo1, $alpha, $blank, $baz, $yo2, $hi],
'Lines should be in order with $hi at the end';
# Try inserting.
my $oy = App::Sqitch::Plan::Change->new(plan => $plan, name => 'oy');
ok $lines->insert_at($oy, 3), 'Insert a change at index 3';
is $lines->count, 9, 'Count should now be nine';
is_deeply [$lines->items], [$foo, $bar, $yo1, $oy, $alpha, $blank, $baz, $yo2, $hi],
'Lines should be in order with $oy at index 3';
is $lines->index_of($oy), 3, 'Should find oy at 3';
is $lines->index_of($alpha), 4, 'Should find @alpha at 4';
is $lines->index_of($hi), 8, 'Should find hi at 8';
firebird.t 100644 001751 000166 46033 15004170404 16142 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
#
# To test against a live Firebird database, you must set the
# SQITCH_TEST_FIREBIRD_URI environment variable. this is a standard URI::db URI,
# and should look something like this:
#
# export SQITCH_TEST_FIREBIRD_URI=db:firebird://sysdba:password@localhost//path/to/test.db
#
#
use strict;
use warnings;
use 5.010;
use Test::More;
use App::Sqitch;
use App::Sqitch::Target;
use Test::MockModule;
use Path::Class;
use Try::Tiny;
use Test::Exception;
use Locale::TextDomain qw(App-Sqitch);
use File::Basename qw(dirname);
use File::Spec::Functions;
use File::Temp 'tempdir';
use DBD::Mem;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
my $uri;
my $tmpdir;
my $have_fb_driver = 1; # assume DBD::Firebird is installed and so is Firebird
# Is DBD::Firebird really installed?
try { require DBD::Firebird; } catch { $have_fb_driver = 0; };
BEGIN {
$CLASS = 'App::Sqitch::Engine::firebird';
require_ok $CLASS or die;
$uri = URI->new($ENV{SQITCH_TEST_FIREBIRD_URI} || $ENV{FIREBIRD_URI} || do {
my $user = $ENV{ISC_USER} || $ENV{DBI_USER} || 'SYSDBA';
my $pass = $ENV{ISC_PASSWORD} || $ENV{DBI_PASS} || 'masterkey';
"db:firebird://$user:$pass@/"
});
delete $ENV{$_} for qw(ISC_USER ISC_PASSWORD);
$tmpdir = File::Spec->tmpdir();
}
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $config = TestConfig->new('core.engine' => 'firebird');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new('db:firebird:foo.fdb'),
);
isa_ok my $fb = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $fb->key, 'firebird', 'Key should be "firebird"';
is $fb->name, 'Firebird', 'Name should be "Firebird"';
is $fb->username, $ENV{ISC_USER}, 'Should have username from environment';
is $fb->password, $ENV{ISC_PASSWORD}, 'Should have password from environment';
is $fb->_limit_default, '18446744073709551615', 'Should have _limit_default';
is $fb->_dsn, 'dbi:Firebird:dbname=sqitch.fdb;ib_dialect=3;ib_charset=UTF8',
'Should append "ib_dialect=3;ib_charset=UTF8" to the DSN';
my $have_fb_client;
if ($have_fb_driver && (my $client = try { $fb->client })) {
$have_fb_client = 1;
like $client, qr/isql|fbsql|isql-fb/,
'client should default to isql | fbsql | isql-fb';
}
is $fb->uri->dbname, file('foo.fdb'), 'dbname should be filled in';
is $fb->registry_uri->dbname, 'sqitch.fdb',
'registry dbname should be "sqitch.fdb"';
is $fb->registry_destination, $fb->registry_uri->as_string,
'registry_destination should be the same as registry URI';
my @std_opts = (
'-quiet',
'-bail',
'-sqldialect' => '3',
'-pagelength' => '16384',
'-charset' => 'UTF8',
);
my $dbname = $fb->connection_string($fb->uri);
is_deeply([$fb->isql], [$fb->client, @std_opts, $dbname],
'isql command should be std opts-only') if $have_fb_client;
isa_ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
ok $fb->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'),
'Set some variables';
is_deeply([$fb->isql], [$fb->client, @std_opts, $dbname],
'isql command should be std opts-only') if $have_fb_client;
##############################################################################
# Make sure environment variables are read.
ENV: {
local $ENV{ISC_USER} = '__kamala__';
local $ENV{ISC_PASSWORD} = 'answer the question';
ok my $fb = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a firebird with environment variables set';
is $fb->username, $ENV{ISC_USER}, 'Should have username from environment';
is $fb->password, $ENV{ISC_PASSWORD}, 'Should have password from environment';
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.firebird.client' => '/path/to/isql',
'engine.firebird.target' => 'db:firebird://freddy:s3cr3t@db.example.com:1234/widgets',
'engine.firebird.registry' => 'meta',
);
$target = App::Sqitch::Target->new(sqitch => $sqitch);
ok $fb = $CLASS->new(sqitch => $sqitch, target => $target), 'Create another firebird';
is $fb->client, '/path/to/isql', 'client should be as configured';
is $fb->uri, URI::db->new('db:firebird://freddy:s3cr3t@db.example.com:1234/widgets'),
'URI should be as configured';
like $fb->destination, qr{db:firebird://freddy:?\@db.example.com:1234/widgets},
'destination should default to URI without password';
like $fb->registry_destination, qr{db:firebird://freddy:?\@db.example.com:1234/meta},
'registry_destination should be URI with configured registry and no password';
is_deeply [$fb->isql], [(
'/path/to/isql',
'-user', 'freddy',
'-password', 's3cr3t',
), @std_opts, 'db.example.com/1234:widgets'], 'firebird command should be configured';
##############################################################################
# Test connection_string.
can_ok $fb, 'connection_string';
for my $file (qw(
foo.fdb
/blah/hi.fdb
C:/blah/hi.fdb
)) {
# DB name only.
is $fb->connection_string( URI::db->new("db:firebird:$file") ),
$file, "Connection for db:firebird:$file";
# DB name and host.
is $fb->connection_string( URI::db->new("db:firebird:foo.com/$file") ),
"foo.com/$file", "Connection for db:firebird:foo.com/$file";
# DB name, host, and port
is $fb->connection_string( URI::db->new("db:firebird:foo.com:1234/$file") ),
"foo.com:1234/$file", "Connection for db:firebird:foo.com/$file:1234";
}
throws_ok { $fb->connection_string( URI::db->new('db:firebird:') ) }
'App::Sqitch::X', 'Should get an exception for no db name';
is $@->ident, 'firebird', 'No dbname exception ident should be "firebird"';
is $@->message, __x(
'Database name missing in URI {uri}',
uri => 'db:firebird:',
), 'No dbname exception message should be correct';
##############################################################################
# Test _run(), _capture(), and _spool().
can_ok $fb, qw(_run _capture _spool);
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my (@run, $exp_pass);
$mock_sqitch->mock(run => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@run = @_;
if (defined $exp_pass) {
is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist';
}
});
my @capture;
$mock_sqitch->mock(capture => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@capture = @_;
if (defined $exp_pass) {
is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist';
}
});
my @spool;
$mock_sqitch->mock(spool => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@spool = @_;
if (defined $exp_pass) {
is $ENV{ISC_PASSWORD}, $exp_pass, qq{ISC_PASSWORD should be "$exp_pass"};
} else {
ok !exists $ENV{ISC_PASSWORD}, 'ISC_PASSWORD should not exist';
}
});
$exp_pass = 's3cr3t';
$target->uri->password($exp_pass);
ok $fb->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@run, [$fb->isql, qw(foo bar baz)],
'Command should be passed to run()';
ok $fb->_spool('FH'), 'Call _spool';
is_deeply \@spool, ['FH', $fb->isql],
'Command should be passed to spool()';
ok $fb->_capture(qw(foo bar baz)), 'Call _capture';
is_deeply \@capture, [$fb->isql, qw(foo bar baz)],
'Command should be passed to capture()';
# Without password.
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $fb = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a firebird with sqitch with no pw';
$exp_pass = undef;
$target->uri->password($exp_pass);
ok $fb->_run(qw(foo bar baz)), 'Call _run again';
is_deeply \@run, [$fb->isql, qw(foo bar baz)],
'Command should be passed to run() again';
ok $fb->_spool('FH'), 'Call _spool again';
is_deeply \@spool, ['FH', $fb->isql],
'Command should be passed to spool() again';
ok $fb->_capture(qw(foo bar baz)), 'Call _capture again';
is_deeply \@capture, [$fb->isql, qw(foo bar baz)],
'Command should be passed to capture() again';
##############################################################################
# Test file and handle running.
ok $fb->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@run, [$fb->isql, '-input', 'foo/bar.sql'],
'File should be passed to run()';
ok $fb->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, ['FH', $fb->isql],
'Handle should be passed to spool()';
# Verify should go to capture unless verosity is > 1.
ok $fb->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
is_deeply \@capture, [$fb->isql, '-input', 'foo/bar.sql'],
'Verify file should be passed to capture()';
$mock_sqitch->mock(verbosity => 2);
ok $fb->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@run, [$fb->isql, '-input', 'foo/bar.sql'],
'Verify file should be passed to run() for high verbosity';
$mock_sqitch->unmock_all;
##############################################################################
# Test DateTime formatting stuff.
can_ok $CLASS, '_ts2char_format';
is sprintf($CLASS->_ts2char_format, 'foo'),
q{'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_format should work'; # WORKS! :)
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';
##############################################################################
# Test error checking functions.
DBI: {
local *DBI::errstr;
ok !$fb->_no_table_error, 'Should have no table error';
ok !$fb->_no_column_error, 'Should have no column error';
$DBI::errstr = '-Table unknown';
ok $fb->_no_table_error, 'Should now have table error';
ok !$fb->_no_column_error, 'Still should have no column error';
$DBI::errstr = 'No such file or directory';
ok $fb->_no_table_error, 'Should again have table error';
ok !$fb->_no_column_error, 'Still should have no column error';
$DBI::errstr = '-Column unknown';
ok !$fb->_no_table_error, 'Should again have no table error';
ok $fb->_no_column_error, 'Should now have no column error';
}
##############################################################################
# Test database creation failure.
DBFAIL: {
my $mock = Test::MockModule->new($CLASS);
$mock->mock(initialized => 0);
$mock->mock(use_driver => 1);
my $fbmock = Test::MockModule->new('DBD::Firebird', no_auto => 1);
$fbmock->mock(create_database => sub { die 'Creation failed' });
throws_ok { $fb->initialize } 'App::Sqitch::X',
'Should get an error from initialize';
is $@->ident, 'firebird', 'No creattion exception ident should be "firebird"';
my $msg = __x(
'Cannot create database {database}: {error}',
database => $fb->connection_string($fb->registry_uri),
error => 'Creation failed',
);
like $@->message, qr{^\Q$msg\E}, 'Creation exception message should be correct';
}
##############################################################################
# Test various database connection and error-handling logic.
DBH: {
# Need to mock DBH.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
my $mock_engine = Test::MockModule->new($CLASS);
$mock_engine->mock(dbh => $dbh);
$mock_engine->mock(registry_uri => URI->new('db:firebird:foo.fdb'));
my $mock_dbd = Test::MockModule->new(ref $dbh, no_auto => 1);
my ($disconnect, $clear);
$mock_dbd->mock(disconnect => sub { $disconnect = 1 });
$mock_engine->mock(_clear_dbh => sub { $clear = 1 });
my $run;
$mock_sqitch->mock(run => sub { $run = 1 });
# Test that upgrading disconnects from a local database before upgrading.
ok $fb->run_upgrade('somefile'), 'Run the upgrade';
ok $disconnect, 'Should have disconnected';
ok $clear, 'Should have cleared the database handle';
ok $run, 'Should have run a command';
$mock_sqitch->unmock('run');
# Test that _cid propagates an unexpected error from DBI.
local *DBI::err;
$DBI::err = 0;
$mock_engine->mock(dbh => sub { die 'Oops' });
throws_ok { $fb->_cid('ASC', 0, 'foo') } qr/^Oops/,
'_cid should propagate unexpected error';
# But it should just return for error code -902.
$DBI::err = -902;
lives_ok { $fb->_cid('ASC', 0, 'foo') }
'_cid should just return on error code -902';
# Test that current_state returns on no table error.
local *DBI::errstr;
$DBI::errstr = '-Table unknown';
$mock_engine->mock(initialized => 0);
lives_ok { $fb->current_state('foo') }
'current_state should return on no table error';
# But it should die if it's not a table error.
$DBI::errstr = 'Some other error';
throws_ok { $fb->current_state('foo') } qr/^Oops/,
'current_state should propagate unexpected error';
# Make sure change_id_for returns undef when no useful params.
$mock_engine->mock(dbh => $dbh);
is $fb->change_id_for(project => 'foo'), undef,
'Should get undef from change_id_for when no useful params';
}
# Make sure default_client croaks when it finds no client.
FSPEC: {
# Give it an invalid fbsql file to find.
my $tmpdir = tempdir(CLEANUP => 1);
my $tmp = Path::Class::Dir->new("$tmpdir");
my $iswin = App::Sqitch::ISWIN || $^O eq 'cygwin';
my $fbsql = $tmp->file('fbsql' . ($iswin ? '.exe' : ''));
$fbsql->touch;
chmod 0755, $fbsql unless $iswin;
my $fs_mock = Test::MockModule->new('File::Spec');
$fs_mock->mock(path => sub { $tmp });
throws_ok { $fb->default_client } 'App::Sqitch::X',
'Should get error when no client found';
is $@->ident, 'firebird', 'Client exception ident should be "firebird"';
is $@->message, __(
'Unable to locate Firebird ISQL; set "engine.firebird.client" via sqitch config'
), 'Client exception message should be correct';
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($fb->key);
##############################################################################
# Can we do live tests?
my ($data_dir, $fb_version, @cleanup) = ($tmpdir);
my $id = DBIEngineTest->randstr;
my ($reg1, $reg2) = map { $_ . $id } qw(__sqitchreg_ __metasqitch_);
my $err = try {
return unless $have_fb_driver;
if ($uri->dbname) {
$data_dir = dirname $uri->dbname; # Assumes local OS semantics.
} else {
# Assume we're running locally and create the database.
my $dbpath = catfile($tmpdir, "__sqitchtest__$id");
$data_dir = $tmpdir;
$uri->dbname($dbpath);
DBD::Firebird->create_database({
db_path => $dbpath,
user => $uri->user,
password => $uri->password,
character_set => 'UTF8',
page_size => 16384,
});
# We created this database, we need to clean it up.
@cleanup = ($dbpath);
}
# Try to connect.
my $dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $fb->error_handler,
});
$fb_version = $dbh->selectcol_arrayref(q{
SELECT rdb$get_context('SYSTEM', 'ENGINE_VERSION')
FROM rdb$database
})->[0];
# We will need to clean up the registry DBs we create.
push @cleanup => map { catfile $data_dir, $_ } $reg1, $reg2;
return undef;
} catch {
return $_ if blessed $_ && $_->isa('App::Sqitch::X');
return App::Sqitch::X->new(
message => 'Failed to connect to Firebird',
previous_exception => $_,
),
};
END {
return if $ENV{CI}; # No need to clean up in CI environment.
foreach my $dbname (@cleanup) {
next unless -e $dbname;
$uri->dbname($dbname);
my $dsn = $uri->dbi_dsn . q{;ib_dialect=3;ib_charset=UTF8};
my $dbh = DBI->connect($dsn, $uri->user, $uri->password, {
FetchHashKeyName => 'NAME_lc',
AutoCommit => 1,
RaiseError => 0,
PrintError => 0,
}) or die $DBI::errstr;
# Disconnect any other database handles.
$dbh->{Driver}->visit_child_handles(sub {
my $h = shift;
$h->disconnect if $h->{Type} eq 'db' && $h->{Active} && $h ne $dbh;
});
# Kill all other connections.
$dbh->do('DELETE FROM MON$ATTACHMENTS WHERE MON$ATTACHMENT_ID <> CURRENT_CONNECTION');
$dbh->func('ib_drop_database') or diag "Cannot drop '$dbname': $DBI::errstr";
}
}
DBIEngineTest->run(
class => $CLASS,
target_params => [ uri => $uri, registry => catfile($data_dir, $reg1) ],
alt_target_params => [ uri => $uri, registry => catfile($data_dir, $reg2) ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have the right isql and can connect to the
# database. Adapted from the FirebirdMaker.pm module of
# DBD::Firebird.
my $cmd = $self->client;
my $cmd_echo = qx(echo "quit;" | "$cmd" -z -quiet 2>&1 );
App::Sqitch::X::hurl('isql not for Firebird')
unless $cmd_echo =~ m{Firebird}ims;
chomp $cmd_echo;
say "# Detected $cmd_echo";
# Skip if no DBD::Firebird.
App::Sqitch::X::hurl('DBD::Firebird did not load')
unless $have_fb_driver;
say "# Connected to Firebird $fb_version" if $fb_version;
return 1;
},
engine_err_regex => qr/\QDynamic SQL Error\E/xms,
init_error => __x(
'Sqitch database {database} already initialized',
database => catfile($data_dir, $reg2),
),
add_second_format => q{dateadd(1 second to %s)},
test_dbh => sub {
my $dbh = shift;
# Check the session configuration...
# To try: https://www.firebirdsql.org/refdocs/langrefupd21-intfunc-get_context.html
is(
$dbh->selectcol_arrayref(q{
SELECT rdb$get_context('SYSTEM', 'DB_NAME')
FROM rdb$database
})->[0],
catfile($data_dir, $reg2),
'The Sqitch db should be the current db'
);
},
);
done_testing;
datetime.t 100644 001751 000166 5377 15004170404 16136 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 33;
#use Test::More 'no_plan';
use Locale::TextDomain qw(App-Sqitch);
use Test::NoWarnings;
use Test::Exception;
use Encode;
use lib 't/lib';
use LC;
use TestConfig;
my $CLASS = 'App::Sqitch::DateTime';
require_ok $CLASS;
local $ENV{TZ} = 'America/Vancouver';
ok my $dt = $CLASS->now, 'Construct a datetime object';
is_deeply [$dt->as_string_formats], [qw(
raw
iso
iso8601
rfc
rfc2822
full
long
medium
short
)], 'as_string_formats should be correct';
my $rfc = do {
my $clone = $dt->clone;
$clone->set_time_zone('local');
$clone->set_locale('en_US');
( my $rv = $clone->strftime('%a, %d %b %Y %H:%M:%S %z') ) =~ s/\+0000$/-0000/;
$rv;
};
my $iso = do {
my $clone = $dt->clone;
$clone->set_time_zone('local');
join ' ', $clone->ymd('-'), $clone->hms(':'), $clone->strftime('%z')
};
my $ldt = do {
my $clone = $dt->clone;
$clone->set_time_zone('local');
$clone->set_locale($LC::TIME);
$clone;
};
my $raw = do {
my $clone = $dt->clone;
$clone->set_time_zone('UTC');
$clone->iso8601 . 'Z';
};
for my $spec (
[ full => $ldt->format_cldr( $ldt->locale->datetime_format_full )],
[ long => $ldt->format_cldr( $ldt->locale->datetime_format_long )],
[ medium => $ldt->format_cldr( $ldt->locale->datetime_format_medium )],
[ short => $ldt->format_cldr( $ldt->locale->datetime_format_short )],
[ raw => $raw ],
[ '' => $raw ],
[ iso => $iso ],
[ iso8601 => $iso ],
[ rfc => $rfc ],
[ rfc2822 => $rfc ],
[ q{cldr:HH'h' mm'm'} => $ldt->format_cldr( q{HH'h' mm'm'} ) ],
[ 'strftime:%a at %H:%M:%S' => $ldt->strftime('%a at %H:%M:%S') ],
) {
my $clone = $dt->clone;
$clone->set_time_zone('UTC');
is $dt->as_string( format => $spec->[0] ), $spec->[1],
sprintf 'Date format "%s" should yield "%s"', $spec->[0], encode_utf8 $spec->[1];
ok $dt->validate_as_string_format($spec->[0]),
qq{Format "$spec->[0]" should be valid} if $spec->[0];
}
throws_ok { $dt->validate_as_string_format('nonesuch') } 'App::Sqitch::X',
'Should get error for invalid date format';
is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'nonesuch',
), 'Invalid date format error message should be correct';
throws_ok { $dt->as_string( format => 'nonesuch' ) } 'App::Sqitch::X',
'Should get error for invalid as_string format param';
is $@->ident, 'datetime', 'Invalid date format error ident should be "datetime"';
is $@->message, __x(
'Unknown date format "{format}"',
format => 'nonesuch',
), 'Invalid date format error message should be correct';
snowflake.t 100644 001751 000166 57330 15004170404 16347 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# To test against a live Snowflake database, you must set the
# SQITCH_TEST_SNOWFLAKE_URI environment variable. this is a standard URI::db
# URI, and should look something like this:
#
# export SQITCH_TEST_SNOWFLAKE_URI=db:snowflake://username:password@accountname/dbname?Driver=Snowflake;warehouse=warehouse
#
# Note that it must include the `?Driver=$driver` bit so that DBD::ODBC loads
# the proper driver.
use strict;
use warnings;
use 5.010;
use Test::More 0.94;
use Test::MockModule;
use Test::Exception;
use Test::File::Contents qw(file_contents_unlike);
use DBD::Mem;
use Locale::TextDomain qw(App-Sqitch);
use Capture::Tiny 0.12 qw(:all);
use File::Temp 'tempdir';
use Path::Class;
use Try::Tiny;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use App::Sqitch::DateTime;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
delete $ENV{"SNOWSQL_$_"} for qw(USER PASSWORD DATABASE HOST);
BEGIN {
$CLASS = 'App::Sqitch::Engine::snowflake';
require_ok $CLASS or die;
$ENV{SNOWSQL_ACCOUNT} = 'nonesuch';
}
# Mock the home directory to prevent reading a user config file.
my $tmp_dir = dir tempdir CLEANUP => 1;
local $ENV{HOME} = $tmp_dir->stringify;
local $ENV{TZ} = 'America/St_Johns';
is_deeply [$CLASS->config_vars], [
target => 'any',
registry => 'any',
client => 'any',
], 'config_vars should return three vars';
my $uri = 'db:snowflake:';
my $config = TestConfig->new('core.engine' => 'snowflake');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new($uri),
);
# Disable config file parsing for the remainder of the tests.
my $mock_snow = Test::MockModule->new($CLASS);
$mock_snow->mock(_snowcfg => {});
isa_ok my $snow = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
is $snow->username, $sqitch->sysuser, 'Username should be sysuser';
is $snow->password, undef, 'Password should be undef';
is $snow->key, 'snowflake', 'Key should be "snowflake"';
is $snow->name, 'Snowflake', 'Name should be "Snowflake"';
is $snow->driver, 'DBD::ODBC 1.59', 'Driver should be DBD::ODBC';
is $snow->default_client, 'snowsql', 'Default client should be snowsql';
my $client = 'snowsql' . (App::Sqitch::ISWIN ? '.exe' : '');
is $snow->client, $client, 'client should default to snowsql';
is $snow->registry, 'sqitch', 'Registry default should be "sqitch"';
my $exp_uri = URI->new(
sprintf 'db:snowflake://%s.snowflakecomputing.com/%s',
$ENV{SNOWSQL_ACCOUNT}, $sqitch->sysuser,
)->as_string;
is $snow->uri, $exp_uri, 'DB URI should be filled in';
is $snow->destination, $exp_uri, 'Destination should be URI string';
is $snow->registry_destination, $snow->destination,
'Registry destination should be the same as destination';
# Test destination URI redaction.
PASSWORDS: {
my $sensitive_uri = "db:snowflake://julie:s3cr3t@/?pwd=xyz;key_pwd=abc;pod=x";
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI::db->new($sensitive_uri),
);
isa_ok my $sensitive_snow = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
# Test URI.
my $exp = URI::db->new($sensitive_uri);
$exp->host("$ENV{SNOWSQL_ACCOUNT}.snowflakecomputing.com");
$exp->dbname('julie');
is $sensitive_snow->uri, $exp, 'Should have sensitive info in URI';
# Test redacted destination URI.
$exp->query('pwd=REDACTED;key_pwd=REDACTED;pod=x');
$exp->password(undef);
is $sensitive_snow->destination, $exp, 'Should have sensitive info in URI';
}
# Test environment variables.
SNOWENV: {
local $ENV{SNOWSQL_USER} = 'kamala';
local $ENV{SNOWSQL_PWD} = 'gimme';
local $ENV{SNOWSQL_REGION} = 'Australia';
local $ENV{SNOWSQL_WAREHOUSE} = 'madrigal';
local $ENV{SNOWSQL_ACCOUNT} = 'egregious';
local $ENV{SNOWSQL_HOST} = 'test.us-east-2.aws.snowflakecomputing.com';
local $ENV{SNOWSQL_DATABASE} = 'tryme';
my $target = App::Sqitch::Target->new(sqitch => $sqitch, uri => URI->new($uri));
my $snow = $CLASS->new( sqitch => $sqitch, target => $target );
is $snow->uri, 'db:snowflake://test.us-east-2.aws.snowflakecomputing.com/tryme',
'Should build URI from environment';
is $snow->username, 'kamala', 'Should read username from environment';
is $snow->password, 'gimme', 'Should read password from environment';
is $snow->account, 'test.us-east-2.aws', 'Should read account from host';
is $snow->warehouse, 'madrigal', 'Should read warehouse from environment';
# Delete host.
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => URI->new($uri));
delete $ENV{SNOWSQL_HOST};
$snow = $CLASS->new( sqitch => $sqitch, target => $target );
is $snow->uri,
'db:snowflake://egregious.Australia.snowflakecomputing.com/tryme',
'Should build URI host from account and region environment vars';
is $snow->account, 'egregious.Australia',
'Should read account and region from environment';
# SQITCH_PASSWORD has priority.
local $ENV{SQITCH_PASSWORD} = 'irule';
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => URI->new($uri));
is $target->password, 'irule', 'Target password should be from SQITCH_PASSWORD';
$snow = $CLASS->new( sqitch => $sqitch, target => $target );
is $snow->password, 'irule', 'Should prefer password from SQITCH_PASSWORD';
}
# Name the target.
my $named_target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => URI->new($uri),
name => 'jonsnow',
);
isa_ok $snow = $CLASS->new(
sqitch => $sqitch,
target => $named_target,
), $CLASS;
is $snow->destination, 'jonsnow', 'Destination should be target name';
is $snow->registry_destination, $snow->destination,
'Registry destination should be the same as destination';
##############################################################################
# Test snowsql options.
my @con_opts = (
'--accountname' => $ENV{SNOWSQL_ACCOUNT},
'--username' => $snow->username,
'--dbname' => $snow->uri->dbname,
);
my @std_opts = (
'--noup',
'--option' => 'auto_completion=false',
'--option' => 'echo=false',
'--option' => 'execution_only=false',
'--option' => 'friendly=false',
'--option' => 'header=false',
'--option' => 'exit_on_error=true',
'--option' => 'stop_on_error=true',
'--option' => 'output_format=csv',
'--option' => 'paging=false',
'--option' => 'timing=false',
'--option' => 'results=true',
'--option' => 'wrap=false',
'--option' => 'rowset_size=1000',
'--option' => 'syntax_style=default',
'--option' => 'variable_substitution=true',
'--variable' => 'registry=sqitch',
'--variable' => 'warehouse=' . $snow->warehouse,
);
is_deeply [$snow->snowsql], [$client, @con_opts, @std_opts],
'snowsql command should be std opts-only';
isa_ok $snow = $CLASS->new(
sqitch => $sqitch,
target => $target,
), $CLASS;
ok $snow->set_variables(foo => 'baz', whu => 'hi there', yo => 'stellar'),
'Set some variables';
is_deeply [$snow->snowsql], [
$client,
@con_opts,
'--variable' => 'foo=baz',
'--variable' => 'whu=hi there',
'--variable' => 'yo=stellar',
@std_opts,
], 'Variables should be passed to snowsql via --set';
##############################################################################
# Test other configs for the target.
ENV: {
# Make sure we override system-set vars.
local $ENV{SNOWSQL_DATABASE};
local $ENV{SNOWSQL_USER};
for my $env (qw(SNOWSQL_DATABASE SNOWSQL_USER)) {
my $snow = $CLASS->new(sqitch => $sqitch, target => $target);
local $ENV{$env} = "\$ENV=whatever";
is $snow->target->name, "db:snowflake:", "Target name should not read \$$env";
is $snow->registry_destination, $snow->destination,
'Registry target should be the same as destination';
}
my $mocker = Test::MockModule->new('App::Sqitch');
$mocker->mock(sysuser => 'sysuser=whatever');
my $snow = $CLASS->new(sqitch => $sqitch, target => $target);
is $snow->target->name, 'db:snowflake:',
'Target name should not fall back on sysuser';
is $snow->registry_destination, $snow->destination,
'Registry target should be the same as destination';
$ENV{SNOWSQL_DATABASE} = 'mydb';
$snow = $CLASS->new(sqitch => $sqitch, username => 'hi', target => $target);
is $snow->target->name, 'db:snowflake:', 'Target name should be the default';
is $snow->registry_destination, $snow->destination,
'Registry target should be the same as destination';
}
##############################################################################
# Make sure we read snowsql config file.
SNOWSQLCFGFILE: {
# Create the mock config directory.
my $cfgdir = $tmp_dir->subdir('.snowsql');
$cfgdir->mkpath;
my $cfgfn = $cfgdir->file('config');
my $cfg = {
username => 'jonSnow',
password => 'winter is cøming',
accountname => 'golem',
region => 'Africa',
warehousename => 'LaBries',
rolename => 'ACCOUNTADMIN',
dbname => 'dolphin',
};
# Unset the mock.
$mock_snow->unmock('_snowcfg');
for my $qm (q{}, q{'}, q{"}) {
# Write out a the config file.
open my $fh, '>:utf8', $cfgfn or die "Cannot open $cfgfn: $!\n";
print {$fh} "[connections]\n";
while (my ($k, $v) = each %{ $cfg }) {
print {$fh} "$k = $qm$v$qm\n";
}
# Add a named connection, which should be ignored.
print {$fh} "[connections.winner]\nusername = ${qm}WINNING$qm\n";
close $fh or die "Cannot close $cfgfn: $!\n";
# Make sure we read it in.
my $target = App::Sqitch::Target->new(
name => 'db:snowflake:',
sqitch => $sqitch,
);
my $snow = $CLASS->new( sqitch => $sqitch, target => $target );
is_deeply $snow->_snowcfg, $cfg, 'Should have read config from file';
}
# Reset default mock.
$mock_snow->mock(_snowcfg => {});
}
##############################################################################
# Make sure we read snowsql config connection settings.
SNOWSQLCFG: {
local $ENV{SNOWSQL_ACCOUNT};
local $ENV{SNOWSQL_HOST};
my $target = App::Sqitch::Target->new(
name => 'db:snowflake:',
sqitch => $sqitch,
);
# Read config.
$mock_snow->mock(_snowcfg => {
username => 'jon_snow',
password => 'let me in',
accountname => 'flipr',
rolename => 'SYSADMIN',
warehousename => 'Waterbed',
dbname => 'monkey',
});
my $snow = $CLASS->new( sqitch => $sqitch, target => $target );
is $snow->username, 'jon_snow',
'Should read username fron snowsql config file';
is $snow->password, 'let me in',
'Should read password fron snowsql config file';
is $snow->account, 'flipr',
'Should read accountname fron snowsql config file';
is $snow->uri->dbname, 'monkey',
'Should read dbname from snowsql config file';
is $snow->warehouse, 'Waterbed',
'Should read warehousename fron snowsql config file';
is $snow->role, 'SYSADMIN',
'Should read rolename fron snowsql config file';
is $snow->uri->host, 'flipr.snowflakecomputing.com',
'Should derive host name from config file accounte name';
# Reset default mock.
$mock_snow->mock(_snowcfg => {});
}
##############################################################################
# Make sure config settings override defaults.
$config->update(
'engine.snowflake.client' => '/path/to/snowsql',
'engine.snowflake.target' => 'db:snowflake://fred:hi@foo/try?warehouse=foo;role=yup',
'engine.snowflake.registry' => 'meta',
);
$std_opts[-3] = 'registry=meta';
$std_opts[-1] = 'warehouse=foo';
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $snow = $CLASS->new(sqitch => $sqitch, target => $target),
'Create another snowflake';
is $snow->account, 'foo', 'Should extract account from URI';
is $snow->username, 'fred', 'Should extract username from URI';
is $snow->password, 'hi', 'Should extract password from URI';
is $snow->warehouse, 'foo', 'Should extract warehouse from URI';
is $snow->role, 'yup', 'Should extract role from URI';
is $snow->registry, 'meta', 'registry should be as configured';
is $snow->uri->as_string,
'db:snowflake://fred:hi@foo.snowflakecomputing.com/try?warehouse=foo;role=yup',
'URI should be as configured with full domain name';
like $snow->destination,
qr{^db:snowflake://fred:?\@foo\.snowflakecomputing\.com/try\?warehouse=foo;role=yup$},
'Destination should omit password';
is $snow->client, '/path/to/snowsql', 'client should be as configured';
is_deeply [$snow->snowsql], [qw(
/path/to/snowsql
--accountname foo
--username fred
--dbname try
--rolename yup
), @std_opts], 'snowsql command should be configured from URI config';
##############################################################################
# Test SQL helpers.
is $snow->_listagg_format, q{listagg(%1$s, ' ') WITHIN GROUP (ORDER BY %1$s)},
'Should have _listagg_format';
is $snow->_ts_default, 'current_timestamp', 'Should have _ts_default';
is $snow->_regex_op, 'REGEXP', 'Should have _regex_op';
is $snow->_simple_from, ' FROM dual', 'Should have _simple_from';
is $snow->_limit_default, '4611686018427387903', 'Should have _limit_default';
DBI: {
local *DBI::state;
ok !$snow->_no_table_error, 'Should have no table error';
ok !$snow->_no_column_error, 'Should have no column error';
$DBI::state = '42S02';
ok $snow->_no_table_error, 'Should now have table error';
ok !$snow->_no_column_error, 'Still should have no column error';
$DBI::state = '42703';
ok !$snow->_no_table_error, 'Should again have no table error';
ok $snow->_no_column_error, 'Should now have no column error';
ok !$snow->_unique_error, 'Unique constraints not supported by Snowflake';
}
is_deeply [$snow->_limit_offset(8, 4)],
[['LIMIT 8', 'OFFSET 4'], []],
'Should get limit and offset';
is_deeply [$snow->_limit_offset(0, 2)],
[['LIMIT 4611686018427387903', 'OFFSET 2'], []],
'Should get limit and offset when offset only';
is_deeply [$snow->_limit_offset(12, 0)], [['LIMIT 12'], []],
'Should get only limit with 0 offset';
is_deeply [$snow->_limit_offset(12)], [['LIMIT 12'], []],
'Should get only limit with noa offset';
is_deeply [$snow->_limit_offset(0, 0)], [[], []],
'Should get no limit or offset for 0s';
is_deeply [$snow->_limit_offset()], [[], []],
'Should get no limit or offset for no args';
is_deeply [$snow->_regex_expr('corn', 'Obama$')],
["regexp_substr(corn, ?) IS NOT NULL", 'Obama$'],
'Should use regexp_substr IS NOT NULL for regex expr';
##############################################################################
# Test unexpeted datbase error in _cid().
$mock_snow->mock(dbh => sub { die 'OW' });
throws_ok { $snow->initialized } qr/OW/,
'initialized() should rethrow unexpected DB error';
throws_ok { $snow->_cid } qr/OW/,
'_cid should rethrow unexpected DB error';
$mock_snow->unmock('dbh');
##############################################################################
# Test _run(), _capture() _spool(), and _probe().
$config->replace('core.engine' => 'snowflake');
can_ok $snow, qw(_run _capture _spool);
my $mock_sqitch = Test::MockModule->new('App::Sqitch');
my ($exp_pass, @capture) = ('s3cr3t');
$mock_sqitch->mock(capture => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@capture = @_;
if (defined $exp_pass) {
is $ENV{SNOWSQL_PWD}, $exp_pass, qq{SNOWSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{SNOWSQL_PWD}, 'SNOWSQL_PWD should not exist';
}
return;
});
my @spool;
$mock_sqitch->mock(spool => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@spool = @_;
if (defined $exp_pass) {
is $ENV{SNOWSQL_PWD}, $exp_pass, qq{SNOWSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{SNOWSQL_PWD}, 'SNOWSQL_PWD should not exist';
}
});
my @probe;
$mock_sqitch->mock(probe => sub {
local $Test::Builder::Level = $Test::Builder::Level + 2;
shift;
@probe = @_;
if (defined $exp_pass) {
is $ENV{SNOWSQL_PWD}, $exp_pass, qq{SNOWSQL_PWD should be "$exp_pass"};
} else {
ok !exists $ENV{SNOWSQL_PWD}, 'SNOWSQL_PWD should not exist';
}
return;
});
$target = App::Sqitch::Target->new(sqitch => $sqitch, uri => URI->new($uri));
$target->uri->password($exp_pass);
ok $snow = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a snowflake with sqitch with options';
ok $snow->_run(qw(foo bar baz)), 'Call _run';
is_deeply \@capture, [$snow->snowsql, qw(foo bar baz)],
'Command should be passed to capture()';
ok $snow->_spool('FH'), 'Call _spool';
is_deeply \@spool, ['FH', $snow->snowsql, $snow->_verbose_opts],
'Command should be passed to spool()';
lives_ok { $snow->_capture(qw(foo bar baz)) } 'Call _capture';
is_deeply \@capture, [$snow->snowsql, $snow->_verbose_opts, qw(foo bar baz)],
'Command should be passed to capture()';
lives_ok { $snow->_probe(qw(foo bar baz)) } 'Call _probe';
is_deeply \@probe, [$snow->snowsql, $snow->_verbose_opts, qw(foo bar baz)],
'Command should be passed to probe()';
# Without password.
$target = App::Sqitch::Target->new( sqitch => $sqitch );
ok $snow = $CLASS->new(sqitch => $sqitch, target => $target),
'Create a snowflake with sqitch with no pw';
$exp_pass = undef;
ok $snow->_run(qw(foo bar baz)), 'Call _run again';
is_deeply \@capture, [$snow->snowsql, qw(foo bar baz)],
'Command should be passed to capture() again';
ok $snow->_spool('FH'), 'Call _spool again';
is_deeply \@spool, ['FH', $snow->snowsql, $snow->_verbose_opts],
'Command should be passed to spool() again';
lives_ok { $snow->_capture(qw(foo bar baz)) } 'Call _capture again';
is_deeply \@capture, [$snow->snowsql, $snow->_verbose_opts, qw(foo bar baz)],
'Command should be passed to capture() again';
lives_ok { $snow->_probe(qw(foo bar baz)) } 'Call _probe again';
is_deeply \@probe, [$snow->snowsql, $snow->_verbose_opts, qw(foo bar baz)],
'Command should be passed to probe() again';
##############################################################################
# Test file and handle running.
ok $snow->run_file('foo/bar.sql'), 'Run foo/bar.sql';
is_deeply \@capture, [$snow->snowsql, $snow->_quiet_opts, '--filename', 'foo/bar.sql'],
'File should be passed to capture()';
ok $snow->run_handle('FH'), 'Spool a "file handle"';
is_deeply \@spool, ['FH', $snow->snowsql, $snow->_verbose_opts],
'Handle should be passed to spool()';
# Verify should go to capture unless verosity is > 1.
# ok $snow->run_verify('foo/bar.sql'), 'Verify foo/bar.sql';
# is_deeply \@capture, [$snow->snowsql, '--filename', 'foo/bar.sql'],
# 'Verify file should be passed to capture()';
$mock_sqitch->mock(verbosity => 2);
ok $snow->run_verify('foo/bar.sql'), 'Verify foo/bar.sql again';
is_deeply \@capture, [$snow->snowsql, $snow->_verbose_opts, '--filename', 'foo/bar.sql'],
'Verifile file should be passed to run() for high verbosity';
$mock_sqitch->unmock_all;
##############################################################################
# Test DateTime formatting stuff.
ok my $ts2char = $CLASS->can('_ts2char_format'), "$CLASS->can('_ts2char_format')";
is sprintf($ts2char->(), 'foo'),
q{to_varchar(CONVERT_TIMEZONE('UTC', foo), '"year:"YYYY":month:"MM":day:"DD":hour:"HH24":minute:"MI":second:"SS":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';
ok my $now = App::Sqitch::DateTime->now, 'Construct a datetime object';
is $snow->_char2ts($now), $now->as_string(format => 'iso'),
'Should get ISO output from _char2ts';
##############################################################################
# Test run_upgrade.
UPGRADE: {
my $file;
$mock_snow->mock(run_file => sub { $file = $_[1] });
# Need to mock the database handle.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
$mock_snow->mock(dbh => $dbh);
my $mock_dbh = Test::MockModule->new(ref $dbh, no_auto => 1);
my (@do, $do_err);
$mock_dbh->mock(do => sub { shift; @do = @_; die $do_err if $do_err });
# Deploy with schema permissions.
my $fn = file($INC{'App/Sqitch/Engine/snowflake.pm'})->dir->file('snowflake.sql');
ok $snow->run_upgrade($fn), 'Run upgrade';
is $file, $fn, 'Should have executed the unmodified file';
# Deploy withouit schema permissions.
$do_err = 'Ooops';
local *DBI::state;
$DBI::state = '42501';
ok $snow->run_upgrade($fn), 'Run upgrade again';
isnt $file, $fn, 'Should have a modified file';
# Make sure no schema stuff remains in the file.
file_contents_unlike $file, qr/CREATE SCHEMA/,
'Should have no CREATE SCHEMA';
file_contents_unlike $file, qr/COMMENT ON SCHEMA/,
'Should have no COMMENT ON SCHEMA';
# Die with any other error.
$DBI::state = '10030';
throws_ok { $snow->run_upgrade($fn) } qr/Ooops/,
'Should have any other error';
$mock_snow->unmock('run_file');
$mock_snow->unmock('dbh');
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($snow->key);
##############################################################################
# Can we do live tests?
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 IF EXISTS $_ CASCADE") for ($reg1, $reg2);
}
$uri = URI->new(
$ENV{SQITCH_TEST_SNOWFLAKE_URI} ||
$ENV{SNOWSQL_URI} ||
'db:snowflake://accountname/?Driver=Snowflake'
);
$uri->host($uri->host . ".snowflakecomputing.com") if $uri->host !~ /snowflakecomputing[.]com/;
my $err = try {
$snow->use_driver;
$dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $snow->error_handler,
});
undef;
} catch {
$_
};
DBIEngineTest->run(
class => $CLASS,
version_query => q{SELECT 'Snowflake ' || CURRENT_VERSION()},
target_params => [ uri => $uri, registry => $reg1 ],
alt_target_params => [ uri => $uri, registry => $reg2 ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have vsql and can connect to the database.
my $version = $self->sqitch->capture( $self->client, '--version' );
say "# Detected SnowSQL $version";
$self->_capture('--query' => 'SELECT CURRENT_DATE FROM dual');
},
engine_err_regex => qr/\bSQL\s+compilation\s+error:/,
init_error => __x(
'Sqitch schema "{schema}" already exists',
schema => $reg2,
),
test_dbh => sub {
my $dbh = shift;
# Make sure the sqitch schema is the first in the search path.
is $dbh->selectcol_arrayref('SELECT current_schema()')->[0],
uc($reg2), 'The Sqitch schema should be the current schema';
},
add_second_format => 'dateadd(second, 1, %s)',
no_unique => 1,
);
done_testing;
rework.conf 100644 001751 000166 40 15004170404 16253 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [rework]
open_editor = true
engine.conf 100644 001751 000166 544 15004170404 16240 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
engine = pg
[engine "mysql"]
target = db:mysql://root@/foo
client = /usr/sbin/mysql
[engine "pg"]
target = db:pg:try
registry = meta
client = /usr/sbin/psql
[engine "sqlite"]
target = widgets
client = /usr/sbin/sqlite3
[target "widgets"]
uri = db:sqlite:widgets.db
plan_file = foo.plan
editor.conf 100644 001751 000166 74 15004170404 16237 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
engine = pg
editor = config_specified_editor
mooseless.t 100644 001751 000166 1022 15004170404 16332 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More;
use File::Find qw(find);
use Module::Runtime qw(use_module);
my $test = sub {
return unless $_ =~ /\.pm$/;
my $module = $File::Find::name;
$module =~ s!^(blib[/\\])?lib[/\\]!!;
$module =~ s![/\\]!::!g;
$module =~ s/\.pm$//;
eval { use_module $module; };
if ($@) {
diag "Couldn't load $module: $@";
undef $@;
return;
}
ok ! $INC{'Moose.pm'}, "No moose in $module";
};
find($test, 'lib');
done_testing();
sqitch.conf 100644 001751 000166 663 15004170404 16270 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
uri = https://github.com/sqitchers/sqitch/
engine = pg
top_dir = migrations
extension = ddl
pager = less -r
[engine "pg"]
client = /usr/local/pgsql/bin/psql
[revert]
to = gamma
count = 2
revision = 1.1
[bundle]
from = gamma
tags_only = true
dest_dir = _build/sql
[foo "BAR"]
baz = hello
yep
[guess "Yes.No"]
red = true
Calico = false
target.conf 100644 001751 000166 352 15004170404 16256 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t [core]
engine = pg
[target "dev"]
uri = db:pg:widgets
[target "qa"]
uri = db:pg://qa.example.com/qa_widgets
registry = meta
client = /usr/sbin/psql
[target "prod"]
uri = db:pg://prod.example.us/pr_widgets
cockroach.t 100644 001751 000166 14242 15004170404 16305 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/t #!/usr/bin/perl -w
# To test against a live Cockroach database, you must set the
# SQITCH_TEST_COCKROACH_URI environment variable. This is a standard URI::db
# URI, and should look something like this:
#
# export SQITCH_TEST_COCKROACH_URI=db:cockroach://root:password@localhost:26257/sqitchtest
#
use strict;
use warnings;
use 5.010;
use Test::More 0.94;
use Test::MockModule;
use Locale::TextDomain qw(App-Sqitch);
use Try::Tiny;
use App::Sqitch;
use App::Sqitch::Target;
use App::Sqitch::Plan;
use Path::Class;
use DBD::Mem;
use lib 't/lib';
use DBIEngineTest;
use TestConfig;
my $CLASS;
BEGIN {
$CLASS = 'App::Sqitch::Engine::cockroach';
require_ok $CLASS or die;
delete $ENV{PGPASSWORD};
}
my $uri = URI::db->new('db:cockroach:');
my $config = TestConfig->new('core.engine' => 'cockroach');
my $sqitch = App::Sqitch->new(config => $config);
my $target = App::Sqitch::Target->new(
sqitch => $sqitch,
uri => $uri,
);
isa_ok my $cockroach = $CLASS->new(sqitch => $sqitch, target => $target), $CLASS;
is $cockroach->key, 'cockroach', 'Key should be "cockroach"';
is $cockroach->name, 'CockroachDB', 'Name should be "CockroachDB"';
is $cockroach->driver, 'DBD::Pg 2.0', 'Driver should be "DBD::Pg 2.0"';
is $cockroach->wait_lock, 1, 'wait_lock should return 1';
##############################################################################
# Test DateTime formatting stuff.
ok my $ts2char = $CLASS->can('_ts2char_format'), "$CLASS->can('_ts2char_format')";
is sprintf($ts2char->($cockroach), 'foo'),
q{experimental_strftime(foo AT TIME ZONE 'UTC', 'year:%Y:month:%m:day:%d:hour:%H:minute:%M:second:%S: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';
##############################################################################
# Test table error methods.
DBI: {
local *DBI::state;
ok !$cockroach->_no_table_error, 'Should have no table error';
ok !$cockroach->_no_column_error, 'Should have no column error';
$DBI::state = '42703';
ok !$cockroach->_no_table_error, 'Should again have no table error';
ok $cockroach->_no_column_error, 'Should now have no column error';
$DBI::state = '42P01';
ok $cockroach->_no_table_error, 'Should now have table error';
ok !$cockroach->_no_column_error, 'Still should have no column error';
}
##############################################################################
# Test _run_registry_file.
RUNREG: {
# Mock I/O used by _run_registry_file.
my $mock_engine = Test::MockModule->new($CLASS);
my @ran;
$mock_engine->mock(_run => sub { shift; push @ran, \@_ });
# Mock up the database handle.
my $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
$mock_engine->mock(dbh => $dbh );
my $mock_dbd = Test::MockModule->new(ref $dbh, no_auto => 1);
my @done;
$mock_dbd->mock(do => sub { shift; push @done, \@_; 1 });
# Find the SQL file.
my $ddl = file($INC{'App/Sqitch/Engine/cockroach.pm'})->dir->file('cockroach.sql');
# Test it!
my $registry = $cockroach->registry;
ok $cockroach->_run_registry_file($ddl), 'Run the registry file';
is_deeply \@ran, [[
'--file' => $ddl,
'--set' => "registry=$registry",
]], 'Shoud have deployed the original SQL file';
is_deeply \@done, [['SET search_path = ?', undef, $registry]],
'The registry should have been added to the search path';
}
# Make sure we have templates.
DBIEngineTest->test_templates_for($cockroach->key);
##############################################################################
# Can we do live tests?
$config->replace('core.engine' => 'cockroach');
$sqitch = App::Sqitch->new(config => $config);
$target = App::Sqitch::Target->new( sqitch => $sqitch );
$cockroach = $CLASS->new(sqitch => $sqitch, target => $target);
$uri = URI->new(
$ENV{SQITCH_TEST_COCKROACH_URI}
|| 'db:cockroach://' . ($ENV{PGUSER} || 'root') . "\@localhost/"
);
my $dbh;
my $id = DBIEngineTest->randstr;
my ($db, $reg1, $reg2) = map { $_ . $id } qw(__sqitchtest__ 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;
});
# Drop the database or schema.
$dbh->do("DROP DATABASE $db") if $dbh->{Active}
}
my $err = try {
$cockroach->_capture('--version');
$cockroach->use_driver;
$dbh = DBI->connect($uri->dbi_dsn, $uri->user, $uri->password, {
PrintError => 0,
RaiseError => 0,
AutoCommit => 1,
HandleError => $cockroach->error_handler,
cockroach_lc_messages => 'C',
});
$dbh->do("CREATE DATABASE $db");
$uri->dbname($db);
undef;
} catch {
$_
};
DBIEngineTest->run(
class => $CLASS,
version_query => 'SELECT version()',
target_params => [ uri => $uri, registry => $reg1 ],
alt_target_params => [ uri => $uri, registry => $reg2 ],
skip_unless => sub {
my $self = shift;
die $err if $err;
# Make sure we have psql and can connect to the database.
my $version = $self->sqitch->capture( $self->client, '--version' );
say "# Detected $version";
$self->_capture('--command' => 'SELECT version()');
},
engine_err_regex => qr/^ERROR: /,
init_error => __x(
'Sqitch schema "{schema}" already exists',
schema => $reg2,
),
test_dbh => sub {
my $dbh = shift;
# Make sure the sqitch schema is the first in the search path.
is $dbh->selectcol_arrayref('SELECT current_schema')->[0],
$reg2, 'The Sqitch schema should be the current schema';
},
);
done_testing;
dist 000755 001751 000166 0 15004170404 14501 5 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 cpanfile 100644 001751 000166 13604 15004170404 16371 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/dist # This file is generated by Dist::Zilla::Plugin::CPANFile v6.032
# Do not edit this file directly. To change prereqs, edit the `dist.ini` file.
requires "Algorithm::Backoff::Exponential" => "0.006";
requires "Clone" => "0";
requires "Config::GitLike" => "1.15";
requires "DBI" => "1.631";
requires "DateTime" => "1.04";
requires "DateTime::TimeZone" => "0";
requires "Devel::StackTrace" => "1.30";
requires "Digest::SHA" => "0";
requires "Encode" => "0";
requires "Encode::Locale" => "0";
requires "File::Basename" => "0";
requires "File::Copy" => "0";
requires "File::Path" => "0";
requires "File::Temp" => "0";
requires "Getopt::Long" => "0";
requires "Hash::Merge" => "0";
requires "IO::Handle" => "0";
requires "IO::Pager" => "0.34";
requires "IPC::Run3" => "0";
requires "IPC::System::Simple" => "1.17";
requires "List::MoreUtils" => "0";
requires "List::Util" => "0";
requires "Locale::Messages" => "0";
requires "Locale::TextDomain" => "1.20";
requires "Moo" => "1.002000";
requires "Moo::Role" => "0";
requires "POSIX" => "0";
requires "Path::Class" => "0.33";
requires "PerlIO::utf8_strict" => "0";
requires "Pod::Escapes" => "1.04";
requires "Pod::Find" => "0";
requires "Pod::Usage" => "0";
requires "Scalar::Util" => "0";
requires "StackTrace::Auto" => "0";
requires "String::Formatter" => "0";
requires "String::ShellQuote" => "0";
requires "Sub::Exporter" => "0";
requires "Sub::Exporter::Util" => "0";
requires "Sys::Hostname" => "0";
requires "Template::Tiny" => "0.11";
requires "Term::ANSIColor" => "2.02";
requires "Throwable" => "0.200009";
requires "Time::HiRes" => "0";
requires "Time::Local" => "0";
requires "Try::Tiny" => "0";
requires "Type::Library" => "0.040";
requires "Type::Utils" => "0";
requires "Types::Standard" => "0";
requires "URI" => "0";
requires "URI::QueryParam" => "0";
requires "URI::db" => "0.20";
requires "User::pwent" => "0";
requires "constant" => "0";
requires "locale" => "0";
requires "namespace::autoclean" => "0.16";
requires "overload" => "0";
requires "parent" => "0";
requires "perl" => "5.010";
requires "strict" => "0";
requires "utf8" => "0";
requires "warnings" => "0";
recommends "Class::XSAccessor" => "1.18";
recommends "Pod::Simple" => "1.41";
recommends "Template" => "0";
recommends "Type::Tiny::XS" => "0.010";
suggests "DBD::Firebird" => "1.11";
suggests "DBD::MariaDB" => "1.0";
suggests "DBD::ODBC" => "1.59";
suggests "DBD::Oracle" => "1.23";
suggests "DBD::Pg" => "2.0";
suggests "DBD::SQLite" => "1.37";
suggests "MySQL::Config" => "0";
suggests "Time::HiRes" => "0";
suggests "Time::Local" => "0";
on 'build' => sub {
requires "Module::Build" => "0.35";
};
on 'build' => sub {
recommends "Menlo::CLI::Compat" => "0";
};
on 'test' => sub {
requires "Capture::Tiny" => "0.12";
requires "Carp" => "0";
requires "DBD::Mem" => "0";
requires "File::Find" => "0";
requires "File::Spec" => "0";
requires "File::Spec::Functions" => "0";
requires "FindBin" => "0";
requires "IO::Pager" => "0.34";
requires "Module::Runtime" => "0";
requires "Path::Class" => "0.33";
requires "Test::Deep" => "0";
requires "Test::Dir" => "0";
requires "Test::Exception" => "0";
requires "Test::Exit" => "0";
requires "Test::File" => "0";
requires "Test::File::Contents" => "0.20";
requires "Test::MockModule" => "0.17";
requires "Test::MockObject::Extends" => "0";
requires "Test::More" => "0.94";
requires "Test::NoWarnings" => "0.083";
requires "Test::Warn" => "0.31";
requires "base" => "0";
requires "lib" => "0";
};
on 'configure' => sub {
requires "Module::Build" => "0.35";
};
on 'develop' => sub {
requires "DBD::Firebird" => "1.11";
requires "DBD::MariaDB" => "1.0";
requires "DBD::ODBC" => "1.59";
requires "DBD::Oracle" => "1.23";
requires "DBD::Pg" => "2.0";
requires "DBD::SQLite" => "1.37";
requires "MySQL::Config" => "0";
requires "Time::HiRes" => "0";
requires "Time::Local" => "0";
};
on 'develop' => sub {
recommends "DBD::Firebird" => "1.11";
recommends "DBD::MariaDB" => "1.0";
recommends "DBD::ODBC" => "1.59";
recommends "DBD::Pg" => "2.0";
recommends "DBD::SQLite" => "1.37";
recommends "Dist::Zilla" => "5";
recommends "Dist::Zilla::Plugin::AutoPrereqs" => "0";
recommends "Dist::Zilla::Plugin::CPANFile" => "0";
recommends "Dist::Zilla::Plugin::ConfirmRelease" => "0";
recommends "Dist::Zilla::Plugin::CopyFilesFromBuild" => "0";
recommends "Dist::Zilla::Plugin::ExecDir" => "0";
recommends "Dist::Zilla::Plugin::GatherDir" => "0";
recommends "Dist::Zilla::Plugin::Git::Check" => "0";
recommends "Dist::Zilla::Plugin::License" => "0";
recommends "Dist::Zilla::Plugin::LocaleTextDomain" => "0";
recommends "Dist::Zilla::Plugin::Manifest" => "0";
recommends "Dist::Zilla::Plugin::ManifestSkip" => "0";
recommends "Dist::Zilla::Plugin::MetaJSON" => "0";
recommends "Dist::Zilla::Plugin::MetaNoIndex" => "0";
recommends "Dist::Zilla::Plugin::MetaResources" => "0";
recommends "Dist::Zilla::Plugin::MetaYAML" => "0";
recommends "Dist::Zilla::Plugin::ModuleBuild" => "0";
recommends "Dist::Zilla::Plugin::OptionalFeature" => "0";
recommends "Dist::Zilla::Plugin::OurPkgVersion" => "0";
recommends "Dist::Zilla::Plugin::Prereqs" => "0";
recommends "Dist::Zilla::Plugin::Prereqs::AuthorDeps" => "0";
recommends "Dist::Zilla::Plugin::PruneCruft" => "0";
recommends "Dist::Zilla::Plugin::Readme" => "0";
recommends "Dist::Zilla::Plugin::RunExtraTests" => "0";
recommends "Dist::Zilla::Plugin::ShareDir" => "0";
recommends "Dist::Zilla::Plugin::TestRelease" => "0";
recommends "Dist::Zilla::Plugin::UploadToCPAN" => "0";
recommends "MySQL::Config" => "0";
recommends "Software::License::MIT" => "0";
recommends "Test::MockObject::Extends" => "1.20180705";
recommends "Test::Pod" => "1.41";
recommends "Test::Pod::Coverage" => "1.08";
recommends "Test::Spelling" => "0";
recommends "Time::HiRes" => "0";
recommends "Time::Local" => "0";
};
on 'develop' => sub {
suggests "DBD::Oracle" => "1.23";
};
lib 000755 001751 000166 0 15004170404 14304 5 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2 sqitch.pod 100644 001751 000166 34441 15004170404 16471 0 ustar 00runner docker 000000 000000 App-Sqitch-v1.5.2/lib =encoding UTF-8
=head1 Name
sqitch - Sensible database change management
=head1 Synopsis
sqitch [options] [command-options] [args]
=head1 Description
Sqitch is a database change management application. It currently supports:
=over
=item * L 8.4+
=item * L 2.6+
=item * L 21+
=item * L 3.8.6+
=item * L 5.1+
=item * L 10.0+
=item * L 10g+,
=item * L 2.0+
=item * L 7.2+
=item * L 6.0+
=item * L
=back
What makes it different from your typical
L-L