Context Navigation

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

Last change on this file since 27694 was 27694, checked in by ak19, 11 years ago
Fixing up previous windows commit for linux
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
[27694]	571	my $os_entry = $entry;
	572	$os_entry =~ s@\[email protected]@ if $isWin;
	573	$os_entry = $^O."-diffcol-$os_entry";
[27687]	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
[27694]	599	# the report we want to upload is actually just os-diffcol-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"
[27694]	696

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

Download in other formats: