#! /usr/bin/env perl
use Cwd;
use Getopt::Long;
use File::Basename;
use strict;
use warnings;

$ENV{PATH} = "/usr/local/bin:/usr/kerberos/bin:/usr/bin:/bin";

# Some defines for our returns
my $ALLSWELL = 0;
my $FAILEDCURLWRAPPER = 1;
my $FAILEDCURLRUNTIME = 2;
my $CHECKSUMFAILED = 3;
my $NORUNTIME = 4;
my $UNTARRUNTIME = 5;
my $UNTARJOBDATA = 6;
my $FAILEDRLIBUNTAR = 7;
my $FAILEDRUN = 8;
my $MISSINGOUTPUT = 9;
my $BADUSAGE = 10;
my $NOCHECKSUM = 11;
my $FAILEDCURLCHECKSUM = 12;

my ($help, $new, $type, $tarball, $installfrom, $cmdtorun, $unique);
GetOptions
(
	'help' => \$help,
	'new' => \$new,
	'type=s' => \$type,
	'tarball=s' => \$tarball,
	'installfrom=s' => \$installfrom,
	'cmdtorun=s' => \$cmdtorun,
	'unique=s' => \$unique,
);

if(defined $help) {
	print "Help defined\n";
	help();
	exit(0);
}

my $stampfilename = "AuditLog.$unique";

#write_audit_message("Test",(value=>"foo",url=>"this>>one",test=>5));

# new way or undocumented early way
if(defined $new) {
	# already have the args
} else {
	#  new selector information Matlab/R and version/install location R
	$type = shift @ARGV;
	$tarball = shift @ARGV;
	$installfrom = shift @ARGV;
	
	#  regular feeds to scripts
	$cmdtorun = shift @ARGV;
	$unique = shift @ARGV;
}

# test for all needed arguements prior to job args
if( !(defined $type) || !(defined $tarball) || !(defined $installfrom) || !(defined $cmdtorun) || !(defined $unique) ) {
	print "Something not defined......... t=$type t=$tarball i=$installfrom c=$cmdtorun u=$unique\n";
	if(defined $new) {
		help();
	} else {
		print "Usage: rungeneric.pl type tarball runtime_dir cmd_to_run unique_pattern all_job_args\n";
	}
	exit($BADUSAGE);
}

print "Controls: <@ARGV>\n";
print "Running: <$type $tarball $installfrom $cmdtorun $unique @ARGV>\n";
#R
my $location = getcwd();
my $Rlocation = "$location/R";
my $renviron;

my $verision = "1.4";

my $dbinstalllog =  "runR_Matlab$unique.out";
print "Trying to open logfile... $dbinstalllog\n";
#open(OLDOUT, ">&STDOUT");
#open(OLDERR, ">&STDERR");
open(STDOUT, ">>$dbinstalllog") or die "Could not open $dbinstalllog: $!";
open(STDERR, ">&STDOUT");
select(STDERR);
 $| = 1;
 select(STDOUT);
  $| = 1;

my $begintime = time();
my $endtime = time();
my $intervalstart = time();
my $intervalstop = time();

system("printenv");
print "\n\n ******** My Verison = <<<<$verision>>>> ******** \n\n";

print "Starting to run <$cmdtorun> <$unique> <@ARGV>\n";
print "Using <$type> <$tarball> <$installfrom>\n";

system("df -k");
system("pwd");


my $prebuilt = $tarball;
# fetch runtime
my $curlres = FetchViaCurl($prebuilt, "http://e089.chtc.wisc.edu/SQUID/","$unique.out");


if($curlres != 0) {
	system("rm $prebuilt");
    print "Fetch of runtime <$prebuilt> failed via curl\n";
	exit($FAILEDCURLRUNTIME);
}

# Allow for download of matching checksum if input_checksum.txt is missing
my $sha1res = 0;
if(-f "input_checksum.txt") {
	$sha1res = system("sha1sum -c input_checksum.txt");
} else {
	# rules for right checksum file is basename_input_checksum.txt
	if($tarball =~ /(.*?)\.tar\.gz/) {
		my $basename = $1;
		$basename = $basename . "_input_checksum.txt";

		$curlres = FetchViaCurl($basename, "http://e089.chtc.wisc.edu/SQUID/","$unique.out");
		if($curlres != 0) {
			system("rm $prebuilt");
    		print "Fetch of runtime <$basename> failed via curl\n";
			exit($FAILEDCURLCHECKSUM);
		}

		print "Checking runtime $tarball against checksum file $basename\n";
		$sha1res = system("sha1sum -c $basename");
	} else {
		exit($NOCHECKSUM);
	}

}

