Move/merge directories
diotalevi
created: 2006-09-14 19:15:20
#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long 'GetOptions';
use autouse 'Pod::Usage' => 'pod2usage';

GetOptions( 'tgt=s' => \ my($tgt),
            nop     => \ my($nop),
            why     => \ my($why),
            help => sub { pod2usage( -verbose => 1 ) },
            man => sub { pod2usage( -verbose => 2 ) } )
  or die pod2usage( -verbose => 0 );
if ( not -d $tgt ) {
    pod2usage( -verbose => 0 );
}

=head1 NAME

merge-move - Moves everything under the current location elsewhere.

=head1 SYNOPSIS

 cd /home/data/blah
 merge-move --tgt /home/data/somewhere-else

 Options:
   --tgt TARGET-DIRECTORY
   --nop
   --why

=head1 OPTIONS

=over

=item C<--tgt TARGET-DIRECTORY>

This is the place which all the stuff in the current directory will be
merged into.

=back

=cut

use autouse 'Cwd' => 'cwd';
use autouse 'File::Find' => 'find';
use autouse 'File::Spec::Functions' => qw( canonpath catfile splitpath catdir );
use autouse 'File::Path' => 'mkpath';
use autouse 'File::Copy' => 'move';
$SIG{CHLD} = 'IGNORE';

my $pwd = cwd();
my $pwd_rx = qr/\A\Q$pwd/;

my ( %dirs );
find( { wanted => sub {
            return if not -f $_;

            my $srcfile = canonpath( $File::Find::name );
            my ( undef, $srcdir, $file ) = splitpath( $srcfile );
            my $tgtdir = catdir( $tgt, $srcdir );

            if ( ! exists $dirs{$tgtdir}
                 and ! -d $tgtdir ) {
                $dirs{$tgtdir} = undef;
                if ( $why ) {
                    print "mkdir $tgtdir\n";
                }
                if ( not $nop ) {
                    mkpath $tgtdir, 0, 0775
                      or die "Can't create $tgtdir: $!";
                }
            }

            my $tgtfile = catfile( $tgtdir, $file );

            if ( -e $tgtfile ) {
                die "Couldn't move $srcfile: $tgtfile already exists.\n";
            }
            if ( $why ) {
                print "mv $srcfile $tgtfile\n";
            }
            if ( not $nop ) {
                move $srcfile, $tgtfile
                  or die "Couldn't move $srcfile to $tgtfile: $!";
            }
        },
        no_chdir => 1 },
      '.' );

perlmonks.org content © perlmonks.org and diotalevi

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03