view release on metacpan or  search on metacpan

lib/App/mvr.pm  view on Meta::CPAN

package App::mvr;
use v5.14.0;
use strict;
use warnings;
# ABSTRACT: like mv, but clever
our $VERSION = '0.005'; # VERSION

use Exporter qw(import);
our @EXPORT = qw(mvr);

use Path::Tiny 0.034;
use Try::Tiny;
use Carp;

our $VERBOSE = 0;


my $duplicates = sub {
    my $A = shift;
    my $B = shift;
    return if $A->stat->size != $B->stat->size; # avoid reading file off disk

    # Pull out the big guns
    return $A->digest eq $B->digest;
};

sub mvr {
    my %args = @_;
    $args{dest}   //= delete $args{destination};
    $args{source} = [delete $args{source}] unless ref $args{source} eq 'ARRAY';

    my $dest = path( $args{dest} );
    my $dest_is_dir = $dest->exists && $dest->is_dir;
    croak sprintf("target `%s' is not a directory\n", $dest)
        if @{ $args{source} } > 1 and !$dest_is_dir;

    STDOUT->autoflush(1) if $VERBOSE;
    foreach my $from ( map { path($_) } @{ $args{source} } ) {
        print "\r${from}\e[K" if $VERBOSE == 1;

        unless ($from->exists) {
            carp sprintf("Cannot stat `%s': No such file or directory\n", $from);
            next;
        }
        my $to = path( $dest, ($dest_is_dir ? $from->basename : ()) );
        croak sprintf("`%s' and `%s' are the same file\n", $to, $from)
            if $from->absolute eq $to->absolute;

        if ($to->exists) {
            if ($args{deduplicate}) {
                print STDERR "File already exists; checking for duplication..."
                    if $VERBOSE > 1;
                if ($duplicates->($from, $to)) {
                    printf STDERR
                        " `%s' and `%s' are duplicates; removing the source file.\n",
                        $from->basename, $to->basename
                        if $VERBOSE > 1;
                    $from->remove;
                    $to->touch;
                    next;
                }
                else {
                    printf STDERR
                        " `%s' and `%s' are not duplicates.\n",
                        $from->basename, $to->basename
                        if $VERBOSE > 1;
                }
            }

            my ($prefix, $suffix) = $to->basename =~ m{^(.*)\.(\w+)$};
            $to = Path::Tiny->tempfile(
                UNLINK => 0,