#! perl -w
# replicates files from source directory to destination directory 


use strict;
use File::Basename;
use File::Copy;
use File::Find;
use File::Path; 


# usage
#
my $usage = <<ENDUSAGE;
replicate -s <sourcedir> -d <destdir> -e <extension [...]> [-q] [-h]
  Replicates each file in source directory and its subdirectories
  into the destination directory and its subdirectories
  if source file has one of the specified extensions
  and the destination file is older or inexistent.
  Creates the destination directory and it's subdirectories if inexistent.
  -d	must be followed by the full path name of the destination directory
  -e	must be followed by one or more space-separated extensions	
  -h	print help text and exit
  -msvc	may be given instead of -e and will copy all non-regenerable msvc files	
  -q	query (print the filenames due for replication)
  -s	must be followed by the full path name of an existing source directory
ENDUSAGE


# parse arguments
#
my ($sourcedir, $destdir, @extensions, $query);
while (@ARGV) {
	my $arg = shift;
	if ($arg eq '-s') {
		$sourcedir = shift;
	}
	elsif ($arg eq '-d') {
		$destdir = shift;
	}
	elsif ($arg eq '-e') {
		while ($ARGV[0] && $ARGV[0] !~ /^-/) {
			push @extensions, shift;	
		}
	}
	elsif ($arg eq '-msvc') {
		push @extensions, qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /;
	}
	elsif ($arg eq '-q') {
		$query = 1;
	}
	elsif ($arg eq '-h') {
		print STDERR $usage;
		exit;
	}
	else {
		errorExit("Unknown option or argument: $arg");
	}
}

if (! -d $sourcedir) {
	errorExit("Please specify an existent source directory ($sourcedir inexistent)");
}

my $extensions;
if (@extensions) {
	$extensions = join "|", @extensions;
}
else {
	errorExit("Please specify at least one extension");
}

if (! -d $destdir) {
	mkdir $destdir, 777 || die "Could not create directory $destdir";
	print STDERR "Created directory $destdir\n";
}

# change '\' to '/' (avoids trouble in substitutions)
#
$sourcedir =~ s|\\|/|g;
$destdir   =~ s|\\|/|g;
#print STDERR "$sourcedir $destdir\n";

# do it
#
find(\&copyIfNeeded, $sourcedir);
 


# subroutines
#

sub copyIfNeeded {
	if (/\.($extensions)$/i) {
		# filename has a valid extension
		my $srcsubdir = $File::Find::dir;
		(my $destsubdir = $srcsubdir) =~ s!$sourcedir!$destdir!;
#		print STDERR "$srcsubdir/$_ -> $destsubdir/$_\n" ;
		if (! -d $destsubdir) {
			if ($query) {
				print STDERR "Should create directory $destsubdir\n";
			} 
			else {
				mkpath($destsubdir, 1, 0777) || die "Could not create directory $destsubdir";
				# mkpath can create a multilevel path (unlike mkdir)
				print STDERR "Created directory $destsubdir\n";
			}
		}
		my $srcfile = "$srcsubdir/$_";
		my $destfile = "$destsubdir/$_";
		if ((!-f $destfile) || isNewer($srcfile, $destfile)) {
			if ($query) {
				print STDERR "Should copy file $srcfile to $destfile\n";
			} 
			else {
				if (-f $destfile && !-w $destfile) {
					chmod 0777, $destfile;
				}
				print STDERR "$srcfile to $destfile ...";
				if (copy($srcfile, $destfile)) {
					print STDERR " replicated\n";
				}
				else {
					warn "Could not copy file $srcfile to $destfile\n";
				}
			}
		}
        else {
			print STDERR "$destfile OK\n";
		}
	}
}

sub errorExit {
	my $msg = shift;
	print STDERR "*** $msg ***\n";
	print STDERR $usage;
	exit;
}

sub mtime {
	my $file = shift;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
           = stat($file);
	$mtime;
}

sub isNewer {
	my ($file1, $file2) = @_;
	return &mtime($file1) > &mtime($file2);
}

__END__


=head2 AUTHOR


rudif@bluemail.ch

I wrote this a long time ago, before I knew about Getopt::Long. And PerlMonks. Use it as you like. 

=cut