Context Navigation

source: other-projects/nightly-tasks/diffcol/trunk/task.pl@ 27687

Last change on this file since 27687 was 27687, checked in by ak19, 11 years ago
Fixes for task.pl: html diffcol report failed to upload properly to puka from Win, so that it was 0 bytes in size once there, but htm worked. Not using blat by default, there's a flag to turn this on. Finally, task.pl works when run from run-gs2-diffcol.bat via envi.pl now that the correct perl (not strawberry perl) is prefixed to the PATH in the localised diffcol\environment.pl. (It was very hard to work out what was going wrong there.)
Property svn:executable set to ``*
File size: 25.1 KB

Rev	Line
[27621]	1	#!/usr/bin/perl -w
[27556]	2
[27621]	3	# This program is meant to run the nightly diffcol
	4	# It is meant to be an equivalent for the existing task bash script
	5	# But it is intended to be expanded to work for Windows and GS3
	6	# For windows, need to REMEMBER to set the correct shebangs at the top
[27556]	7
[27663]	8
	9	# TODO:
	10	# Have a caveat mode and a stable mode (as in snapshot/task.pl)
	11	#
	12	#} elsif ( $ENV{'TASK_NAME'} =~ "gs2-diffcol-(caveat\|stable)" ) {
	13	# $major_version = 2;
	14	# $prefix="2t";
	15	# $rk="tk2"; # test kit
	16	#} elsif ( $ENV{'TASK_NAME'} =~ "gs3-diffcol-(caveat\|stable)" ) {
	17	# $major_version = 3;
	18	# $prefix="3t";
	19	# $rk="tk3"; # test kit
	20
[27628]	21	package diffcoltask;
[27556]	22
[27621]	23	use Cwd;
[27628]	24	use Switch; # for switch(val) { case: ; ...}
[27621]	25	use File::Path; # for rmdir and mkdir type functions
	26	use File::Copy; # for recursive copying of folders but skipping .svn
	27	use File::Basename;
	28
[27628]	29	use strict;
	30	no strict 'subs'; # allow barewords (eg STDERR) as function arguments
[27621]	31
	32	my $isWin = ($^O =~ m/mswin/i) ? 1 : 0;
	33	my $sep = $isWin ? "\\" : "/";
	34	my $pathsep = $isWin ? ";" : ":";
	35	#my $script_ext = $isWin ? ".bat" : ".bash";
	36	my $setup_script = "setup"; # needs to become gs3-setup for GS3
[27687]	37	my $use_blat = 0; # if we ever get blat to send mail/attachments on Windows working, set this to 1
[27621]	38
	39	# TASK_HOME should be the toplevel diffcol folder
	40	$ENV{'TASK_HOME'} = getcwd unless defined $ENV{'TASK_HOME'};
[27668]	41	$ENV{'TASK_HOME'} =~ s@\/@\\@g if $isWin;
[27621]	42	## print STDERR "@@@ TASK_HOME: ".$ENV{'TASK_HOME'}."\n";
	43
	44
[27678]	45	$ENV{'BIN_DIR'} = &filename_concat($ENV{'TASK_HOME'}, "bin");
	46
	47	# we'll be using BLAT to send mail attachments on Windows
[27687]	48	my $blat = $use_blat ? &filename_concat($ENV{'BIN_DIR'}, "blat", "full", "blat.exe") : 0;
	49	if($isWin && $use_blat && ! -e $blat) {
	50	print STDERR "\n***********************************\n";
	51	print STDERR "No blat.exe found in $blat.\n";
	52	print STDERR "Blat needed to send mail with attachments on Windows.\n";
	53	print STDERR "Extract the blat zip file found in $ENV{'BIN_DIR'}\n";
	54	print STDERR "for your bit architecture and name the folder 'blat'\n";
	55	print STDERR "***********************************\n\n";
[27678]	56	$blat = 0;
	57	}
	58
	59
[27668]	60	$ENV{'DATA_DIR'} = &filename_concat($ENV{'TASK_HOME'}, "diffcol-data");
	61	$ENV{'UPLOAD_DIR'} = &filename_concat($ENV{'TASK_HOME'}, "diffcol-reports");
[27621]	62	$ENV{'MONITOR_EMAIL'} = "greenstone_team\@cs.waikato.ac.nz"; # need to escape @ sign
[27678]	63	$ENV{'GSDL_SMTP'} = ""; #"smtp.gmail.com";
[27621]	64	##print STDERR "@@@ email: ".$ENV{'MONITOR_EMAIL'}."\n";
	65
	66	# control if an existing compiled greenstone is used
	67	# or, if one should be checked out, which revision to checkout from svn
	68	$ENV{'SVN_OPT_REV'} = "-r head";
