view release on metacpan or  search on metacpan

t/change.t  view on Meta::CPAN

# 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",
    );
}