#!/usr/bin/perl -w
#  All rights reserved. 2004.
#  Z. Jerry Shi
#  Email: jerry@kateandjerry.org
#
# 07/24/2005
# 	Fix the problem of deleteing directories. 
#	The full name of the directory should have three parts:
#	dest root, path, and dir name. Path was missing so directories
#	could not be removed correctly. 

use strict;
use locale;
use POSIX();
use Cwd;
use File::Spec;
use File::Copy;
use File::Path;
use Fcntl ':mode';
use Time::Local;

use constant DT_REGULAR => 0;
use constant DT_FILE => 1;
use constant DT_NOTEXIST => 2;

# global vars
my $debug = 0; 
my $systype = CheckHostType();  # Linux = 0; Windows = 1;

my $flag_e = 0;   
my $flag_s = 0;   
my $flag_l = 0;
my $flag_i = 0;
my $flag_u = 0;
my $flag_f = 0;
my $flag_p = 0;
my $flag_d = 0;
my $flag_q = 0;
my $flag_y = 0;
my $flag_cmptime = 1;
my $flag_delete = 0;
my $flag_move = 0;
my $flag_verbose = 0;
my $flag_timeerror = 0;
my $flag_fnci = 1;
my $flag_timeacc = 0;
my @flag_timezone = (3600);
my @EXPatterns = (); 
my @EXPatternActions = (); 

my ($time_start, $time_end) = (0, 0);

my $logfile = "";

my ($sroot, $droot);
my ($stype, $dtype) = (DT_REGULAR, DT_REGULAR);

my $num_copied = 0;
my $num_deleted = 0;
my $num_bytes = 0;
my $num_byteshi = 0;
my $num_dir_deleted = 0;

goto main;

############################################################################
#  helper functions
############################################################################

sub Error($)
{ 
	print LOGFILE "$_[0]\n"; exit 12;
}

sub Warning($)
{
	print LOGFILE "$_[0]\n";
}

sub Confirm($)
{
	print STDERR $_[0];
	print STDERR " (Yes/No/All/Quit)? \n";
	while (<STDIN>)
	{
		/^y/i and return 1;
		/^n/i and return 0;
		/^a/i and return -1;
		/^q/i and exit;
	}
}

# return 1 for Windows
sub CheckHostType
{
	return 0 if (defined $ENV{SHELL});
	return 1;
}

sub MakeDir($)
{
	my $dir = shift or return;
   	print("Create directory $dir\n"), return 1 if $debug;
	return 1 if ($flag_l);
	if ($flag_p)
	{
		my $r = Confirm("Create directory $dir");
		return 0 if (!$r); 
		$flag_p = 0 if ($r < 0);
	}
   	mkpath($dir) and return 1;
   	Error("Creating directory $dir failed ($!).");
}

sub DeleteDir($)
{
	my $dir = "$droot$_[0]";
	if ($flag_y) {
		my $r = Confirm("Delete directory $dir");
		return if (! $r);
		$flag_y = 0 if ($r < 0);
	}
	$num_dir_deleted ++;
	print("[$dir/]\n"), return if ($flag_l);
	print("[$dir/]\n") if (! $flag_q);
	rmtree("$dir", 0, 1) or warn "Warning: Couldn't rmtree '$dir' $!";
}

# CopyFile(relpath, source_file_info, newfile)
sub CopyFile($$$)
{
   	my $src = "$sroot$_[0]$_[1]->[0]";
   	my $dstdir = "$droot$_[0]"; 
   	my $dstfn = "$dstdir$_[1]->[0]"; 

   	print("Copy: $src $dstfn\n"), return if $debug;
	if ($flag_p)
	{
		my $r = Confirm("Copy file $src");
		return if (!$r); 
		$flag_p = 0 if ($r < 0);
	}
	if (! $_[2] and $flag_y)
	{
		my $r = Confirm("Overwrite file $dstfn");
		return if (!$r); 
		$flag_y = 0 if ($r < 0);
	}
	$num_copied ++;
	$num_bytes += $_[1]->[3];
	if ($num_bytes > 1048576) {
		$num_byteshi += $num_bytes >> 20;
		$num_bytes &= (1 << 20) - 1;
	}
	print("$_[0]$_[1]->[0]\n"), return if ($flag_l);
	print("$_[0]$_[1]->[0]\n") if (! $flag_q);
	# syscopy should preserve attributes too
	# but it seems not working on Linux
	# needs to do something later
	File::Copy::syscopy($src, $dstfn) or
    		Error("Copying $src to $dstfn failed ($!).");
	if ($systype == 0) {
		utime $_[1]->[2], $_[1]->[2], $dstfn;
   	}
}

