#!/usr/bin/perl

# post-commit hook scheduler

########################################################################
# FINE PRINT:
#
# Copyright (C) 2004-2006 Eric Wilhelm (ewilhelm at cpan dot org)

# This program is copyrighted 2004-2006 by Eric Wilhelm and is
# distributed under the terms of the GNU General Public License
# (http://www.gnu.org/licenses/gpl.txt) and additional terms described
# below.
 
# This program may be reproduced and distributed in whole or in part, in
# any medium physical or electronic, as long as this copyright notice is
# retained on all copies. Commercial redistribution is allowed and
# encouraged; however, the author would like to be notified of any such
# distributions. 
#
# Please contact me with suggestions or improvements.
# 
# BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
# FOR THE PROGRAM.  THE PROGRAM IS PROVIDED "AS IS" WITHOUT WARRANTY OF
# ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
# PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME
# THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
# 
# END FINE PRINT
########################################################################

use YAML;
use warnings;
use strict;

# standard post-commit args:
my $repo = shift;
my $rev = shift;

unless($repo and defined($rev)) {
	die "usage: $0 <repository> <revision>\n";
}

# location for backups: (repository name goes at the end)
# XXX add $ENV{SVN_BACKUP_ROOT} support?
my $backup_base = "/var/backups/svn/";

my $rname = $repo;
$rname =~ s#/*$##;
$rname =~ s#^.*/##;
my $backup_loc =  $backup_base . $rname . "/";
# print "using $backup_loc\n";
(-d $backup_loc) or die "DEATH no backups location $backup_loc\n ";
my $always = $backup_loc . "always";
my $schedule = $backup_loc . "schedule";
my $log = $backup_loc . "logfile";
open(LOG, ">>$log");
if($ENV{HOME}) { # XXX is this a flawed assumption?
	print LOG "running interactively?\n";
	# maybe allow running command-line args and such at this point
}

my %setup;
my $rundir = $backup_loc . "run/";
# this will work a lot like the hook-scripts:  must be executable and in
# the $rundir
## print "getting runnables $rundir\n";
opendir(RUN, $rundir);
my @runnables = grep({($_ !~ m/\.\.?/) } readdir(RUN));
closedir(RUN);
my %try_run = map({$_ => $rundir . $_} @runnables);
foreach my $key (keys(%try_run)) {
	if((-f $try_run{$key}) and (-X $try_run{$key})) {
		$setup{$key} = $try_run{$key};
	}
}
print LOG "got setups for:\n  ", join("\n  ", keys(%setup)), "\n";



my %do;
if(-e $always) {
	print LOG "$always exists, running everything\n";
}
elsif(-e $schedule) {
	my $config = YAML::LoadFile($schedule);
	foreach my $key (keys(%setup)) {
		if(defined($config->{$key})) {
			$do{$key} = scheduler($config->{$key}, $rev);
			print LOG "do $key says ", ($do{$key} ? "yes" : "no"), "\n";
		}
	}
}
else {
	print LOG "no schedule: $schedule (rev $rev)\n";
	exit;
}

# perform scheduled actions:
print LOG "revision $rev\n";
foreach my $action (grep({$do{$_}} keys(%do))) {
	my $dest_dir = $backup_loc . $action . "/";
	my @command = ($setup{$action}, $repo, $rev, $dest_dir);
	print LOG "running $action: @command\n";
	system(@command) and print LOG "failed -- @command";
}



# open(TMP, ">/tmp/committed");
# 0 and  print TMP "have these:\n  ", 
# 	join("\n  ", map({"$_ => $ENV{$_}"} keys(%ENV))), "\n";
# 
# print TMP "called with $repo / $rev\n";
# print TMP "looking to $backup_loc\n";

exit;
########################################################################
sub scheduler {
	my ($schedule, $rev) = @_;
	my ($mod, $plus) = split(/s/, $schedule, 2);
	my $not;
	if(defined($plus)) {
		($plus, $not) = split(/\!/, $plus);
	}
	if(defined($not)) {
		scheduler($not, $rev) and return();
	}
	if($plus) {
		$rev -= $plus;
	}
	return( ! ($rev % $mod));
} # end subroutine scheduler definition
########################################################################