Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

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.
use strict;
use warnings;

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

            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.


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


=head1 OPTIONS


=item --nop

Don't do any eral work.

=item -verbose

Show what's happening.



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';

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.\
            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.

      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.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://573031]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2018-05-23 09:42 GMT
Find Nodes?
    Voting Booth?