[27656]	69	#$ENV{'GSDLHOME'}=
	70	#$ENV{'GSDL3SRCHOME'}=
[27621]	71
[27628]	72
[27677]	73	# if the first arg is a digit, it's the new envi verbosity param. Take it off the array
	74	my $envi_verbose = shift(@ARGV) if(exists $ARGV[0] && $ARGV[0] =~ m/^\d+$/);
[27628]	75
	76	#parse arguments
	77	my $action = "all";
	78	if(scalar(@ARGV) > 1) {
	79	&printusage();
	80	exit 0;
	81	}
	82
	83	if(scalar(@ARGV) == 0) {
	84	$action="all";
	85	}
	86	else {
	87	switch ($ARGV[0]) {
	88	case qr/^(-h\|-help\|help)$/i { &printusage; exit 0; }
	89	case qr/^(setup_greenstone\|run_test\|summarise\|upload\|all)$/ { $action=$ARGV[0]; }
	90	else {
	91	print STDERR "Bad subcommand.\n";
	92	&printusage;
	93	exit -1;
	94	}
	95	}
	96	}
	97
[27621]	98	#check key environment vars are set
	99	if(!defined $ENV{'UPLOAD_DIR'}) {
[27629]	100	print STDERR "Please set a UPLOAD_DIR for the test in an environment.sh file\n";
[27621]	101	#return 1;
	102	}
	103	if(!defined $ENV{'DATA_DIR'}) {
[27629]	104	print STDERR "Please set a DATA_DIR for the test in an environment.sh file\n";
[27621]	105	#return 1;
	106	}
	107	if(!defined $ENV{'MONITOR_EMAIL'}) {
[27629]	108	print STDERR "Please set a MONITOR_EMAIL for the test in an environment.sh file\n";
[27621]	109	#return 1;
	110	}
	111
	112	if($ENV{'DATA_DIR'} eq "/") {
[27629]	113	print STDERR "DATA_DIR should not be the fs root\n";
[27621]	114	#return 1;
	115	}
	116
[27629]	117	print STDERR "DATA_DIR: ".$ENV{'DATA_DIR'}."\n";
	118	print STDERR "UPLOAD_DIR: ".$ENV{'UPLOAD_DIR'}."\n";
[27621]	119
	120	#create an id for this test
	121	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	122	$year += 1900;
	123	$mon += 1;
	124	$mon = "0$mon" if ($mon < 10);
	125	$mday = "0$mday" if ($mday < 10);
	126	my $dateid="$year-$mon-$mday"; #my $dateid=($year+1900)."-".($mon+1)."-$mday";
	127
[27629]	128	print STDERR "Starting test '$dateid'\n";
[27621]	129
	130
	131	# http://stackoverflow.com/questions/2149368/how-can-i-loop-through-files-in-a-directory-in-perl
	132	$ENV{'CLASSPATH'} = "";
	133	my $jar_lib_path = $ENV{'TASK_HOME'}.$sep."lib";
	134	my @files = <$jar_lib_path/.jar>; # /full/path/to/diffcol/lib/jar
[27628]	135	foreach my $file (@files) {
[27668]	136	$file =~ s@\/@\\@g if $isWin;
[27621]	137	$ENV{'CLASSPATH'}=$file.$pathsep.$ENV{'CLASSPATH'};
	138	}
	139	##print STDERR "**** classpath: ".$ENV{'CLASSPATH'}."\n";
	140
	141
	142	#set the location of the full report
	143	my $xmlout=filename_concat($ENV{'DATA_DIR'}, "full-report-$dateid.xml");
	144	##print STDERR "XML: $xmlout\n";
	145
	146	# the toplevel folder of the greenstone installation being used
	147	my $greenstone_home="";
	148	# gsdl is the checkout folder and can be greenstone2 or greenstone3
	149	my $gsdl="greenstone2";
	150
	151
	152	# Check if using existing compiled-up greenstone installation
	153	# and set the greenstone_home location accordingly
	154
	155	if(defined $ENV{'GSDL3SRCHOME'} \|\| defined $ENV{'GSDLHOME'}) {
[27629]	156	print STDERR "Found existing Greenstone home, will use that instead\n";
[27621]	157	$greenstone_home=$ENV{'GSDLHOME'};
	158	} else {
	159	$greenstone_home=filename_concat($ENV{'DATA_DIR'}, $gsdl);
	160	}
	161	##print STDERR "GSHOME: $greenstone_home\n";
	162
