#!/usr/bin/perl
# Rename to unison-wrap.pl, make executable, and run

#########################################################################
######################## Unison Wrap v0.5.2 #############################
#########################################################################
######## Copyright (C) 2004 Wybo Wiersma <s.wiersma01@chello.nl> ########
#########################################################################
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#########################################################################
# Script that makes unison only report clashes (changes on 
# both sides since the last run)

# If you get out of memory errors with unison you should run 
# it with the -firstrun option enabled (make sure you supply 
# it with a -path 

use Date::Parse;

# Don't change!
$g_starttime = time();

# Set the runningfile (see the &youareabouttoeatyourowntail() sub)
@c_runningfilearr = ($ENV{'HOME'}."/.unison/running-",".current");

# No need to modify
$c_maxdepth = 2;
$c_rootpath = "";
$c_transferpath = "";
$c_firstrun = 0;
$c_verbose = 0;
$c_profile = "default";

my $runner = 0;
while (@ARGV) {
	if ($ARGV[0] =~ /-h|-help|--help/) {
		&printwhatitis();
		&printhowtouse();
		exit(0)
	}
	if ($ARGV[0] !~ /^\-.*$/) {
		$c_profile = $ARGV[0];
		shift(@ARGV);
	}
	if ($ARGV[0] =~ /-f|--firstrun/ || $c_firstrun) {
		$c_firstrun = 1;
		$c_rootpath = $ARGV[1];
		if ($c_rootpath !~ /.*\/$/) {
			$c_rootpath = $c_rootpath."/";
		}
		if ($ARGV[2] && $ARGV[2] !~ /^\-/) {
			$c_maxdepth = $ARGV[2];
			shift(@ARGV);
		}
		shift(@ARGV);
		shift(@ARGV);
	}
	if ($ARGV[0] =~ /-p|--path/) {
		$c_transferpath = $ARGV[1];
		shift(@ARGV);
		shift(@ARGV);
	}
	if ($ARGV[0] =~ /-v|--verbose/) {
		$c_verbose = 1;
		shift(@ARGV);
	}
	$runner++;
	if ($runner > 50) {
		&printhowtouse();
		exit(0)
	}
}

sub printwhatitis() {
	print "\n";
	print "### Unison-Wrap - Purpose ###\n";
	print "\n";
	print "Unison-Wrap is meanth to allow for running unison in\n";
	print "-batch mode in such a way that the only output of\n"; 
	print "Unison that remains are reports of clashes (changes on\n"; 
	print "both sides) or errors.\n";
	print "\n";
	print "Unison-Wrap can prevent out of memory crashes of\n"; 
	print "Unison on its first run if you use the -firstrun option.\n";
	print "\n";
	print "Unison-Wrap will prevent itself from running again if it\n";
	print "was already running with the same profile for the same\n";
	print "user\n";
	print "\n";
	print "NOTE: Unison-Wrap reports clashes, it does not resolve\n"; 
	print "      them. For that you will need to run unison without\n"; 
	print "      the -batch option\n";
}

sub printhowtouse() {
	print "\n";
	print "### Unison-Wrap - Usage ###\n";
	print "\n";
	print "unison-wrap.pl [<profile>] [-h] [-firstrun <theroot>\n";
	print "               [<maxdepth>]] [-path <thepath>] [-v]\n";
	print "\t <profile> sets the Unison profile to be used\n";
	print "\t -path     the path to pass to Unison as the path\n";
	print "\t           arg\n";
	print "\t -firstrun will run unison on every dir seperately\n";
	print "\t           theroot is the Unison root (a full path as\n"; 
	print "\t           of the root dir) where Unison wrap wil\n"; 
	print "\t           start building it's dir-list. Maxdepth\n"; 
	print "\t           sets the maximum walking depth (default 2)\n";
	print "\t -v        use the normal Unison verbosity level\n";
	print "\t           (usefull only for the firstrun option)\n";
	print "\t -h        print this help\n";
}

$runningfile = $c_runningfilearr[0].$c_profile.$c_runningfilearr[1];

if (&youareabouttoeatyourowntail($runningfile,$g_starttime)) {
	print "### Previous run still running: Exiting ###\n" if $c_verbose;
	exit(0);
}

if ($c_firstrun) {
	$dirlist = &gogetdirtreeindir($c_rootpath.$c_transferpath);
	for (my $i = 0; $i < @$dirlist ;$i++) { # walk the list backwards
		$dirlist->[$i] =~ s/$c_rootpath(.*)/$1/;
		&rununison($dirlist->[$i]);
	}
} elsif ($c_transferpath) {
	&rununison($c_transferpath);
} else {
	&rununison;
}

system("rm ".$runningfile);

