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

Last change on this file since 27743 was 27743, checked in by ak19, 11 years ago

Basic Word-PDF collection now has the same number of diffing errors on Windows upon diffcol as on Linux and Mac. Needed to do a lot of special processing for windows: to remove carriage returns introduced into doc.xml when doing a multiread on the html version of a pdf doc after it has been converted to html. (And similarly, needed to get rid of windows carriage returns introduced into ex.Title meta for pdf01.pdf converted to HTML. This was handled in HTMLPlugin). Further special tags need either to be ignored, if they're time stamps, or specially handled if they're filepaths. Not sure if it's the encoding setting in multiread or maybe the locale that is introducing the carriage returns, but am dealing with this at the point of diffcol since it's not a 'problem' in Greenstone, just an inconsistency across OS-es. There's still one diffcol error remaining for this collection on all 3 OS: one word document has a different word wrap length on the machine where the model col was built compared to the wrap length on the other machines. This may be a setting to wvware or else libreoffice/staroffice, if these are used.

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