#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Test::More tests => 132;
#use Test::More 'no_plan';
use App::Sqitch;
use Path::Class;
use Test::Exception;
use Test::Dir;
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(make_path remove_tree);
use Test::NoWarnings;
use lib 't/lib';
use MockOutput;
my $CLASS = 'App::Sqitch::Command::bundle';
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_deploy_dir
dest_revert_dir
dest_verify_dir
bundle_config
bundle_plan
bundle_scripts
_mkpath
_copy_if_modified
);
is_deeply [$CLASS->options], [qw(
dest-dir|dir=s
from=s
to=s
)], 'Should have dest_dir option';
is $bundle->dest_dir, dir('bundle'),
'Default dest_dir should be bundle/';
is $bundle->dest_top_dir, dir('bundle'), 'Should have dest top dir';
##############################################################################
# Test configure().
is_deeply $CLASS->configure($config, {}), {}, 'Default config should be empty';
is_deeply $CLASS->configure($config, {dest_dir => 'whu'}), {
dest_dir => dir 'whu',
}, '--dest_dir should be converted to a path object by configure()';
is_deeply $CLASS->configure($config, {from => 'HERE', to => 'THERE'}), {
from => 'HERE',
to => 'THERE',
}, '--from and --to should be passed through configure';
chdir 't';
END { remove_tree 'bundle' if -d 'bundle' }
ok $sqitch = App::Sqitch->new(
top_dir => dir 'sql',
), 'Load a sqitch object with top_dir';
$config = $sqitch->config;
my $dir = dir qw(_build sql);
is_deeply $CLASS->configure($config, {}), {
dest_dir => $dir,
}, '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, dir(qw(_build sql sql)),
'Dest top dir should be _build/sql/sql/';
for my $sub (qw(deploy revert verify)) {
my $attr = "dest_$sub\_dir";
is $bundle->$attr, $dir->subdir('sql', $sub),
"Dest $sub dir should be _build/sql/sql/$sub";
}
# Try pg project.
ok $sqitch = App::Sqitch->new(
top_dir => dir 'pg',
), 'Load a sqitch object with pg top_dir';
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'pg bundle command';
is $bundle->dest_dir, $dir, qq{dest_dir should again be "$dir"};
for my $sub (qw(deploy revert verify)) {
my $attr = "dest_$sub\_dir";
is $bundle->$attr, $dir->subdir('pg', $sub),
"Dest $sub dir should be _build/sql/pg/$sub";
}
##############################################################################
# Test _mkpath.
my $path = dir 'delete.me';
dir_not_exists_ok $path, "Path $path should not exist";
END { remove_tree $path->stringify if -e $path }
ok $bundle->_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 $bundle->_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 { $bundle->_mkpath('foo') } 'App::Sqitch::X',
'Should fail on permission issue';
is $@->ident, 'bundle', 'Permission error should have ident "bundle"';
is $@->message, __x(
'Error creating {path}: {error}',
path => 'foo',
error => 'Permission denied yo',
), 'The permission error should be formatted properly';
}
##############################################################################
# Test _copy().
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 debugging output';
# 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 { remove_tree $dir->parent->stringify }
$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, qw(sqitch.plan);
file_not_exists_ok $dest;
ok $bundle->bundle_plan, 'Bundle the plan file';
file_exists_ok $dest;
file_contents_identical $dest, file(qw(pg 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 the plan file with --from';
my $plan = $sqitch->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 . $/
. '%project=pg' . $/
. $/
. $plan->find('widgets')->as_string . $/
. $plan->find('func/add_user')->as_string . $/,
'Plan should have written only "widgets"';
# 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 the plan file with --to';
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 . $/
. '%project=pg' . $/
. $/
. $plan->find('users')->as_string . $/
. join( $/, map { $_->as_string } $plan->find('users')->tags ) . $/,
'Plan should have written only "users" and its tags';
##############################################################################
# Test bundle_scripts().
my @files = (
$bundle->dest_deploy_dir->file('users.sql'),
$bundle->dest_revert_dir->file('users.sql'),
$bundle->dest_deploy_dir->file('widgets.sql'),
$bundle->dest_revert_dir->file('widgets.sql'),
$bundle->dest_deploy_dir->file(qw(func add_user.sql)),
$bundle->dest_revert_dir->file(qw(func add_user.sql)),
);
file_not_exists_ok $_ for @files;
ok $sqitch = App::Sqitch->new(
extension => 'sql',
top_dir => dir 'pg',
), 'Load pg sqitch object';
isa_ok $bundle = App::Sqitch::Command->load({
sqitch => $sqitch,
command => 'bundle',
config => $config,
}), $CLASS, 'another bundle command';
ok $bundle->bundle_scripts, 'Bundle scripts';
file_exists_ok $_ for @files;
is_deeply +MockOutput->get_info, [
[__ 'Writing scripts'],
[' + ', 'users @alpha'],
[' + ', 'widgets'],
[' + ', 'func/add_user'],
], '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 scripts';
file_not_exists_ok $_ for @files[0,1];
file_exists_ok $_ for @files[2,3];
is_deeply +MockOutput->get_info, [
[__ 'Writing scripts'],
[' + ', 'widgets'],
[' + ', 'func/add_user'],
], 'Should have only "widets" in change 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',
), $CLASS, 'bundle to "users"';
ok $bundle->bundle_scripts, 'Bundle scripts';
file_exists_ok $_ for @files[0,1];
file_not_exists_ok $_ for @files[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)) {
throws_ok {
$CLASS->new( sqitch => $sqitch, $key => 'nonexistent' )->bundle_scripts
} '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;
@files = (
file($dir, 'sqitch.conf'),
file($bundle->dest_top_dir, 'sqitch.plan'),
@files,
);
file_not_exists_ok $_ for @files;
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 @files;
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'],
], 'Should have all notices';