if($sha1res != 0) {
	print "sha1 checksum validation failed\n";
	exit($CHECKSUMFAILED);
}


if(!(-f "$prebuilt")) {
	print "Can not prepare local installed runtime : $prebuilt not here !\n";
	exit($NORUNTIME);
} else {
	my $tarres = 0;
	$tarres = system("tar -zxvf $prebuilt");
	system("rm $prebuilt");
	if($tarres != 0) {
		print "Detar of runtime failed.......\n";
		exit($UNTARRUNTIME);
	}
	system("chmod -R 777 .");
}

my $jobtar = "$unique.tar.gz";

# note this brings in all job related input files
# but not the shared files across jobs.
print "Tar file to extract is <$jobtar>\n";
if(-f "$jobtar") {
	print "Tar files exists. Extract....\n";
	my $jobdatares = system("tar -zxvf $unique.tar.gz");
	if($jobdatares != 0) {
		return($UNTARJOBDATA);
	}
}

# do we have dataset shared files to extract?
if(-f "sharedfiles.tar.gz") {
	print "Shared files exist. Extracting.....\n";
	system("tar -zxvf sharedfiles.tar.gz");
	print "Done extracting\n";
}

# Are we using dmtcp?
if(-f "dmtcp.tar.gz") {
	print "dmtcp files exist. Extracting.....\n";
	system("tar -zxvf dmtcp.tar.gz");
	print "Done extracting\n";
}

if($type eq "R") {
	# R needs to prepare runtime
	chdir("$installfrom");
	system("make prefix=$Rlocation install");
	chdir("$location");

	# Set up R environment
	$ENV{R_HOME} = "$Rlocation";
	$ENV{LD_LIBRARY_PATH} = "$Rlocation/lib:$ENV{LD_LIBRARY_PATH}";

	# do we have prebuilt libraries?
	if(-f "RLIBS.tar.gz") {
		my $libres = system("tar -zxvf RLIBS.tar.gz");
		if($libres != 0) {
			return($FAILEDRLIBUNTAR);
		}
		$ENV{HOME} = $location;
		$renviron = "$location/.Renviron";
		open(RLIB,">$renviron") or die "Can not create <$renviron>:$!\n";
		print RLIB "R_LIBS_USER=$location/RR/library\n";
		close(RLIB);
	}
} elsif($type eq "Matlab") {
	# adjust path to where our sandbox is......
	my @mlpaths = (
		"v711/runtime/glnxa64",
		"v711/sys/os/glnxa64",
		"v711/bin/glnxa64",
		"v711/sys/java/jre/glnxa64/jre/lib/amd64/native_threads",
		"v711/sys/java/jre/glnxa64/jre/lib/amd64/server",
		"v711/sys/java/jre/glnxa64/jre/lib/amd64",
	);

	my $realldlibrarypath = "";
	foreach my $subpath (@mlpaths) {
		if($realldlibrarypath eq "") {
			$realldlibrarypath = "$subpath";
		} else {
			$realldlibrarypath = $realldlibrarypath . ":$subpath";
		}
	}

	$ENV{HOME} = ".";

	$ENV{LD_LIBRARY_PATH} = $realldlibrarypath;
	$ENV{XAPPLRESDIR}  = "v711/X11/app-defaults";
	$ENV{DISPLAY} = ":0.0";
	$ENV{HOME} = ".";
	$ENV{MATLAB_PREF} = ".";
}

print "Running here: ";
system("hostname");
system("ls -l");

my $runthis = "";
my $line = "";
my $res = 0;

if( -f "CONTROL" ) {
	print "Execution determined by CONTROL file STARTED\n";
	open(CO,"<CONTROL") or die "Failed to open existing CONTROL file:$!\n";
	while(<CO>) {
		chomp();
		my $signaldata = 0;
		my $resultdata = 0;
		$line = $_;
		if($line =~ /^\s*?(.*?)\s+(.*)$/) {
			if($type eq "R") {
				$runthis = "$Rlocation/bin/Rscript --no-save ./$1 $2";
			} else {
				$runthis = "./$1 $2";
			}
			print "Serially execute <$runthis>\n";
			$intervalstart = time();
			$res = system("$runthis");
			$intervalstop= time();
			DropInterval($intervalstart, $intervalstop, $runthis, $res);
			if($res != 0) {
				print "Serially execution FAILED <$line>\n";
				print "Did not do the following:\n";
				while(<CO>) {
					print "$_";
				}
			}
			close(STAMP);
		} else { 
			die "Serially execution parsing FAILED <$line>\n";
		}
	}
	print "Execution determined by CONTROL DONE\n";
} else {
	if($type eq "R") {
		$runthis = "$Rlocation/bin/Rscript --no-save ./$cmdtorun @ARGV";
	} elsif($type eq "Matlab") {
		system("chmod 755 $cmdtorun");
		$runthis = "./$cmdtorun @ARGV";
	}
	print "about to execute <<$runthis>>\n";
	$intervalstart = time();
	$res = system("$runthis");
	$intervalstop= time();
	DropInterval($intervalstart, $intervalstop, $runthis, $res);
	if($res != 0) {
		print "Ececution of <$runthis> failed\n";
	}
}