#The deleted file must be under $droot 
#DeleteFile(filename)
sub DeleteFile($)
{
	my $fn = "$droot$_[0]";

   	print("Delete $fn\n"), return if $debug;
	if ($flag_y) {
		my $r = Confirm("Delete file $fn");
		return if (!$r); 
		$flag_y = 0 if ($r < 0);
	}
	$num_deleted ++;
	print("[$fn]\n"), return if ($flag_l);
	print("[$fn]\n") if (! $flag_q);
        unlink $fn
    		or Warning("Removal of $fn failed. ($!)");
}

sub	AddEXPattern($$)
{
	$_ = $_[0];
	s/\\/\//g;
	$_ = quotemeta;
	s/\\\*/.*/g;
	s/\\\?/./g;
	push @EXPatterns, $_;
	push @EXPatternActions, $_[1];
	if ($debug) {
		print "EXPattern Added '$_' Actions=$_[1]\n";
	}
}

sub	LoadEXPatterns($)
{
	open EXF, $_[0] or Error("Can not open $_[0]. ($!)");
	while (<EXF>)
	{
		chomp;
		next if (/^\s*$/);
		AddEXPattern($_, 1);
	}
	close EXF;
}

# 1  : should not included
sub	CheckEXPatterns
{
    my $s = "/$_[0]";
    my $i = 0;
    foreach (@EXPatterns) {
	   print "$s matches $_\n", return $EXPatternActions[$i] if $s =~ /$_/i;
	   $i ++;
    }
    return 0;
}

# 1  : should not included
sub	CheckTimeStamp
{
	return 0 if (! $flag_d);
	return 0 if ($_[0] >= $time_start and $_[0] < $time_end);
	return 1;
}