[27628]	163	#do the requested action
	164	if($action eq "setup_greenstone") {
	165	&setup_greenstone;
	166	}
	167	elsif ($action eq "run_test") {
	168	&run_test;
	169	}
	170	elsif ($action eq "summarise") {
	171	&summarise;
	172	}
	173	elsif ($action eq "upload") {
	174	&upload;
	175	&mail_with_report_attached;
	176	}
	177	elsif ($action eq "all") {
	178	&setup_greenstone;
	179	&run_test;
	180	&summarise;
	181	&upload;
	182	&mail_with_report_attached;
	183	}
[27621]	184
	185	##********************************
	186
[27628]	187	sub printusage
	188	{
	189	print STDERR "Run as: $0 (help\|setup_greenstone\|run_test\|summarise\|upload\|all)\n";
	190	}
[27621]	191
	192	#http://stackoverflow.com/questions/7427262/read-a-file-and-save-it-in-variable-using-shell-script
	193
	194	sub setup_greenstone
	195	{
	196	#clean up from previous tests
[27628]	197	print STDERR "about to clean up any old tests (Ctrl-C to cancel)"; # no newline
[27621]	198	for my $i ( 1..5 ) {
	199	sleep 1; # 1 second
[27628]	200	print STDERR ".";
[27621]	201	}
[27628]	202	print STDERR "\n";
[27621]	203
	204	# http://perldoc.perl.org/File/Path.html
[27629]	205	print STDERR "cleaning up previous tests\n";
[27621]	206	&File::Path::remove_tree($ENV{'DATA_DIR'});
	207
[27629]	208	print STDERR "creating the data dir\n";
[27621]	209	&File::Path::make_path($ENV{'DATA_DIR'}); # works like mkdir -p
	210
	211	chdir($ENV{'DATA_DIR'});
	212
	213	# use existing compiled-up greenstone installation, if a GSDLHOME set
	214	if(defined $ENV{'GSDL3SRCHOME'} \|\| defined $ENV{'GSDLHOME'}) {
[27629]	215	print STDERR "Found existing Greenstone home, will use that instead";
[27621]	216	return;
	217	}
	218
	219	# Else checkout a GS from svn into DATA_DIR
	220
	221	#svn checkout of main gsdl directory
[27629]	222	print STDERR "checkout $gsdl:\n";
[27621]	223	my $cmd = "svn co ".$ENV{'SVN_OPT_REV'}." http://svn.greenstone.org/main/trunk/greenstone2 $gsdl";
	224	##print STDERR "Checkout CMD: $cmd\n";
	225
	226	# # unlike backticks operator, system() will print the output of the command to the screen as it executes
	227	# http://stackoverflow.com/questions/758611/how-to-flush-output-in-backticks-in-perl?rq=1
	228	my $status = system "$cmd"; #my $status = `$cmd`;
[27668]	229	if($status != 0) {
	230	print STDERR "@@@ SVN checkout of $gsdl failed\n";
	231	exit -1;
	232	}
[27629]	233	print STDERR "done\n";
[27621]	234
	235	##print STDERR "$ENV{'DATA_DIR'}$sep$gsdl\n";
	236
	237	chdir("$ENV{'DATA_DIR'}$sep$gsdl");
	238
	239	##print STDERR "@@@ OS: $^O.\|".$Config{'archname64'}."\|\n";
	240
[27668]	241
	242	if($isWin) {
	243	print STDERR "Compiling $gsdl using makegs2.bat running in auto (silent) mode\n";
	244
	245	# we're now in the GS2 folder, call makegs2 with silent param
	246	$cmd = "makegs2.bat silent 2>> $ENV{'DATA_DIR'}/compilation-errors"; # STDERR is sent to compilation-errors file
	247	$status = system $cmd;
	248
	249	} else { # if we're on linux/darwin, need gnome-lib for the correct architecture.
	250
[27629]	251	print STDERR "setting up gnome-lib-minimal for compilation\n";
[27621]	252
	253	# To get gnome-lib, need to determine bit architecture of the linux/darwin
	254	# http://stackoverflow.com/questions/8963400/the-correct-way-to-read-a-data-file-into-an-array
	255	# $Config{'archname64'} doesn't work on the Ubuntu and the Sys::Info package seems to not be supported
	256	# well on ActivePerl.
	257	# But since we know we're on a Linux/Darwin machine at this point, wecan just run `uname -m` and other linux cmds
	258
	259	my $gnome_lib_file = ($^O =~ m/macos/i) ? "darwin-intel" : "linux"; # assuming all darwin is intel, not ppc!!
	260
	261	my $bit_arch=`uname -m`;
	262	$gnome_lib_file .= "-x64" if($bit_arch =~ m/64$/);
	263
	264	#svn checkout gnome-lib for this linux/darwin
	265	chdir("$ENV{'DATA_DIR'}$sep$gsdl$sep"."ext"); #cd $DATA_DIR/$gsdl/ext
	266
	267	##print STDERR "**** gnomelib: $gnome_lib_file\n";
	268
	269	# checkout and unpack gnome-lib-minimal
	270
	271	#svn export http://svn.greenstone.org/gs2-extensions/gnome-lib/trunk/gnome-lib-minimal-linux-x64.tar.gz gl.tar.gz
	272	$cmd = "svn export http://svn.greenstone.org/gs2-extensions/gnome-lib/trunk/gnome-lib-minimal-".$gnome_lib_file.".tar.gz gl.tar.gz";
	273	system $cmd;
	274	system ("tar -xvzf gl.tar.gz");
	275
	276	chdir("gnome-lib-minimal");
	277	##print STDERR "*** ARCH: $bit_arch\n";
	278
	279	# need to run source devel.bash on gnome-lib followed by configure, make, make install
	280	# in one go, in order to preserve the compile environment set up by sourcing devel.bash
	281
	282	# http://stackoverflow.com/questions/7369145/activating-a-virtualenv-using-a-shell-script-doesnt-seem-to-work
	283	# http://ubuntuforums.org/showthread.php?t=1932504 linking /bin/sh to bash instead of dash
	284
	285	# $cmd = "bash -c \"source ./devel.bash && cd ../.. && ./configure --enable-apache-httpd && make && make install\"";
	286	$cmd = "bash -c \"";
	287
	288	$cmd .= "source ./devel.bash";
	289	$cmd .= " && cd ../..";
	290
	291	#configure
	292	# $cmd .= " && ./configure";
	293	$cmd .= " && echo 'configure $gsdl: ' ";
	294	$cmd .= " && echo '<configure>' >> $xmlout";
	295	$cmd .= " && ./configure 2>> $ENV{'DATA_DIR'}/compilation-errors"; # configure
	296	$cmd .= " && echo '</configure>' >> $xmlout";
	297	$cmd .= " && echo 'done'";
	298
	299	#make
	300	$cmd .= " && echo 'make $gsdl: '";
	301	$cmd .= " && echo '<make>' >> $xmlout";
	302	$cmd .= " && make 2>> $ENV{'DATA_DIR'}/compilation-errors"; # make
	303	$cmd .= " && echo '</make>' >> $xmlout";
	304	$cmd .= " && echo 'done'";
	305
	306	#make install
	307	$cmd .= " && echo 'make install $gsdl: '";
	308	$cmd .= " && echo '<make-install>' >> $xmlout";
	309	$cmd .= " && make install 2>> $ENV{'DATA_DIR'}/compilation-errors"; # make install
	310	$cmd .= " && echo '</make-install>' >> $xmlout";
	311	$cmd .= " && echo 'done'";
	312
	313	$cmd .= "\""; # close off cmd to bash and run it
[27668]	314	$status = system $cmd;
[27621]	315	}
[27668]	316
	317	if($status != 0) {
	318	print STDERR "@@@ Compile failed\n";
	319	exit -1;
	320	}
	321
[27621]	322	# set the path to the greenstone_home variable
	323	$greenstone_home="$ENV{'DATA_DIR'}$sep$gsdl";
	324
	325	}
	326
	327	# http://stackoverflow.com/questions/3377879/how-do-i-receive-command-output-immediately
	328	sub run_test
	329	{
[27668]	330	open (my $xml_fh, '>'.$xmlout) \|\| die "Could not open xml file $xmlout for appending: $!\n";
[27621]	331
	332	# perform the requested subcommands, outputting xml information
	333	print $xml_fh "<test time=\"$dateid\" id=\"$dateid\">\n";
	334
	335	# make sure that diffcol/model-collect is up to date before copying it over to greenstone-home
	336	print $xml_fh "Updating $ENV{'TASK_HOME'}/model-collect:\n";
	337	my $cmd = "svn up $ENV{'TASK_HOME'}/model-collect"; #chdir("$ENV{'TASK_HOME'}/model-collect");
	338	my $status = system "$cmd";
	339
	340	# go to whichever greenstone_home we're using
	341	chdir($greenstone_home);
	342
	343	# get svn info
[27629]	344	print STDERR "getting svn info: $xmlout\n";
[27621]	345	print $xml_fh "<svn-info>\n";
[27668]	346	&run_and_print_cmd("svn info", $xml_fh);
[27621]	347	print $xml_fh "</svn-info>\n";
[27629]	348	print STDERR "done\n";
[27621]	349
	350	#make two copies of the model-collect directory in gsdl
	351	#one to be rebuilt and one as the basis for comparison
	352	#strip both of all .svn directories
	353
	354	#copy the model collections to the collect folder to be rebuilt
[27629]	355	print STDERR "installing test collections and model collections to new $gsdl installation... ";
[27621]	356
	357	#clean up
	358	if(-d "collect") {
	359	&File::Path::remove_tree("collect") \|\| die "Error could not delete collect: $!";
	360	}
	361	&File::Path::remove_tree("model-collect");
	362
	363	#copy to collect and strip .svn subfolders
	364	&File::Path::make_path("collect"); # create the folder and copy contents across
	365	&copy_recursively(&filename_concat("$ENV{'TASK_HOME'}","model-collect"), "collect", ".svn");
	366
	367	#make the model copy
	368	&File::Path::make_path("model-collect");
	369	&copy_recursively("collect", "model-collect"); # copy contents across
	370
[27629]	371	print STDERR "done\n";
[27621]	372
	373
	374	#for each collection, import, build and diff with its model counterpart
	375	opendir my($collect_handle), "collect" or die "Could not open dir $greenstone_home/collect: $!";
	376	for my $collection (readdir $collect_handle) {
	377	next if ($collection eq "." \|\| $collection eq "..");
[27630]	378	##next if ($collection ne "Small-HTML"); ## TEMPORARY, FOR TESTING THIS SCRIPT
[27621]	379
	380	#escape the filename (in case of space)
	381	$collection =~ s@ @\\ @g;
	382	#getting just the basename of the collection would have been necessary had we not cd-ed into $gsdl
	383
	384	print STDERR "*** Found collection $collection\n";
	385	print $xml_fh "<collection-test name=\"$collection\">\n";
	386
	387	#import
	388	# Ensure the OIDtype for importing is hash_on_full_filename
	389	# "to make document identifiers more stable across upgrades of the software,
	390	# although it means that duplicate documents contained in the collection are
	391	# no longer detected automatically."
[27629]	392	print STDERR "$collection - Importing:\n";
[27621]	393	print $xml_fh "<import>\n";
[27687]	394	&run_build_script("import.pl $collection -removeold"); #-OIDtype hash_on_full_filename
[27621]	395	print $xml_fh "</import>\n";
[27629]	396	print STDERR "done\n";
[27621]	397
	398	#build
[27629]	399	print STDERR "$collection - Building:\n";
[27621]	400	print $xml_fh "<build>\n";
[27629]	401	&run_build_script("buildcol.pl $collection -removeold");
[27621]	402	print $xml_fh "</build>\n";
[27629]	403	print STDERR "done\n";
[27621]	404
	405	#rename the intermediate 'building' directory 'index'
[27629]	406	print STDERR "$collection - Move \"building\" to \"index\"... ";
[27621]	407	my $index = &filename_concat("collect", $collection, "index");
	408	my $building = &filename_concat("collect", $collection, "building");
	409	&File::Path::remove_tree($index);
	410	# Renaming Directories, http://www.perlmonks.org/?node_id=177421
	411	move($building, $index) or die "copy failed: $!"; # File::Copy::move
[27629]	412	print STDERR "done\n";
[27621]	413
	414	#diffcol
[27629]	415	print STDERR "$collection - Diffing:\n";
[27621]	416	my $diffcol_dir = &filename_concat($ENV{'TASK_HOME'},"diffcol");
[27667]	417	$cmd = "diffcol.pl -output xml -verbosity 10 $collection"; # need to run with ./diffcol.pl if bash script
[27621]	418	&run_diff_script($cmd, $xml_fh, $diffcol_dir);
	419
	420	chdir($greenstone_home); # this is actually where we are
[27629]	421	print STDERR "done\n";
[27621]	422	print $xml_fh "</collection-test>\n";
	423	}
	424	closedir $collect_handle; # close handle to collect dir
	425
	426	print $xml_fh "</test>\n";
	427	close($xml_fh);
	428
[27629]	429	print STDERR "done\n";
[27621]	430	}
	431
	432	##***************************************************************
	433	# runs setup in greenstone_home before running the diff command
	434	sub run_diff_script {
	435	my ($cmd, $fh, $diffcol_dir) = @_;
	436
	437	# we're in greenstone_home now
	438	if(!$isWin) {
[27667]	439	$cmd = "bash -c \"export GSDLHOME=&& source $setup_script.bash && cd $diffcol_dir && ./$cmd\"";
[27621]	440
	441	} else { # Need to prefix cmd -c/-k as necessary
[27668]	442	$cmd = "cmd /c \"set GSDLHOME=&& $setup_script.bat && cd $diffcol_dir && perl -S $cmd\"";
	443	## print STDERR "@@@@ Going to call command: $cmd\n";
[27621]	444	}
	445
	446	return &run_and_print_cmd($cmd, $fh);
	447	}
	448
	449	# runs setup in greenstone_home before running the given build command
	450	sub run_build_script {
	451	my ($cmd, $fh) = @_;
	452
	453	# chdir($greenstone_home);
[27687]	454	# we are in $greenstone_home already, can directly run the build cmd on the collection
[27621]	455	if(!$isWin) {
	456	$cmd = "bash -c \"export GSDLHOME=&& source $setup_script.bash && $cmd\"";
	457
	458	} else { # Need to prefix cmd -c/-k as necessary
[27668]	459	$cmd = "cmd /c \"set GSDLHOME=&& $setup_script.bat && perl -S $cmd\"";
[27621]	460	}
[27687]	461	## print STDERR "@@@@ Going to call command: $cmd\n";
[27621]	462
[27668]	463	return system($cmd);
[27629]	464	#return &run_and_print_cmd($cmd, $fh); # doesn't work on cmds chained with bash -c
[27621]	465	}
	466
	467
	468	# http://stackoverflow.com/questions/758611/how-to-flush-output-in-backticks-in-perl?rq=1activeperl%20sys::info
	469	# http://stackoverflow.com/questions/1477500/how-do-i-get-the-output-of-an-external-command-in-perl
	470	sub run_and_print_cmd {
	471	my ($cmd, $fh) = @_;
	472
	473	open my $pin, "$cmd\|" or die "unable to run cmd $cmd: $!"; # open(my $fh, '-\|', 'powercfg -l') or die $!;
	474
	475	if(defined $fh) { # print cmd output both to the filehandle and to stdout
	476	while (my $line = <$pin>) {
	477	print $fh $line;
	478	# print STDOUT $line; # if also printing cmd output to STDOUT
	479	}
	480	}
	481	else { # no filehandle, so just need to print to stdout
	482
	483	# unlike backticks operator, system() will print the output of the command to the screen as it executes
	484	# http://stackoverflow.com/questions/758611/how-to-flush-output-in-backticks-in-perl?rq=1
	485
	486	my $status = system $cmd;
	487	if($status != 0) {
	488	print STDERR "ERROR ($status) running $cmd: $!\n";
	489	}
	490	}
	491	close($pin);
	492	}
	493
	494	sub filename_concat {
	495	my $first_file = shift(@_);
	496	my (@filenames) = @_;
	497
	498	# If first_file is not null or empty, then add it back into the list
	499	if (defined $first_file && $first_file =~ /\S/)
	500	{
	501	unshift(@filenames, $first_file);
	502	}
	503
	504	my $filename = join($sep, @filenames);
	505	$filename =~ s/[\\\/]$//; # remove trailing slashes if any
	506	return $filename;
	507	}
	508
	509
	510	# The following code is from
	511	# http://stackoverflow.com/questions/227613/how-can-i-copy-a-directory-recursively-and-filter-filenames-in-perl
	512	# It also states that "Perl's File::Copy is a bit broken (it doesn't copy permissions on Unix systems, for example)"
	513	sub copy_recursively {
	514	my ($from_dir, $to_dir, $regex) = @_;
	515	opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
	516
	517	# if(-d !$to_dir) {
	518	# mkdir $to_dir or die "mkdir '$to_dir' failed: $!" if not -e $to_dir;
	519	# }
	520
	521	for my $entry (readdir $dh) {
	522	next if ($entry eq "." \|\| $entry eq "..");
	523	next if (defined $regex && $entry =~ /$regex/);
	524	my $source = "$from_dir/$entry";
	525	my $destination = "$to_dir/$entry";
	526	if (-d $source) {
	527	mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
	528	copy_recursively($source, $destination, $regex);
	529	} else {
	530	copy($source, $destination) or die "copy failed: $!";
	531	}
	532	}
	533	closedir $dh;
	534	return;
	535	}
	536
	537	sub summarise {
	538
	539	# make a summarised Xml report
[27629]	540	print STDERR "Summarizing the xml report... ";
[27621]	541	my $cmd = "java org.apache.xalan.xslt.Process -IN $xmlout -XSL $ENV{'TASK_HOME'}/xsl/xml-report.xsl -OUT $ENV{'DATA_DIR'}/report-$dateid.xml";
	542	my $status = system($cmd);
[27629]	543	print STDERR "done\n";
[27621]	544
	545	# make a summarised HTMl report
[27629]	546	print STDERR "Creating an html summary report... ";
[27621]	547	$cmd = "java org.apache.xalan.xslt.Process -IN $ENV{'DATA_DIR'}/report-$dateid.xml -XSL $ENV{'TASK_HOME'}/xsl/html-report.xsl -OUT $ENV{'DATA_DIR'}/report-$dateid.html";
	548	$status = system($cmd);
[27629]	549	print STDERR "done\n";
[27621]	550	}
	551
	552	sub upload {
[27657]	553	# if the upload dir already existed, clear it of contents
	554	if (-d $ENV{'UPLOAD_DIR'}) { #else rm $UPLOAD_DIR/*
	555	# don't want to keep previous days reports
	556	# else we will have to manually clear them at some point
	557	# just generate the set of reports for this run of task.pl upload
	558	# and
	559	&File::Path::remove_tree($ENV{'UPLOAD_DIR'});
	560	}
	561	# recreate the upload directory
	562	&File::Path::make_path($ENV{'UPLOAD_DIR'});
[27621]	563
	564	# copy all .xml and .html files across to UPLOAD_DIR
	565	opendir my($dh), $ENV{'DATA_DIR'} or die "Could not open DATA_DIR: $!";
	566	for my $entry (readdir $dh) {
[27687]	567	next if ($entry !~ m/(\.xml\|\.html?)$/);
	568
	569	# copy the reports across with different names: with OS prefixed to them. And for the HTML file on Win, rename to HTM
	570	# html files uploaded from windows to nzdl are empty for no reason. Uploading as htm seems to work
	571	my $os = $^O;
	572	(my $os_entry = $entry) =~ s@\[email protected]@ if $isWin;
	573	$os_entry = $^O."-$os_entry";
	574
	575	# get the absolute path to the original files before copying them over
	576	$entry = &filename_concat($ENV{'DATA_DIR'}, $entry);
	577
	578	# copy them over with their new names
	579	## print STDERR "@@@@ copying across $entry to $ENV{'UPLOAD_DIR'} as $os_entry\n";
	580	copy($entry, "$ENV{'UPLOAD_DIR'}$sep$os_entry"); #copy($entry, "$ENV{'UPLOAD_DIR'}");
[27621]	581	}
	582	closedir $dh;
	583
[27637]	584
	585	# Upload the html file to puka
	586	#default identity dir
	587	if ( ! exists $ENV{'IDENTITY_DIR'} ) {
	588	$ENV{'IDENTITY_DIR'} = "$ENV{'HOME'}${sep}.ssh";
	589	}
	590	if (! exists $ENV{'SNAPSHOT_MODE'} ) {
	591	$ENV{'SNAPSHOT_MODE'} = "caveat";
	592	}
	593
[27678]	594	#use the correct key for uploading
[27637]	595	$ENV{'IDENTITY_FILE'} = "$ENV{'IDENTITY_DIR'}${sep}upload-" . $ENV{'SNAPSHOT_MODE'} . ($^O eq "MSWin32" ? ".ppk" : "");
	596	if(-f $ENV{'IDENTITY_FILE'}) {
[27678]	597	# if you need to touch the file on windows: http://stackoverflow.com/questions/51435/windows-version-of-the-unix-touch-command
	598
[27657]	599	# the report we want to upload is actually just report-$dateid.html
[27687]	600	my $command = "cd \"$ENV{'UPLOAD_DIR'}\" && tar -c .htm \| "; #&& cat .html \| "; # && tar -c \|
[27637]	601	$command .= ($^O eq "MSWin32" ? "plink" : "ssh");
	602	$command .= " -T -i \"$ENV{'IDENTITY_FILE'}\" nzdl\@puka.cs.waikato.ac.nz";
	603	#print "$command\n";
	604	my $status = system("$command");
	605	if($status != 0) {
[27678]	606	print STDERR "*** Failed to upload test report to nzdl $status\n";
[27637]	607	}
	608	} else {
	609	print STDERR "*** Cannot upload the test report to nzdl from this machine\n";
	610	}
	611
[27629]	612	print STDERR "Finished uploading\n";
[27621]	613	}
	614
	615	# Sending emails with perl: http://learn.perl.org/examples/email.html
	616	# Sending email attachments with perl: http://www.perlmonks.org/?node_id=19430