# if we have sent shared files, remove them so they don't come back
# even if we failed....
if(-f "sharedfiles.tar.gz") {
    my $outputfile = "shared";
    my $line = "";
    system("tar -ztf sharedfiles.tar.gz >$outputfile");
    open(SS,"<$outputfile") or print "Failed to open list of shared files<$outputfile>:$!\n";
    while(<SS>) {
        chomp();
        my $line = $_;
        system("rm -rf $line");
    }
    close(SS);
}

$endtime = time();
DropTotal($begintime, $endtime, $type);
print "Done Running $unique $location Result was <$res>\n";
if($res != 0) {
	print "Non-zero job status so exit($FAILEDRUN)....\n";
	system("touch CODEBLOWUP");
	exit($FAILEDRUN);
}

my $here = getcwd();

print "Results are:";
system("ls -l");
exit(0);


sub DropTotal
{
	my $begin = shift;
	my $end = shift;
	my $type = shift;
	my $interval = ( $end - $begin );
	write_audit_message("RUNTIME",(type=>$type,duration=>$interval));
}

sub DropInterval
{
	my $begin = shift;
	my $end = shift;
	my $type = shift;
	my $res = shift;
	my $interval = ( $end - $begin );
	my $result = $res >>=8;
	my $signal = $res & 255;
	write_audit_message("JOBTIME",(type=>$type,duration=>$interval,signal=>$signal,result=>$result));
}

sub FetchViaCurl
{
	my $target = shift;
	my $url = shift;
	my $unique = shift;

	my $tries = 30;
	my $trycount = 0;
	my $sleeptime = 6;
	my $starttime = time();
	
	while($trycount < $tries) {
		$curlres = system("curl -H \"Prgama:\" -o $target $url$target");
		# trace data per attempt
		my $stoptime = time();
		my $elapsed = $stoptime - $starttime;
		my $fetchfile = "$url$target";
		my $result = $curlres >>=8;
		my $signal = $curlres & 255;
		write_audit_message("CURL",(url=>$fetchfile,time=>$elapsed,signal=>$signal,result=>$result));
		if($curlres != 0) {
			$trycount += 1;
			sleep($sleeptime);
		} else {
			last;
		}
	}
	print "Curl error <$curlres>\n";
	return($curlres);
}

#	I don't care strongly about the filename, but as a straw man:
#	"AuditLog.$unique"?

#	I propose the following for the records:

#	TIMESTAMP TYPE key=value key=value key=value

#	- TIMESTAMP can be anything easy to parse.
#	- TYPE is unique identified for that type of record
#	- keys and values are forbidden from having spaces in them (to
#	  simplify parsing).  We'll probably want some sort of simple
#	  escaping mechanism.  Perhaps s/\\/\\\\/g; s/_/\\_/g; s/ /_/g;
#	- Might want to sort keys within a given record.

#	so for example
#	2011-04-18 14:35 CURL duration=32 url=http://www.example.com/foo/bar result=1
#	2011-04-17 15:22 EXIT cmd=R return=0 signal=7


#	proposed API:

#	sub write_audit_message {
#	my($type, %keys) = @_;
#	# Write log here.
#	}


sub write_audit_message {
	open(STAMP,">>$stampfilename");
	my($type, %classad) = @_;
	print STAMP ( timestamp(), " $type ");
	foreach my $key (sort keys (%classad)) {
		my $filter = $classad{$key};
		$filter =~ s/>/GT/g;
		print STAMP "$key=<$filter> ";
	}
	print STAMP "\n";
	close(STAMP);
}

sub timestamp {
    return scalar localtime();
}



#	'help' => \$help,
#	'new' => \$new,
#	'type=s' => \$type,
#	'tarball=s' => \$tarball,
#	'installfrom=s' => \$installfrom,
#	'cmdtorun=s' => \$cmdtorun,
#	'unique=s' => \$unique,

sub help
{
	print "Help for runRandMatlab.pl R and Matlab Job Environment
		--new --type=Matlab --tarball=r2009b.tar.gz --installfrom=v711
		--cmdtorun=mymatlabprog --unique=1111

		end\n";
}
