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

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

Many additions to equalise the PDFBox collection metadata, since it generates an intermediate src file in the GSDLHOME/tmp directory whose path and random filename ends up in all the doc.xml and index/col.gdb files
File size: 30.2 KB
RevLine 
[21711]1#!/usr/bin/perl -w
2
3#TODO: Individual Testing
4
5###########################################################################
6#
7# test.pl -- for testing is built collection is consistent with model collection
8# A component of the Greenstone digital library software
9# from the New Zealand Digital Library Project at the
10# University of Waikato, New Zealand.
11#
12# Copyright (C) 1999 New Zealand Digital Library Project
13#
14# This program is free software; you can redistribute it and/or modify
15# it under the terms of the GNU General Public License as published by
16# the Free Software Foundation; either version 2 of the License, or
17# (at your option) any later version.
18#
19# This program is distributed in the hope that it will be useful,
20# but WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22# GNU General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with this program; if not, write to the Free Software
26# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
27#
28###########################################################################
29
30package diffcol_mk2;
31
32BEGIN {
33 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
34 die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
35 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
36 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
37}
38
39use parsargv;
40use util;
[27536]41use FileUtils;
[21711]42use logdiff;
43use cfgdiff;
44use gdbdiff;
45use diffutil;
46use Text::Diff;
[27766]47use Cwd;
[21711]48
49#--Global Variables Declaration-----------
[27536]50$gv_strModelColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/model-collect");
51$gv_strTestColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/collect");
[21711]52
53$gv_blnErrorStop = "false";
54$gv_blnErrorShow = "false";
55$gv_intVerbosity = 0;
56$gv_strMode = "Full";
[27537]57$strOutputFormat = "xml" unless defined $strOutputFormat; # global var with default
[21711]58
59%gv_IndivList = ("archives" => 0,
60 "etc" => 0,
61 "images" => 0,
62 "building" => 0,
63 "import" => 0,
64 "index" => 0,
65 "log" => 0,
66 "metadata" => 0,
67 "perllib" => 0,
68 "temp" => 0);
69#----##
70
71#--System Setup---------------------------
72sub SetMode
73{
74 my ($strModeList) = @_;
75 $strModeList =~ s/\|/ /g;
76 my @Modes = split(" ",$strModeList);
77
78 my $blnIndividual = "true";
79 my $blnInitial = "false";
80 my $blnFull = "false";
81
82
83 foreach $strEachMode (@Modes)
84 {
85 if($strEachMode eq "all")
86 {
87 $blnFull = "true";
88 $blnIndividual = "false";
89 }
90 elsif($strEachMode eq "init")
91 {
92 $blnInitial = "true";
93 $blnIndividual = "false";
94 }
95 else
96 {
97 if(defined $gv_IndivList{$strEachMode})
98 {
99 $gv_IndivList{$strEachMode} = 1;
100 }
101 else
102 {
103 die Help("Error: used undefined mode");
104 }
105 }
106 }
107
108 if($blnFull eq "true") {return "Full";}
109 elsif($blnInitial eq "true") {return "Initial";}
110 elsif($blnIndividual eq "true") {return "Individual";}
111 else {die "Error occured in function SetMode!!\n";}
112}
113#----##
114
115#--System Process-------------------------
116sub IndivTest
117{
[27730]118 my ($strModelCol,$strTestCol,$strColName) = @_;
[21711]119 my @Errors = ();
120 my $intNumberOfErrors = 0;
121 foreach $strEachFolder (keys %gv_IndivList)
122 {
123 if($gv_IndivList{$strEachFolder} == 1)
124 {
125
126 VobPrint("Start Comparing \"$strEachFolder\"\n",0);
[27536]127 my $strModelFolder = &FileUtils::filenameConcatenate($strModelCol,$strEachFolder);
128 my $strTestFolder = &FileUtils::filenameConcatenate($strTestCol,$strEachFolder);
[21711]129 $intNumberOfErrors = scalar(@Errors);
[27730]130 push(@Errors,TestEach($strModelFolder,$strTestFolder,0,$strColName));
[21711]131 $intNumberOfErrors = scalar(@Errors) - $intNumberOfErrors;
132 VobPrint("End Comparing \"$strEachFolder\"\n",0);
133 VobPrint("Difference Found: $intNumberOfErrors\n",0);
134 VobPrint ("\n",0);
135 }
136 }
137 return @Errors;
138}
139
140sub InitTest
141{
142
143 my ($strModelCol,$strTestCol,$strColName) = @_;
144 my $intLevel = 1;
145 my @Errors;
146
147 # Testing Log files
[27536]148# my $strModelLog = &FileUtils::filenameConcatenate($strModelCol,"log");
149# my $strTestLog = &FileUtils::filenameConcatenate($strTestCol,"log");
[21711]150#
151# if(-e $strModelLog && -e $strTestLog)
152# {
153# my $strLogError = logdiff::test_log($strModelLog,$strTestLog);
154# if($strLogError ne "")
155# {
156# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
157# VobPrint ("$strLogError\n",$intLevel);
158#
159# $strLogError = "$strLogError";
160# $strLogError = "Difference Found at Log Folder Testing\n".$strLogError."\n";
161# push(@Errors,$strLogError);
162# }
163# else
164# {
165# AlignPrint("Log Folder Comparison Result","Succeed",$intLevel);
166# }
167# }
168# else
169# {
170# my $strErrorColName;
171# my $strLogError;
172#
173# if(!(-e $strModelLog)){ $strErrorColName = $strErrorColName."(Model Collection)";}
174# if(!(-e $strTestLog)){ $strErrorColName = $strErrorColName."(Test Collection)";}
175#
176# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
177# $strLogError = "Difference Report: No Log Folder found in $strErrorColName";
178# VobPrint ("$strLogError\n",$intLevel);
179# $strLogError = "Difference Found at Log Folder Testing (Log folders are only created using GLI)\n".$strLogError."\n";
180#
181# push(@Errors,$strLogError);
182# }
183# VobPrint ("\n",$intLevel);
184
185 # Testing the build.cfg
[27536]186 my $strModelBcfg = &FileUtils::filenameConcatenate($strModelCol,"index","build.cfg");
187 my $strTestBcfg = &FileUtils::filenameConcatenate($strTestCol,"index","build.cfg");
[21711]188
189 if(-e $strModelBcfg && -e $strTestBcfg)
190 {
191 my $strBcfgError = cfgdiff::test_cfg($strModelBcfg,$strTestBcfg,"build.cfg");
192 if($strBcfgError ne "")
193 {
[27537]194 if( $strOutputFormat eq "xml" ) {
[21711]195 print "<build-cfg succeeded=\"no\">\n<message>";
196 } else {
197 AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
198 }
199
200 VobPrint ("$strBcfgError",$intLevel);
[27537]201 if( $strOutputFormat eq "xml" ) {
[21711]202 print "</message></build-cfg>";
203 }
204
205 $strBcfgError = "$strBcfgError";
206 $strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
207 push(@Errors,$strBcfgError);
208 }
209 else
210 {
211 if( $strOutputFormat eq "xml" ) {
212 print "<build-cfg succeeded=\"yes\"/>";
213 } else {
214 AlignPrint("Config File(build.cfg) Comparison Result","Succeed",$intLevel);
215 }
216 }
217 }
218 else
219 {
220 my $strErrorColName;
221 my $strBcfgError;
222
223 if(!(-e $strModelBcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
224 if(!(-e $strTestBcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
225
226 AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
227 $strBcfgError = "Difference Report: No Config files found in $strErrorColName";
228 VobPrint ("$strBcfgError\n",$intLevel);
229 $strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
230
231 push(@Errors,$strBcfgError);
232 }
233 VobPrint ("\n",$intLevel);
234
235 # Testing the collect.cfg
236
[27536]237 my $strModelCcfg = &FileUtils::filenameConcatenate($strModelCol,"etc","collect.cfg");
238 my $strTestCcfg = &FileUtils::filenameConcatenate($strTestCol,"etc","collect.cfg");
[21711]239
240 if(-e $strModelCcfg && -e $strTestCcfg)
241 {
242 my $strCcfgError = cfgdiff::test_cfg($strModelCcfg,$strTestCcfg,"collect.cfg");
243 if($strCcfgError ne "")
244 {
245 if( $strOutputFormat eq "xml" ) {
246 print "<collect-cfg succeeded=\"no\"><message>";
247 } else {
248 AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
249 }
250
251 VobPrint ("$strCcfgError",$intLevel);
252
253 if( $strOutputFormat eq "xml" ) {
254 print "</message></collect-cfg>";
255 }
256
257 $strCcfgError = "$strCcfgError";
258 $strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
259 push(@Errors,$strCcfgError);
260 }
261 else
262 {
263 if( $strOutputFormat eq "xml" ) {
264 print "<collect-cfg succeeded=\"yes\"/>";
265 } else {
266 AlignPrint("Config File(collect.cfg) Comparison Result","Succeed",$intLevel);
267 }
268 }
269 }
270 else
271 {
272 my $strErrorColName;
273 my $strCcfgError;
274
275 if(!(-e $strModelCcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
276 if(!(-e $strTestCcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
277
278 AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
279 $strCcfgError = "Difference Report: No Config files found in $strErrorColName";
280 VobPrint ("$strCcfgError\n",$intLevel);
281 $strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
282
283 push(@Errors,$strCcfgError);
284 }
285
286 VobPrint ("\n",$intLevel);
287
[27604]288 # Testing databases
[21711]289
[27604]290 # index
291 my $strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"index","text","$strColName.gdb");
292 my $strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"index","text","$strColName.gdb");
293 my $strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName); # returns 0 if no error
294 if($strGdbError) {
295 push(@Errors,$strGdbError);
296 }
[21711]297
[27604]298 # archives
299 $strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"archives","archiveinf-doc.gdb");
300 $strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"archives","archiveinf-doc.gdb");
301 $strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName);
302 if($strGdbError) {
303 push(@Errors,$strGdbError);
304 }
[21711]305
[27604]306 $strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"archives","archiveinf-src.gdb");
307 $strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"archives","archiveinf-src.gdb");
308 $strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName);
309 if($strGdbError) {
310 push(@Errors,$strGdbError);
311 }
[21711]312
[27604]313 VobPrint ("\n",$intLevel);
314
315 return @Errors;
316}
317
318
319# At present handles gdbm - need to expand to allow for jdbm and other db types
320sub GdbDiff
321{
322 my ($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName) = @_;
323
324 my $strGdbError = 0;
325
326 if(-e $strModelGdb && -e $strTestGdb)
327 {
328 #my $strGdbError = gdbdiff::test_gdb($strModelGdb, $strTestGdb);
329 $strGdbError = gdbdiff::test_gdb($strModelGdb, $strTestGdb,$strColName);
330 if($strGdbError ne "")
331 {
332 if( $strOutputFormat eq "xml" ) {
333 print "<database succeeded=\"no\" location=\"$strModelGdb\"><message>";
334 } else {
335 AlignPrint("Database Comparsion Result","Failed",$intLevel);
336 }
337 VobPrint ("$strGdbError\n",$intLevel);
338
339 if( $strOutputFormat eq "xml" ) {
340 print "</message></database>";
341 }
342
343 $strGdbError = "$strGdbError";
344 $strGdbError = "Difference Found at Database Comparsion\n".$strGdbError."\n";
345 #push(@Errors,$strGdbError);
[21711]346 }
[27604]347 else
348 {
349 if( $strOutputFormat eq "xml" ) {
350 print "<database succeeded=\"yes\" location=\"$strModelGdb\"/>";
351 } else {
352 AlignPrint("Database Comparsion Result","Succeed",$intLevel);
353 }
354 }
355 }
356 else
357 {
358 my $strErrorColName;
[21711]359
[27604]360 if(!(-e $strModelGdb)){ $strErrorColName = $strErrorColName."(Model Collection)";}
361 if(!(-e $strTestGdb)){ $strErrorColName = $strErrorColName."(Test Collection)";}
[21711]362
[27604]363 AlignPrint("Database Comparsion Result","Failed",$intLevel);
[21711]364
[27604]365 $strGdbError = "Difference Report: No Database files found in $strErrorColName";
366 VobPrint ("$strGdbError\n",$intLevel);
367
368 $strGdbError = "Difference Found at Database Comparison\n".$strGdbError."\n";
[21711]369
[27604]370 }
371
372 return $strGdbError;
[21711]373}
374
375sub FullTest
376{
377 my ($strModelCol,$strTestCol,$strColName) = @_;
378 my @Errors = ();
379 my $intLevel = 0;
380 my $intNumberDiffs = 0;
381
382 # <Initial Test>
383 if( $strOutputFormat eq "xml" ) {
384 #print "<initial-test>";
385 } else {
386 VobPrint("Initial Testing Start\n",$intLevel);
387 }
388
389 @Errors = InitTest($strModelCol,$strTestCol,$strColName);
390 $intNumberDiffs = scalar(@Errors);
391
392 if( $strOutputFormat eq "xml" ) {
393 #print "</initial-test>";
394 } else {
395 VobPrint("Initial Testing End\n",$intLevel);
396 VobPrint("Difference Found in Initial Testing: $intNumberDiffs\n",$intLevel);
397 VobPrint("\n",$intLevel);
398 }
399 # </Initial Test>
400
401 # <Detailed Test>
402 if( $strOutputFormat eq "xml" ) {
403 #print "<detailed-test>";
404 } else {
405 VobPrint("Detail Testing Start\n",$intLevel);
406 }
[27730]407 push(@Errors,TestEach($strModelCol,$strTestCol,$intLevel,$strColName));
[21711]408 $intNumberDiffs = scalar(@Errors) - $intNumberDiffs;
409
410 if( $strOutputFormat eq "xml" ) {
411 #print "</detailed-test>";
412 } else {
413 VobPrint("Detail Testing End\n",$intLevel);
414 VobPrint("Difference Found in Detail Testing: $intNumberDiffs\n",$intLevel);
415 }
416 # </Detailed Test>
417
418 return @Errors;
419}
420#----##
421
422
423#--Other System Utilities
424sub PrintUsage
425{
426 my ($strProgName) = @_;
427 if ( $strOutputFormat eq "xml" ) {
428 print "<error>usage incorrect</error>\n";
429 } else {
430 print STDERR "Usage: $strProgName test-col [more-col] [-verbosity d] [-mode modes] [-eshow] [-estop]\n";
431 }
432 Help("Error: used incorrect parameters");
433}
434
435sub Help
436{
437 my ($strError) = @_;
438 my $aryptHelps =
439 [ { 'name' => "verbosity",
440 'type' => "scale",
441 'argu' => "a integer" ,
442 'descrip' => "this parameter setup the verbosity of the testing result"},
443 { 'name' => "mode",
444 'type' => "option",
445 'argu' => "mode type \"[all|init|archives|building|etc|images|import|index|perllib|tmp]\" default to \"all\"" ,
446 'descrip' => "setup testing mode: all-full testing, init-initial testing (include configuration file test,database testing and log testing), others-for individual folder testing"},
447 { 'name' => "estop",
448 'type' => "flag",
449 'argu' => "NULL" ,
450 'descrip' => "Set then system will stop once it meet an error"},
451 { 'name' => "eshow",
452 'type' => "flag",
453 'argu' => "NULL" ,
454 'descrip' => "Set then system will show the error summary"}
455 ];
456
457
458 if ( $strOutputFormat ne "xml" ) {
459 print "$strError\n";
460
461 foreach my $hashOneArg (@{$aryptHelps})
462 {
463 print "\n----------------------------\n";
464 print "Parameters: -".$hashOneArg->{"name"}."\n";
465 print "Type: ".$hashOneArg->{"type"}."\n";
466 print "Supply Argument: ".$hashOneArg->{"argu"}."\n";
467 print "Description: ".$hashOneArg->{"descrip"}."\n";
468 print "----------------------------\n";
469 }
470 }
471}
472
473sub OutputStart
474{
475 my ($strColName) = @_;
476 my $intPadding = 17 - length($strColName);
477
478 if ( $strOutputFormat eq "xml" ) {
479 print "<diffcol>\n";
480 } else {
481 print "+---------------------------------------------------------+\n";
482 print "| |\n";
483 print "| Start Testing Collection: $strColName"," " x $intPadding,"|\n";
484 print "| |\n";
485 print "+---------------------------------------------------------+\n\n";
486 }
487}
488
489sub OutputEnd
490{
491 my ($strColName,$aryptErrors) = @_;
492 my $intPadding = 12 - length($strColName);
493 if ( $strOutputFormat eq "xml" ) {
494 print "</diffcol>\n";
495 } else {
496 print "\n";
497 print "+---------------------------------------------------------+\n";
498 print "| |\n";
499 print "| Result of Collection Testing: $strColName"," " x $intPadding,"|\n";
500 print "| |\n";
501 print "+---------------------------------------------------------+\n\n";
502 }
503
504 my $intTotalErrors = scalar(@{$aryptErrors});
505 if ( $strOutputFormat ne "xml" ) {
506 print "Checking completed, there is $intTotalErrors error(s) found.\n";
507 }
508
509 if($gv_blnErrorShow ne "off")
510 {
511 foreach my $strEachError (@{$aryptErrors})
512 {
513 if ( $strOutputFormat eq "xml" ) {
514 print "<error>";
515 print $strEachError;
516 print "</error>\n";
517 } else {
518 print "+---------------------------------------------------------+\n";
519 print "| Error |\n";
520 print "+---------------------------------------------------------+\n\n";
521 print "$strEachError\n\n";
522 }
523 }
524 }
525 else
526 {
527 if ( $strOutputFormat ne "xml" ) {
528 print "Use -eshow to show the error detail\n\n";
529 }
530 }
531}
532
533sub AlignPrint
534{
535 my ($strMainString,$strStatus,$intLevel) = @_;
536 my $intDot = 100 - length($strMainString) - length($strStatus);
537 VobPrint ($strMainString."."x$intDot."$strStatus\n",$intLevel);
538}
539
[27695]540
541# this function is only called on DocXMLFiles.
542# so far, only doc.xml files need special Windows processing (db files' OS-sensitivity are handled in gdbdiff.pm)
543# Returns true if the doc.xml contains windows style slashes in the gsdlsourcefilename meta field
544sub isDocXMLFileWindows
545{
546 my ($file_contents) = @_;
547
548 #return ($file_contents =~ m/\\/) ? 1 : 0; # windows slashes detected.
549
550 # Is this a better test? look for gsdlsourcefilename, see if it contains windows slashes.
551 # what if $gsdlsourcefilename is not guaranteed to exist in all doc.xml files?
552
553 # for doc.xml:
554 # <Metadata name="gsdlsourcefilename">import/html_files/cleves.html</Metadata>
555 if($file_contents =~ m@<Metadata name="gsdlsourcefilename">([^>]*)</Metadata>@m) {
556 $gsdlsourcefilename = $1;
557 if($gsdlsourcefilename =~ m/\\/) { # windows slashes detected.
558 return 1;
559 }
560 }
561
562 return 0;
563}
564
[21711]565sub TestEach
566{
[27730]567 my ($strModel,$strTest,$intLevel,$strColName) = @_;
[21711]568 my @Errors = ();
569
570 $intLevel++;
571 if (-d $strModel && -d $strTest)
572 {
573 my @aryInModel = &diffutil::files_in_dir($strModel);
574 my @aryInTest = &diffutil::files_in_dir($strTest);
[27695]575
576 # Files to be skipped because they get generated on one OS but not the other
577 # On windows, files of the form col.invf.state.\d\d\d\d get generated (e.g. Small-HTML.invf.state.1228) that aren't there on linux
578 my $skipfiles_re = qr/\.invf\.state\.\d+$/; # Create a regex of all files to be skipped, see http://perldoc.perl.org/perlop.html
579 @aryInModel = grep { $_ !~ m/$skipfiles_re/ } @aryInModel; # http://stackoverflow.com/questions/174292/what-is-the-best-way-to-delete-a-value-from-an-array-in-perl
580 @aryInTest = grep { $_ !~ m/$skipfiles_re/ } @aryInTest;
581
582 # Now check all remaining files in the folder exist in both model and test collections
[21711]583 my @aryTwoPointers = FolderTesting(\@aryInModel,\@aryInTest,$strModel,$strTest,$intLevel);
584 my @aryCorrectFiles = @{$aryTwoPointers[1]};
585 @Errors = @{$aryTwoPointers[0]};
586
587 if(scalar(@Errors) == 0)
588 {
589 foreach my $strEachFile (@aryInModel)
590 {
[27536]591 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
592 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
[27695]593 # now additionally ignoring the earliestDatestamp file and the index/idx/*.idh binary file when diffing file
[27743]594 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.((g|j|l|b)db|idh|i.*|wa|td|tsd|ti|t|tl|w|jpe?g|gif|png|wmf)$/g)) # wmf = windows meta file
[21711]595 {
[27730]596 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
[21711]597 }
598 else
599 {
600 if ( $strOutputFormat eq "xml" ) {
601 print "<file-comparision location=\"$strEachFile\" blocked=\"yes\" succeeded=\"yes\"/>";
602 } else {
603 VobPrint ("Blocked File Report: Test \"$strEachFile\" by using -mode \"init\"\n",$intLevel);
604 }
605 }
606 }
607 }
608 else
609 {
610 foreach my $strEachFile (@aryCorrectFiles)
611 {
[27536]612 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
613 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
[27743]614 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.((g|j|l|b)db|idh|i.*|wa|td|tsd|ti|t|tl|w|jpe?g|gif|png|wmf)$/g))
[21711]615 {
[27730]616 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
[21711]617 }
618 }
619 }
620 if($intLevel == $gv_intVerbosity)
621 {
622 if(scalar(@Errors) == 0){ AlignPrint("Contents Comparsion","Succeed",$intLevel);}
623 else { AlignPrint("Contents Comparsion","Failed",$intLevel);}
624 }
625 }
626 else
627 {
[27730]628 my $ignore_line_re = "<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate|ex.File.FileModifyDate|ex.File.FilePermissions|ImageSize)\">.*</Metadata>\\s*\\n*";
629
[27604]630 my $strResult;
631
632 # for doc.xml files, need to ignore many date fields. Filter these out before diffing,
633 # in case these don't appear in the same order between collections, since
634 # diffutil::GenerateOutput only handles the ignore_regex after a diff has been done
635 # when they can show up as unnecessary diff 'errors'
636 if($strModel =~ m/doc\.xml$/) {
637 my ($model_contents, $test_contents);
638 open(FIN,"<$strModel") or die "Unable to open $strModel...ERROR: $!\n";
639 sysread(FIN, $model_contents, -s FIN);
640 close(FIN);
641 open(FIN,"<$strTest") or die "Unable to open $strTest...ERROR: $!\n";
642 sysread(FIN, $test_contents, -s FIN);
643 close(FIN);
644
645 $model_contents =~ s/$ignore_line_re//g;
646 $test_contents =~ s/$ignore_line_re//g;
[27730]647
648
[27695]649 # equalise/normalise the two doc.xml files for OS differences, if there are any
650 my $testIsWin = &isDocXMLFileWindows($test_contents);
651 my $modelIsWin = &isDocXMLFileWindows($model_contents);
652
653 if($testIsWin != $modelIsWin) { # one of the 2 collections is built on windows, the other on linux, so need to make newlines constant
654
655 my $win_contents = $testIsWin ? \$test_contents : \$model_contents;
656
[27743]657 # remove all carriage returns \r - introduced into doc.xml by multiread after pdf converted to html
658 $$win_contents =~ s@[\r]@@g;
659
660 # make all single windows slashes into single unix slashes
661 $$win_contents =~ s@([^\\])\\([^\\])@$1\/$2@g;
662 # make windows \r newlines into constant \n newlines. Already handled when \r got replaced
663 #$$win_contents =~ s@\r\n@\n@mg; # #http://stackoverflow.com/questions/650743/in-perl-how-to-do-you-remove-m-from-a-file
[27695]664
[27725]665 #FOR MAC: old macs use CR carriage return (see http://www.perlmonks.org/?node_id=745018), so replace with \n?)
[27695]666 # $$win_contents =~ s@\r@\n@mg;
667 }
[27743]668
[27695]669
[27743]670 # tmp dirs have subdirs with random numbers in name, remove randomly named subdir portion of path
[27766]671 # these tmpdirs are located inside the collection directory
[27743]672 $model_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
673 $test_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
674
675 # remove all absolute paths upto collect folder from <Metadata /> elements
676 $model_contents =~ s@(<Metadata name=\"[^\"]*\">(http:\/\/)?).*(collect[\\\/]$strColName)@$1$3@g;
[27766]677 $test_contents =~ s@(<Metadata name=\"[^\"]*\">(http:\/\/)?).*(collect[\\\/]$strColName)@$1$3@g;
[27743]678
[27766]679 # The following block of code is necessary to deal with tmp (html) source files generated when using PDFBox
680 # These tmpdirs are located inside the toplevel *greenstone* directory
681 (my $gsdlhome_re = $ENV{'GSDLHOME'}) =~ s@\\@\/@g;
682 my $tmpfile_regex = "<Metadata name=\"URL\">http://$gsdlhome_re/tmp/([^\.]*)(\..{3,4})</Metadata>"; # $gsdlhome/tmp/randomfilename.html, file ext can be 3 or 4 chars long
683 if($test_contents =~ m@$tmpfile_regex@) {
684 # found a match, replace the tmp file name with "random", keeping the original file extension
685 # in <Metadata name="OrigSource|URL|UTF8URL|gsdlconvertedfilename">
686
687 my ($old_tmp_filename, $ext) = ($1, $2);
688 my $new_tmp_filename = "random";
689
690 $tmpfile_regex = "(<Metadata name=\"(URL|UTF8URL|gsdlconvertedfilename|OrigSource)\">(http://)?)($gsdlhome_re)?(/tmp/)?$old_tmp_filename($ext</Metadata>)";
691 if($5) {
692 $test_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
693 } else { # OrigSource contains only the filename
694 $test_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
695 }
696
697 # modelcol used a different gsdlhome, but also a tmp dir, so make the same changes to its random filename
698 $tmpfile_regex = "(<Metadata name=\"(URL|UTF8URL|gsdlconvertedfilename|OrigSource)\">(http://)?)(.*)?(/tmp/)?.*($ext</Metadata>)";
699 if($5) {
700 $model_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
701 } else { # OrigSource contains only the filename
702 $model_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
703 }
704 }
705
[27743]706# my $savepath = &getcwd."/../"; # TASK_HOME env var does not exist at this stage, but it's one level up from current directory
707# &gdbdiff::print_string_to_file($model_contents, $savepath."model_doc.xml");
708# &gdbdiff::print_string_to_file($test_contents, $savepath."test_doc.xml");
709
[27604]710 $strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
711
712 } else {
713 $strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
714 }
715
716 # The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
717 # these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
718 $strResult = &diffutil::GenerateOutput($strResult,"^\\s*<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\$");
719
[21711]720 #$strResult = GeneralOutput($strResult);
721 if ( $strOutputFormat eq "xml" ) {
722 #
723 } else {
724 VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
725 }
726 if ($strResult eq "")
727 {
728 if ( $strOutputFormat eq "xml" ) {
729 print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
730 } else {
731 AlignPrint("Comparing File","Succeed",$intLevel);
732 }
733 }
734 else
735 {
[27730]736# print STDERR "**** Diff is: $strResult\n"; # print any differences to the screen
737
[21711]738 my $strOutput = "Difference Report:\n$strResult\n";
739 if ( $strOutputFormat eq "xml" ) {
740 print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
741 } else {
742 AlignPrint("Comparing File","Failed",$intLevel);
743 }
744
[27666]745 #$result=`file -b $strModel`; # linux specific test for binary file
746 $result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
[21711]747 if ( "$result" =~ "data" ) {
748 VobPrint( "These binary files differ", $intLevel );
749 } else {
750 VobPrint ( "$strOutput" , $intLevel);
751 }
752
753
754 if ( $strOutputFormat eq "xml" ) {
755 print "</message></file-comparison>";
756 }
757
758 if($gv_blnErrorStop ne "off") { exit; }
759 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
760 }
761 }
762
763 return @Errors;
764}
765
766
767sub FolderTesting
768{
769 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
770 my %hashCount = ();
771 my @Errors = ();
772 my @CorrectFiles = ();
773 my @TwoPointers = (\@Errors,\@CorrectFiles);
774
775 if ( $strOutputFormat eq "xml" ) {
776 #print "<folder-comparison location=\"$strModelFolder\">\n";
777 } else {
778 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
779 }
780
781 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
782 foreach my $strEachItem (@$aryptTest)
783 {
784 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
785 else {$hashCount{$strEachItem} = 'T';}
786 }
787
788 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
789 {
790 if ( $strOutputFormat eq "xml" ) {
791 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
792 } else {
793 AlignPrint("Folder Comparsion","Succeed",$intLevel);
794 }
795 return @TwoPointers;
796 }
797 else
798 {
799 if ( $strOutputFormat eq "xml" ) {
800 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
801 } else {
802 AlignPrint("Folder Comparsion","Failed",$intLevel);
803 }
804
805 foreach my $strEachItem (keys %hashCount)
806 {
807 if($hashCount{$strEachItem} ne 'B')
808 {
809 my $strOutput = "";
810 my $strReport = "";
811
812 if($hashCount{$strEachItem} eq 'M')
813 {
[27539]814 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
[21711]815 $strReport = "Difference Report: difference found at $strTestFolder";
816 }
817 elsif($hashCount{$strEachItem} eq 'T')
818 {
[27539]819 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
[21711]820 $strReport = "Difference Report: difference found at $strModelFolder";
821 }
822 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
823
824 VobPrint ("$strOutput\n",$intLevel);
825 $strOutput = $strOutput."\n\t".$strReport."\n";
826 push(@Errors,$strOutput);
827 }
828 else {push(@CorrectFiles,$strEachItem);}
829 }
830 if( $strOutputFormat eq "xml" ) {
831 print "</message></folder-comparison>";
832 }
833
834 return @TwoPointers;
835 }
836}
837
838sub VobPrint
839{
840 my ($strOutput, $intLevel) = @_;
841 my $strTab = "";
842 my $intTab = int($intLevel/2);
843 if($intLevel <= $gv_intVerbosity)
844 {
845 if($intLevel >= 1)
846 {
847 $strTab = "\t"x($intTab+1);
848 $strOutput =~ s/\n$//;
849 $strOutput =~ s/\n/\n$strTab/g;
850 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
851 }
852
853 if( $strOutputFormat eq "xml" ) {
854 $strOutput =~ s/&/&amp;/g;
855 $strOutput =~ s/</&lt;/g;
856 $strOutput =~ s/>/&gt;/g;
857 }
858
859 if ( length( $strOutput ) > 1000 ) {
860 $strOutput = substr( $strOutput, 0, 978) . "... (output truncated)";
861 }
862
863
864 print $strTab.$strOutput."\n";
865 }
866}
867#----##
868
869
870#--Main System----------------------------
871#-----------------------------------------
872# Name: main
873# Perameters: arguments from command line
874# Pre-condition: testing will start by calling this main function.
875# Post-condition: output the test results for one or more collections.
876#-----------------------------------------
877sub main
878{
879 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
880 my $strProgName = $0;
881 my $intArgc = scalar(@ARGV);
882
883 #--System Arguments Setup
884 if (!parsargv::parse(\@ARGV,
885 'estop//off', \$strErrorStop,
886 'eshow//off', \$strErrorShow,
887 'verbosity/\d+/1', \$intVerbosity,
888 'mode/[\w\-]+/all', \$strMode,
889 'output/[\w\-]+/text', \$strOutputFormat
890 )) {
891 PrintUsage($strProgName);
892 die "\n";
893 }
894
895 if ($intArgc<1) {
896 PrintUsage($strProgName);
897 die "\n";
898 }
899
900 $gv_blnErrorStop = $strErrorStop;
901 $gv_blnErrorShow = $strErrorShow;
902 $gv_intVerbosity = $intVerbosity;
903 $gv_strMode = SetMode($strMode);
904
905 #----##
906
907 #--Collection(s) Testing
908 foreach $strColName (@ARGV)
909 {
910 my @ErrorsInEachCol;
[27536]911 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
912 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
[21711]913
914 #--Output(Start)
915 OutputStart($strColName);
916 #----##
917
918 if(-e $strModelCol && -e $strTestCol )
919 {
920
921 #--Individual Testing
922 if ($gv_strMode eq "Individual")
923 {
[27730]924 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol,$strColName);
[21711]925 }
926 #----##
927
928 #--Initial Testing
929 elsif ($gv_strMode eq "Initial")
930 {
931 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
932 }
933 #----##
934
935 #--Full Testing
936 elsif ($gv_strMode eq "Full")
937 {
938 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
939 }
940 #----##
941
942 #--Error Checking
943 else
944 {
945 if ( $strOutputFormat eq "xml" ) {
946 die "<error>Error occoured in main function</error>\n";
947 } else {
948 die "Error occoured in main function.\n";
949 }
950 }
951 #----##
952
953 }
954 else
955 {
956 if( $strOutputFormat eq "xml" ) {
957 die "<error>Cannot find collection: $strColName</error>\n";
958 } else {
959 die "Error: cannot find collection: $strColName\n";
960 }
961 }
962 #----##
963
964 #--Output(Results and Errors)
965 OutputEnd($strColName,\@ErrorsInEachCol);
966 #----##
967
968 }
969}
970#----##
971
972&main();
Note: See TracBrowser for help on using the repository browser.