#both $r and $p have trailing '/'
#$p could be empty ''
# the third return value indicates if this directory exists or not
# currently it is not used.
sub	GetDirContents($$$$)
{
	my ($r, $p, $type, $sscan) = @_;
	my (@files, @dirs);
	my $dir = "$r$p";

	print ("Reading directory $dir...\n") if ($debug);
	@files = ();
	@dirs = ();
	if ($type == DT_REGULAR)
	{
        	opendir DIR, $dir or return (\@files, \@dirs, 0);
		# Error("Can not open directory $dir\n$!");
        	while (my $fname = readdir DIR) {
			next if CheckEXPatterns("$p$fname");
			my ($mode, $mtime, $length) = (lstat("$dir$fname"))[2, 9, 7];
			if (!defined($mode))
			{
				print "Warning: Could not lstat '$dir$fname'($!)\n"; 
				next;
			}
			if (S_ISDIR($mode))
			{
				next if ($fname eq "." or $fname eq "..");
				push @dirs, $fname;
				print "DIR: $dir$fname\n" if $debug;
			}
			else {
				next if ($sscan and CheckTimeStamp($mtime));
				print "FILE: $dir$fname\n" if $debug;
				push @files, [$fname, lc $fname, $mtime, $length];
			}
        	}
        	closedir DIR;
		printf("%d dirs and %d files\n", $#dirs + 1, $#files + 1) 
			if ($debug);
		return (\@files, \@dirs, 1);
	}
	elsif ($type == DT_NOTEXIST)
	{
		return (\@files, \@dirs, 0);
	}
	Error("Unknown directory type. ($r, $p, $type)\n"); 
}

#compare two file stamps
sub 	CompareTime($$)
{
	my ($a, $b) = @_;
	return 1 if ($flag_cmptime == 0);
	my $d = ($a - $b);
	my $ad = $d;
	$ad = - $d if ($d < 0);
	return 0 if ($ad <= $flag_timeerror);
	foreach (@flag_timezone)
	{
		return 0 if ($ad >= $_ - $flag_timeerror and $ad <= $_ + $flag_timeerror);
	}
	return $d;
}

sub 	sync_directory($);
sub 	sync_directory($)
{
	my $path = shift @_;	#relative path

	my ($sfs, $sds, $se) = GetDirContents($sroot, $path, $stype, 1);
	my ($dfs, $dds, $de);

	if ($flag_cmptime or $flag_delete or $flag_u)
	{
		($dfs, $dds, $de) = GetDirContents($droot, $path, $dtype, 0);
	}
	else
	{ # do not need to get the contents of the destination directories
		($dfs, $dds, $de) = GetDirContents($droot, $path, DT_NOTEXIST, 0);
	}

	my @sfiles; 
	my @dfiles;
	my $dstdirokay = 0;

	$dstdirokay = 1 if (-d "$droot$path");

	if ($flag_fnci) {
		@sfiles = sort { $a->[1] cmp $b->[1] } @{$sfs};
		@dfiles = sort { $a->[1] cmp $b->[1] } @{$dfs};
	}
	else {
		@sfiles = sort { $a->[0] cmp $b->[0] } @{$sfs};
		@dfiles = sort { $a->[0] cmp $b->[0] } @{$dfs};
	}

	while ($#sfiles >= 0 or $#dfiles >= 0)
	{
		my $flag = 0; # 0: both   1: dfiles only  -1 sfiles only
		$flag = 1 if ($#sfiles < 0);
		$flag = -1 if ($#dfiles < 0);
		if (!$flag)
		{
			$flag = ($sfiles[0]->[$flag_fnci] cmp $dfiles[0]->[$flag_fnci]);
		}
		if (!$flag)
		{ # same file
			#compare time and length
			my $r = CompareTime($sfiles[0]->[2], $dfiles[0]->[2]);
			if ($r == 0) {
				Warning("$path$sfiles[0]->[0] has same stamps, but different lengthes.\n".
				         "$sfiles[0]->[3]  $dfiles[0]->[3]") 
				    if ($sfiles[0]->[3] != $dfiles[0]->[3]);
			}
			elsif ($r < 0) {
				Warning("$path$sfiles[0]->[0] is newer in the destination. \n".
					localtime($sfiles[0]->[2]). ":" . localtime($dfiles[0]->[2]));
			}
			else {
				if ($dstdirokay == 0) {
					MakeDir("$droot$path");
					$dstdirokay = 1;
				}
				CopyFile($path, $sfiles[0], 0);
			}
			shift @sfiles;
			shift @dfiles;
		}
		elsif ($flag < 0)
		{ # only source file 
			#check if only updates are allowed and 
			#copy source to destination
			if ($flag_u == 0) {
				if ($dstdirokay == 0) {
					MakeDir("$droot$path");
					$dstdirokay = 1;
				}
				CopyFile($path, $sfiles[0], 1); 
			}
			shift @sfiles;
		}
		else
		{ # only destination file
			#delete destination? 
			#The deleted file must be under $droot
			#so only $path and filename are passed into
			DeleteFile("$path$dfiles[0]->[1]") if ($flag_delete & 1);
			shift @dfiles;
		}
	}

	return if ($flag_s == 0);

	my @sdirs; 
	my @ddirs;

	if ($flag_fnci) {
		@sdirs = sort { lc $a cmp lc $b } @{$sds};
		@ddirs = sort { lc $a cmp lc $b } @{$dds};
	}
	else { # case sensitive
		@sdirs = sort @{$sds};
		@ddirs = sort @{$dds};
	}

	while ($#sdirs >= 0 or $#ddirs >= 0)
	{
		my $flag = 0;
		my $syndir = "";

		$flag = 1 if ($#sdirs < 0);
		$flag = -1  if ($#ddirs < 0);

		if (! $flag)
		{ # compare 
			if ($flag_fnci) {
				$flag = (lc $sdirs[0]) cmp (lc $ddirs[0]); 
			}
			else {
				$flag = $sdirs[0] cmp $ddirs[0]; 
			}
		}

		if (! $flag)
		{
			$syndir = shift @sdirs;
			shift @ddirs;
		}
		elsif ($flag < 0)
		{
			$syndir = shift @sdirs;
			if ($flag_e) { 
			# always make destination directories even if it is empty 
				MakeDir("$droot$path$syndir") or return;
			}
		}
		else
		{
			DeleteDir("$path$ddirs[0]") if ($flag_delete & 2);
			shift @ddirs;
			next;
		}
		sync_directory("$path$syndir/");
	}
}

sub	print_help
{
	print  	<<EOH;
All rights reserved by Z. Jerry Shi, 2003-2005.
Copy directories. Version 0.2.
Usage: dcopy [options] source [destination]

options:
   -d:m-d-y	   copy files changed on or after the specified date, or
   -d:-<time>	   copy files changed in the last <time> period. Time
                   could be 3s, 4m, 5h, 6d. This option can not be used 
		   together with --delete.
   -d-             do not check if destination files are newer. Always copy 
		   files. Can be used together with the previous option.
   -s	           recursively process subdirectories.
   -e              copy empty directory too.
   -h	           print this message.
   -i	           always create the destination root.
   -l	           list the files to be copied (no real copies).
   -p              prompt before copying each file or creating directories.
   -q              do not print the files that are copied.
   -u	           copy only files that already exist in destination.
   -y	           do not prompt to confirm if you want to overwrite/delete
                   an existing destination file. 
   -y-	           prompt to confirm if you want to overwrite/delete
                   an existing destination file or directories.
   -exclude:file   exclude files that match the patterns listed in <file>.
   -fp:pattern     exclude files that match the pattern.
   +fp:pattern     include files that match the pattern.
   --delete        delete the files and dirs that are not in the source tree.
   --deletefile    delete only the files that are not in the source tree but 
                   whose parent dir is present in the source tree
   --fnci=(on|off) do case insensitive comparison for file names.
   --log=<logfile> specify a log file.
   --debug=n	   debug flag.
   --timeerrror=n  time error that is allowed (in seconds).
	
EOH
	exit 1;
}

sub	SetTimeSpec($)
{
	$flag_d = 1;
	$_ = $_[0];
	$time_end = time if ($time_end == 0);
	if (/^(\d+)-(\d+)-(\d+)$/)
	{
		my ($m, $d, $y) = ($1, $2, $3);

		$y += 2000 if ($y < 10);
		$y += 1900 if ($y < 100);
		Error("Invalid date ($_)")
		if ($m > 12 or $m < 1 or $d > 31 or $d < 1 
			or $y > 2050 or $y < 1970);
		$time_start = timelocal(0, 0, 0, $d, $m, $y); 
	}
	elsif (/^-(\d+)(s|m|h|d)$/i)
	{
		my $n = $1;
		my $unit = lc $2;
		$n *= 60 if ($unit eq "m"); 
		$n *= 3600 if ($unit eq "h"); 
		$n *= 3600*24 if ($unit eq "d"); 
		$time_start = $time_end - $n;
	}
	else {
		Error("Invalid time specification ($_).");
	}
}

sub	get_opts
{
    while ($#ARGV >= 0) {
    	last if ($ARGV[0] !~ /^[-\/]/);
    	$_ = shift @ARGV;
	s/^\//-/;
    	last if /^--$/;
    	/^-e$/i and $flag_e = 1, next;
    	/^-s$/i and $flag_s = 1, next;
	/^-d[:=](.+)/i and SetTimeSpec($1), next;
	/^-d$/i and $flag_cmptime = 1, next; # copy updated files only 
	/^-d-$/i and $flag_cmptime = 0, next; # do not compare time stamps of two files  
    	/^-l$/i and $flag_l = 1, next;
    	/^-u$/i and $flag_u = 1, next;
    	/^-i$/i and $flag_i = 1, next;
    	/^-f$/i and $flag_f = 1, next;
    	/^-p$/i and $flag_p = 1, next;
    	/^-q$/i and $flag_q = 1, next;
    	/^-y$/i and $flag_y = 1, next;
    	/^-y-$/i and $flag_y = 0, next;
    	/^-h$/i and print_help(), next;
	/^-exclude[:=](.+)/i and LoadEXPatterns($1), next; 
	/^-fp[:=](.+)/i and AddEXPattern($1, 1), next; 
	/^\+fp[:=](.+)/i and AddEXPattern($1, 0), next; 
	/^--timeerror[:=](\d+)/i and $flag_timeerror = $1, next; 
	/^--te[:=](\d+)/i and $flag_timeerror = $1, next; 
    	/^--debug[:=](\d+)/i and $debug = $1, next;
    	/^--delete$/i and $flag_delete = 3, next;
    	/^--deletefile$/i and $flag_delete = 1, next;
    	/^--verbose$/i and $flag_verbose = 1, next;
    	/^--fnci[:=]on$/i and $flag_fnci = 1, next;
    	/^--fnci[:=]off$/i and $flag_fnci = 0, next;
    	/^--log[:=](.+)/i and $logfile = $1, next;
    	Error("Invalid option $_");
   }
   Error("Specifying a time period is not allowed when --delete is used.")
  	if ($flag_delete and $flag_d); 
}

main:

*LOGFILE = *STDERR;
get_opts();

if ($logfile ne "") {
	if (!open(LOGFILE, ">>$logfile"))
	{
		*LOGFILE = *STDERR;
		Error("Can not open log file:$logfile\n$!");
	}
}

if ($#ARGV == 0) {
	$sroot = $ARGV[0];
	$droot = ".";
}
elsif ($#ARGV == 1) {
	$sroot = $ARGV[0];
	$droot = $ARGV[1];
}
else {
	Error("Invalid number of parameters. Use -h option to see the usage."); 
}

# get the directory infomation
$_ = $sroot;
s/\\/\//g;  
$sroot = Cwd::abs_path($_); # get the absolute path
$sroot or Error("Can not find $_.");
$sroot .= "/" if ($sroot !~ m/\/$/);

Error("The destination can not be a file.") if (-f $droot);

if (! -d $droot)
{
	if ($flag_l) {
		$dtype = DT_NOTEXIST;
	}
	else {
		my $r = $flag_i ? 1 : Confirm("Create directory $droot");
		exit if ($r == 0);
		mkdir $droot or
			Error("Creating directory $droot failed ($!).");
	}
}

if ($dtype == DT_REGULAR) {
	$_ = $droot;
	s/\\/\//g;  
	$droot = Cwd::abs_path($_); # get the absolute path
	$droot or Error("Can not find $_.");
	$droot .= "/" if ($droot !~ m/\/$/);
}

if ($flag_verbose)
{
   print LOGFILE "Source root: $sroot\n";
   print LOGFILE "Destination root: $droot\n";
}

$_ = length($sroot);
$_ = length($droot) if (length($droot) < $_);
substr($sroot,0,$_) eq substr($droot,0,$_) 
	and Error("Two roots are not independent.\n");

sync_directory("");

exit 0 if ($flag_q);

Warning("============================");
Warning("$num_copied files copied.");
if ($num_byteshi > 0)
{
        Warning("$num_byteshi M and $num_bytes bytes copied.");
}
else
{
        Warning("$num_bytes bytes copied.");
}
Warning("$num_deleted files deleted.") if ($num_deleted > 0);
Warning("$num_dir_deleted directories deleted.") if ($num_dir_deleted > 0);

exit 0;
__END__

=head1 dcopy 

=head2 Usage: 

	dcopy [options] <source dir> <destination dir>

=head2 options:

	A option can start with - or /. However, - is recommended.  

=head2 theory:

	The files in the source directory will go through the following 
	check points:

	1. If the file name matches any exclusion pattern, do not copy.

	2. If -d: option is specified and the file was not last updated
	   in the specified time period, do not copy.

	3. If in files' time stamps are compared and the source file is 
	   not newer, do not copy.

	4. If the destination file does not exist and it is the update
           only mode, do not copy.	
	
	5. Copy file.

	The first two steps are done when reading source directory contents.
	If files' time stamps are not compared and it is not in update only
	mode and it is not in delete mode, the destination directory are 
	not scanned first.

	--delete and -d: can not be used together. 

=head2 common usages:

=head3 dcopy -s --delete -d- src dst
	Copy all the files in src to dst. Two directories should be the same
        after copying. Newer files under dst are lost.	

=head3 dcopy -s --delete src dst

	Copy modified files in src to dst. The files present under 
	dst but not under src are deleted. Only updated files 
	are copied. If files under dst are newer, they are
	left untouched. 

=head3 dcopy -s -d:-1d src dst
	Copy files modified in the last one day.