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

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