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 | |
by diotalevi (Canon) on Jan 12, 2007 at 21:09 UTC | |
by RyuMaou (Deacon) on Jan 12, 2007 at 21:28 UTC | |
by parv (Parson) on Jan 13, 2007 at 04:34 UTC | |
by diotalevi (Canon) on Jan 13, 2007 at 05:52 UTC |
Back to
Code Catacombs