sub rununison () {
	my($dir) = @_;
	my $input;
	my $mydir = "";
	my $myverbose = "";
	if ($dir) {
		$mydir = " -path ".$dir;
	}
	if ($c_verbose) {
		$myverbose = "| tee /dev/tty 2>&1";
	} else {
		$myverbose = "";
#		$myverbose = "| tee /dev/tty 2>&1";
	}
	print "unison $c_profile -batch$mydir 2>&1 $myverbose\n" if $c_verbose;
	$input = `unison $c_profile -batch$mydir 2>&1 $myverbose`;
	@inputarr = split("\n",$input);
	my $i = 5;
	my $firstclash = 1;
		
		# Get the clashes
	foreach $inputline (@inputarr) {
		if ($inputline =~ /<-\?->/) {
			$i = 0;
		}
		if ($inputline =~ /^([^\ ][^\ ]|)*(error|Error|exception|Fatal)/) {
			$i = 3;
		}
		if ($i < 5) {
			if ($firstclash) {
				print "The following clashes were found:\n";
				$firstclash = 0;
			}
			print $inputline."\n";
			$i++;
		}
		if ($i == 5) {
			print "\n";
			$i++;
		}
	}
}

# All below is only needed for the first run

sub gogetdirtreeindir() {
	my($dir,$depth) = @_;
	if (!$depth && $dir !~ /.*\/$/) {
		$dir = $dir."/";
	}
	my $dirsindir = &goreaddirsindir($dir);
	my @dirs;
	foreach my $dirindir (@$dirsindir) {
		if ($depth <= $c_maxdepth) {
			push (@dirs,@{&gogetdirtreeindir($dir.$dirindir."/",$depth + 1)});
		}
	}
	push (@dirs,$dir);
	return \@dirs;
}

sub goreaddirsindir() {
	my($dir) = @_;
	opendir(DIR,$dir);
	my @dirc = readdir(DIR);
	closedir(DIR);

	my @dirsindir;
	foreach my $dircontent (@dirc) {
		if (-d $dir.$dircontent  && $dircontent ne "." && $dircontent ne "..") {
			push(@dirsindir,$dircontent);
		}
	}
	return \@dirsindir;
}

	# This sub is meanth to prevent UnisonWrap from eating the tail of it's
	# own previous self (it looks if there's a pid and start-time of a
	# previous run in the running-c_profile.current file, if it finds them
	# it uses ps to check if it is still running. If it is, this sub
	# returns true, if it isn't or if none is found it writes it's own pid
	# and start time into the running-c_profile.current file). This function 
	# was copied from OtheRSync
sub youareabouttoeatyourowntail() {
	my ($runningfile,$starttime) = @_;

	open(RUNNINGFILE,$runningfile);
	my $runningline = <RUNNINGFILE>;
	close(RUNNINGFILE);
	chomp $runningline;

		# There is still a line in the runningfile: A previous process must
		# be either still running or it must have exited in an abnormal way.
	if ($runningline ne "") {
		my @pidtimearr = split(" ", $runningline);

			# Get the pids of all running othersync programs
		my $psrunningpidlist = `ps -C unison-wrap.pl -o pid=`;
		chomp $psrunningpidlist;
		my @psrunningpidarr = split("\n",$psrunningpidlist);

		my $psrunningpid;

			# Look if one of the pids is the one in the runningfile
		for ($i = 0; $i < @psrunningpidarr; $i++) {
			if ($psrunningpidarr[$i] == $pidtimearr[0]) {
				$psrunningpid = $psrunningpidarr[$i];
			}
		}

			# The pid of one of the othersync processes is the same. Now
			# look if it started at the same time as the one in the
			# runningfile (it could be that the last run crashed and that
			# the current one (or another one) has by chance received the
			# same pid).
		if ($psrunningpid) {
			my $psrunningstartstringtime = `ps -p $psrunningpid -o lstart=`;
			chomp $psrunningstartstringtime;
			my $psrunningstarttime = str2time($psrunningstartstringtime);

			if (abs($psrunningstarttime - $pidtimearr[1]) < 2) {
				# The pid is the same as the one found in the
				# runningfile, an othersync process with that pid is
				# still running and it started running at the same
				# time (a 2 sec interval) as the one in the
				# runningfile.
				return 1;
				# TODO: If you tink the tiny chance that 2 othersync-
				# runs will start within 2 secs of eachother, one of
				# them crashing, the other getting the pid of the
				# first one is worth the effort... a check for the
				# c_profile could be added to this sub.
			}
		}
	}

		# There is no tail to snatch...
	open(RUNNINGFILE,">".$runningfile);
	print RUNNINGFILE $$." ".$starttime;
	close(RUNNINGFILE);

	return 0;
}