Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Move/merge directories

by diotalevi (Canon)
on Sep 14, 2006 at 23:15 UTC ( #573031=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info
Description: This allows you to merge two identical-ish directory trees. It won't overwrite any files if there's a conflict.
#!/usr/bin/perl
use strict;
use warnings;

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

GetOptions( 
            nop     => \ my($nop),
            verbose     => \ my($verbose),
            help => sub { pod2usage( -verbose => 1 ) },
            man => sub { pod2usage( -verbose => 2 ) } )
  or die pod2usage( -verbose => 0 );
@ARGV == 2 or pod2usage( -verbose => 0 );
my ( $src, $tgt ) = @ARGV;
-d $tgt and -d $src or pod2usage( -verbose => 0 );

=head1 NAME

merge-move - Moves the contents of one directory into another by mergi
+ng files.

=head1 SYNOPSIS

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

 Options:
   --nop
   --verbose

=head1 OPTIONS

=over

=item --nop

Don't do any eral work.

=item -verbose

Show what's happening.

=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 ( $verbose ) {
                    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 ( $verbose ) {
                print "mv $srcfile $tgtfile\n";
            }
            if ( not $nop ) {
                move $srcfile, $tgtfile
                  or die "Couldn't move $srcfile to $tgtfile: $!";
            }
        },
        no_chdir => 1 },
      $src );

Comment on Move/merge directories
Download Code
Re: Move/merge directories
by RyuMaou (Deacon) on Jan 12, 2007 at 20:53 UTC
    Sounds like a great script, but when I run it on my Win2K system, I get the following error:

    Name "$File::Find::name" only used once: Possible typo

    Based on the info for the CPAN module, everything looks right, but then, I'm still pretty limited in my Perl skills.
    Suggestions?

      It's not an error, it's just a warning that I didn't force to disappear.

      ⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

        Hunh. Curiouser and curiouser.

        I assumed it was an actual error, instead of a warning, because the script then seemed to not do anything. I was sort of thinking it had something to do with the fact I was running it on a Win2K machine. I tried every variable of directory naming convention that I can think of, but got no joy with any of them.

        I suppose I could try it in Cygwin to see if I get the same results.
        I'll let you know.


        Update: I thought it synchronized the directories in either direction, but it seems to have just created the source directory in the target directory and moved the files.
        Still cool, but not quite what I was hoping for.

        Thanks.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://573031]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2014-12-27 16:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (177 votes), past polls