[27628]	617	# Sadly none of the packages are installed by default and use of MIME::Lite is discouraged
	618	sub mail_with_report_attached
	619	{
	620	# email out with report attached, if the tests failed
[27629]	621	print STDERR "Checking if successful... \n";
[27628]	622	my $cmd = "java org.apache.xalan.xslt.Process -IN $xmlout -XSL $ENV{'TASK_HOME'}/xsl/passed-or-not.xsl";
	623	#my $result = system($cmd);
	624	my $result = `$cmd`;
[27621]	625
[27629]	626	print STDERR "result: $result\n";
[27621]	627
[27628]	628	if($result ne "yes") {
	629	my $msg = "$gsdl regression test for $dateid failed";
	630	my $subject = "Regression Test Failed"; #"$gsdl regression test for $dateid failed\n";
	631	my $attach_file = &filename_concat($ENV{'DATA_DIR'}, "report-$dateid.html");
	632
[27687]	633	if($isWin) {
	634	if($use_blat && $blat && $ENV{'GSDL_SMTP'}) {
[27678]	635	# http://stackoverflow.com/questions/709635/sending-mail-from-batch-file
	636	#blat -to [email protected] -server smtp.example.com -f [email protected] -subject "subject" -body "body"
[27628]	637
[27678]	638	# need to install blat on windows
	639	$cmd = "$blat -to $ENV{'MONITOR_EMAIL'} -server $ENV{'GSDL_SMTP'} -f $ENV{'MONITOR_EMAIL'} -attach $attach_file -subject \"$subject\" -body \"$msg\"";
	640	$result = system($cmd);
	641	}
	642	else {
[27687]	643	$result = 1; # status from running mail command is 0 if success, 1 if fail
[27678]	644	print STDERR "********************************************\n";
[27687]	645	if ($use_blat) {
	646	print STDERR "Need blat and SMTP set to send mail attachment\n" ;
	647	} else {
	648	print STDERR "Not set up to send mail on Windows\n";
	649	}
[27678]	650	print STDERR "Inspect report at: $attach_file\n";
	651	print STDERR "********************************************\n";
	652	}
	653	} else { # linux
[27628]	654	my $status = system("command -v mutt > /dev/null 2>&1;"); #better way of doing "which mutt"
	655
	656	if($status != 0) { # mutt doesn't exist, can't send attachments, so send simple email
	657	$cmd="echo '$gsdl regression test for $dateid failed.' \| mail -s 'Regression Test Failed' $ENV{'MONITOR_EMAIL'}";
	658
	659	print STDERR "********************************************\n";
	660	print STDERR "No mutt installed, unable to mail attachment\n";
	661	print STDERR "Inspect report at: $attach_file\n";
	662	print STDERR "********************************************\n";
	663	} else {
	664	#$cmd = "bash -c \"echo '$gsdl regression test for $dateid failed' \| mutt -a $attach_file -s 'Regression Test Failed' -- $ENV{'MONITOR_EMAIL'}\"";
	665	$cmd = "echo '$gsdl regression test for $dateid failed' \| mutt -a $attach_file -s 'Regression Test Failed' -- $ENV{'MONITOR_EMAIL'}";
	666	}
[27678]	667
	668	# run the mail command
	669	$result = system($cmd); #&run_and_print_cmd($cmd);
[27628]	670	}
	671
[27678]	672
[27637]	673	if($result != 0) {
	674	print STDERR "*** Unable to send email: $?\n";
	675	}
	676	else {
	677	print STDERR "Sent mail with report attached.\n";
	678	}
[27628]	679	} else {
	680	print STDERR "********************************************\n";
[27629]	681	print STDERR "Tests were successful. Not sending mail.\n";
[27628]	682	print STDERR "********************************************\n";
	683	}
	684	}
	685
[27621]	686	# The old version of this program contained the following, consisting of 1 line of active code:
	687
	688	# Invoke as: sjmc@br:/research/sjm84/envi/bin$ ./envi diffcol summarise
	689	# Doing so will call this pl file and pass in "summarise" in ARGV
	690	# This pl file will in turn call the task executable in this folder
	691	# passing in "summarise" as a parameter.
	692	#system("/bin/bash -c \"../etc/tasks/diffcol/task @ARGV\"");
	693
	694	##system("/bin/bash -c \"./task @ARGV\"");
	695	##print STDERR "/bin/bash -c ../etc/tasks/diffcol/task @ARGV"
[27668]	696

Note: See TracBrowser for help on using the repository browser.

Download in other formats: