App-Sqitch

 view release on metacpan or  search on metacpan

inc/Module/Build/Sqitch.pm  view on Meta::CPAN

        # Append .default if file already exists at its ultimate destination
        # or if it exists with an old name (to be moved by move_old_templates).
        if ( -e File::Spec->catfile($etc, $rel) || (
            $segs[0] eq 'templates'
                && $fn =~ /^(?:pg|sqlite)[.]tmpl$/
                && -e File::Spec->catfile($etc, 'templates', "$segs[1].tmpl")
        ) ) {
            $dest .= '.default';
        }

        $self->copy_if_modified(
            from => $file,
            to   => File::Spec->catfile( $self->blib, $dest )
        );
    }
}

sub process_pm_files {
    my $self = shift;
    my $ret  = $self->SUPER::process_pm_files(@_);
    my $pm   = File::Spec->catfile(qw(blib lib App Sqitch Config.pm));

inc/Module/Build/Sqitch.pm  view on Meta::CPAN

    # Delete empty directories.
    File::Find::finddepth(sub{rmdir},$base);
}

sub _copy_findbin_script {
    my $self = shift;
    # XXX Switch to lib/perl5.
    my $bin = $self->install_destination('script');
    my $script = File::Spec->catfile(qw(bin sqitch));
    my $dest = File::Spec->catfile($bin, 'sqitch');
    my $result = $self->copy_if_modified($script, $bin, 'flatten') or return;
    $self->fix_shebang_line($result) unless $self->is_vmsish;
    $self->_set_findbin($result);
    $self->make_executable($result);
}

sub _set_findbin {
    my ($self, $file) = @_;
    local $^I = '';
    local @ARGV = ($file);
    while (<>) {

lib/App/Sqitch/Command/bundle.pm  view on Meta::CPAN

        for my $target (@{ $ targets }) {
            my @fromto = splice @{ $changes }, 0, 2;
            $self->bundle_plan($target, @fromto);
            $self->bundle_scripts($target, @fromto);
        }
    }

    return $self;
}

sub _copy_if_modified {
    my ( $self, $src, $dst ) = @_;

    hurl bundle => __x(
        'Cannot copy {file}: does not exist',
        file => $src,
    ) unless -e $src;

    if (-e $dst) {
        # Skip the file if it is up-to-date.
        return $self if -M $dst <= -M $src;

lib/App/Sqitch/Command/bundle.pm  view on Meta::CPAN

        dest   => $dst,
        error  => $!,
    );
    return $self;
}

sub bundle_config {
    my $self = shift;
    $self->info(__ 'Writing config');
    my $file = $self->sqitch->config->local_file;
    $self->_copy_if_modified( $file, $self->dest_dir->file( $file->basename ) );
}

sub bundle_plan {
    my ($self, $target, $from, $to) = @_;

    my $dir = $self->dest_top_dir($target);

    if (!defined $from && !defined $to) {
        $self->info(__ 'Writing plan');
        my $file = $target->plan_file;
        return $self->_copy_if_modified(
            $file,
            $dir->file( $file->basename ),
        );
    }

    $self->info(__x(
        'Writing plan from {from} to {to}',
        from => $from // '@ROOT',
        to   => $to   // '@HEAD',
    ));

lib/App/Sqitch/Command/bundle.pm  view on Meta::CPAN

    $self->info(__ 'Writing scripts');
    $plan->position( $from_index );
    my $dir_for = $self->dest_dirs_for($target);

    while ( $plan->position <= $to_index ) {
        my $change = $plan->current // last;
        $self->info('  + ', $change->format_name_with_tags);
        my $prefix = $change->is_reworked ? 'reworked_' : '';
        my @path = $change->path_segments;
        if (-e ( my $file = $change->deploy_file )) {
            $self->_copy_if_modified(
                $file,
                $dir_for->{"${prefix}deploy"}->file(@path)
            );
        }
        if (-e ( my $file = $change->revert_file )) {
            $self->_copy_if_modified(
                $file,
                $dir_for->{"${prefix}revert"}->file(@path)
            );
        }
        if (-e ( my $file = $change->verify_file )) {
            $self->_copy_if_modified(
                $file,
                $dir_for->{"${prefix}verify"}->file(@path)
            );
        }
        $plan->next;
    }

    return $self;
}

t/bundle.t  view on Meta::CPAN

    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

t/bundle.t  view on Meta::CPAN

        "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';
}