#!/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