view release on metacpan or  search on metacpan

lib/App/perlmv/u.pm  view on Meta::CPAN

        return [];
    }
}

sub _write_undo_file {
    require Sereal::Encoder;

    my $path = _undo_file_path();
    open my $fh, ">", $path
        or die "perlmv-u: Can't open undo file '$path' for writing: $!\n";
    print $fh Sereal::Encoder::encode_sereal($_[0]);
    close $fh or die "perlmv-u: Can't write undo file '$path': $!\n";
}

$SPEC{move_multiple} = {
    v => 1.1,
    args => {
        file_pairs => {
            summary => 'Pairs of [source, target]',
            schema => ['array*', {
                of=>['array*', elems=>['pathname*', 'pathname*']],
            }],
            req => 1,
            pos => 0,
            greedy => 1,
            description => <<'_',

Both `source` and `target` must be absolute paths.

_
        },
    },
    features => {
        tx => {v=>2},
        idempotent => 1,
        dry_run => 1,
    },
};
sub move_multiple {
    require File::Util::Test;

    my %args = @_;

    my $tx_action = $args{-tx_action};
    if ($tx_action eq 'check_state') {
        my (%src, %dest, %exists);
        for my $pair (@{ $args{pairs} }) {
            my ($src, $dest) = @$pair;
            $src {$src}++;
            $dest{$dest}++;
            for my $k ($src, $dest) {
                unless (exists $exists{$k}) {
                    $exists{$k} = File::Util::Test::file_exists($k);
                }
            }
        }
        my $all_dest_exist = 1;
        for (keys %dest) {
            unless ($exists{$_}) { $all_dest_exist = 0; last }
        }
        my $all_src_not_in_dest_not_exist = 1;
        for (keys %src) {
            next if $dest{$_};
            if ($exists{$_}) { $all_src_not_in_dest_not_exist = 0; last }
        }
        if ($all_dest_exist && $all_src_not_in_dest_not_exist) {
            # fixed
            return [304, "All sources do not exist and ".
                        "all targets already exist"];
        }
        my $all_src_exist = 1;
        for (keys %src) {
            unless ($exists{$_}) { $all_src_exist = 0; last }
        }
        my $all_dest_not_in_src_not_exist = 1;
        for (keys %dest) {
            next if $src{$_};
            if ($exists{$_}) { $all_dest_not_in_src_not_exist = 0; last }
        }
        if ($all_src_exist && $all_dest_not_in_src_not_exist) {
            # fixable
            my @do_actions;
            my @undo_actions;
            my @pairs;
            for my $pair (reverse @{ $args{pairs} }) {
                push @pairs, [$pair->[1] => $pair->[0]];
            }
            push @do_actions  , ['move_multiple', {pairs => $args{pairs}}];
            push @undo_actions, ['move_multiple', {pairs => \@pairs}];
            return [200, "OK", undef, {
                do_actions  =>\@do_actions,
                undo_actions=>\@undo_actions}];
        } else {
            # not fixable
            return [412, "Either some sources do not exist or ".
                        "some targets exist already"];
        }
    } elsif ($tx_action eq 'fix_state') {
        for my $pair (@{ $args{pairs} }) {
            my ($src, $dest) = @$pair;
            log_info("Renaming %s -> %s ...", $src, $dest);
            unless (rename $src, $dest) {
                if ($args{_ignore_errors}) {
                    warn "Can't rename '$src' -> '$dest': $!, skipped\n" if $!;
                } else {
                    return [500, "Can't rename '$src' -> '$dest': $!"] if $!;
                }
            }
        }
        [200, "OK"];
    } else {
        return [400, "Invalid -tx_action"];
    }
}

$SPEC{perlmv} = {
    v => 1.1,
    summary => 'Rename files using Perl code, with undo/redo',
    args => {
        eval => {
            summary => 'Perl code to rename file',
            schema => 'str*',
            cmdline_aliases => {e=>{}},
            description => <<'_',

Your Perl code will receive the original filename in `$_` and is expected to
modify it. If it is unmodified, the last expression is used as the new filename.
If it is also the same as the original filename, the file is not renamed.

_
            req => 1,
        },
        files => {
            'x.name.is_plural' => 1,
            'x.name.singular' => 'file',
            schema => ['array*', of=>'pathname*'],
            req => 1,
            pos => 0,
            greedy => 1,
        },