http://www.perlmonks.org?node_id=573031
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 );
Replies are listed 'Best First'.
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.