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

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

2 fixes: 1. The Tudor collections' html source documents have stray carriage returns (r) that are not cleaned up by html tidy and make it into the linux doc.xml which for the rest use only linefeed chars. In contrast, the windows doc.xml was explicitly processed to convert all carriage-return-line-feed (rn) into linefeed by removing the carriage returns. So there were stray carriage returns in the linux doc.xml but these had been removed in the windows doc.xml, resulting in differences. 2. Partly truncated ampersand entities in the xml report are now completed so that things don't break when the xslt is applied during the summarise command that generates the report.
File size: 31.6 KB
Line 
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;
41use FileUtils;
42use logdiff;
43use cfgdiff;
44use gdbdiff;
45use diffutil;
46use Text::Diff;
47use Cwd;
48
49#--Global Variables Declaration-----------
50$gv_strModelColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/model-collect");
51$gv_strTestColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/collect");
52
53$gv_blnErrorStop = "false";
54$gv_blnErrorShow = "false";
55$gv_intVerbosity = 0;
56$gv_strMode = "Full";
57$strOutputFormat = "xml" unless defined $strOutputFormat; # global var with default
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{
118 my ($strModelCol,$strTestCol,$strColName) = @_;
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);
127 my $strModelFolder = &FileUtils::filenameConcatenate($strModelCol,$strEachFolder);
128 my $strTestFolder = &FileUtils::filenameConcatenate($strTestCol,$strEachFolder);
129 $intNumberOfErrors = scalar(@Errors);
130 push(@Errors,TestEach($strModelFolder,$strTestFolder,0,$strColName));
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
148# my $strModelLog = &FileUtils::filenameConcatenate($strModelCol,"log");
149# my $strTestLog = &FileUtils::filenameConcatenate($strTestCol,"log");
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
186 my $strModelBcfg = &FileUtils::filenameConcatenate($strModelCol,"index","build.cfg");
187 my $strTestBcfg = &FileUtils::filenameConcatenate($strTestCol,"index","build.cfg");
188
189 if(-e $strModelBcfg && -e $strTestBcfg)
190 {
191 my $strBcfgError = cfgdiff::test_cfg($strModelBcfg,$strTestBcfg,"build.cfg");
192 if($strBcfgError ne "")
193 {
194 if( $strOutputFormat eq "xml" ) {
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);
201 if( $strOutputFormat eq "xml" ) {
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
237 my $strModelCcfg = &FileUtils::filenameConcatenate($strModelCol,"etc","collect.cfg");
238 my $strTestCcfg = &FileUtils::filenameConcatenate($strTestCol,"etc","collect.cfg");
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
288 # Testing databases
289
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 }
297
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 }
305
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 }
312
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);
346 }
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;
359
360 if(!(-e $strModelGdb)){ $strErrorColName = $strErrorColName."(Model Collection)";}
361 if(!(-e $strTestGdb)){ $strErrorColName = $strErrorColName."(Test Collection)";}
362
363 AlignPrint("Database Comparsion Result","Failed",$intLevel);
364
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";
369
370 }
371
372 return $strGdbError;
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 }
407 push(@Errors,TestEach($strModelCol,$strTestCol,$intLevel,$strColName));
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
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
565sub TestEach
566{
567 my ($strModel,$strTest,$intLevel,$strColName) = @_;
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);
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
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 {
591 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
592 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
593 # now additionally ignoring the earliestDatestamp file and the index/idx/*.idh binary file when diffing file
594 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/collect\.bak$/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 # || $strEachFile =~ m/\~$/g to get rid of ~ files
595 {
596 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
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 {
612 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
613 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
614 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/collect\.bak$/g || $strEachFile =~ m/\.((g|j|l|b)db|idh|i.*|wa|td|tsd|ti|t|tl|w|jpe?g|gif|png|wmf)$/g)) # || $strEachFile =~ m/\~$/g to get rid of ~ files
615 {
616 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
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 {
628 my $ignore_line_re = "<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate|ex.File.FileModifyDate|ex.File.FilePermissions|ImageSize|FileSize)\">.*</Metadata>\\s*\\n*";
629
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;
647
648
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 my $lin_contents = $testIsWin ? \$model_contents : \$test_contents;
657
658 # remove all carriage returns \r - introduced into doc.xml by multiread after pdf converted to html
659 $$win_contents =~ s@[\r]@@g;
660
661 # make all single windows slashes into single unix slashes
662 $$win_contents =~ s@([^\\])\\([^\\])@$1\/$2@g;
663 # make windows \r newlines into constant \n newlines. Already handled when \r got replaced
664 #$$win_contents =~ s@\r\n@\n@mg; # #http://stackoverflow.com/questions/650743/in-perl-how-to-do-you-remove-m-from-a-file
665
666 #FOR MAC: old macs use CR carriage return (see http://www.perlmonks.org/?node_id=745018), so replace with \n?)
667 # $$win_contents =~ s@\r@\n@mg;
668
669 # remove solitary, stray carriage returns \r in the linux doc.xml, as occurs in the tudor collection owing to the source material
670 # containing solitary carriage returns instead of linefeed
671 $$lin_contents =~ s@[\r]@@g; #$$lin_contents =~ s@[\r][^\n]@@g;
672 }
673
674
675 # tmp dirs have subdirs with random numbers in name, remove randomly named subdir portion of path
676 # these tmpdirs are located inside the collection directory
677 $model_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
678 $test_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
679
680 # remove all absolute paths upto collect folder from <Metadata /> elements
681 $model_contents =~ s@(<Metadata name=\"[^\"]*\">(http:\/\/)?).*(collect[\\\/]$strColName)@$1$3@g;
682 $test_contents =~ s@(<Metadata name=\"[^\"]*\">(http:\/\/)?).*(collect[\\\/]$strColName)@$1$3@g;
683
684 # The following block of code is necessary to deal with tmp (html) source files generated when using PDFBox
685 # These tmpdirs are located inside the toplevel *greenstone* directory
686 (my $gsdlhome_re = $ENV{'GSDLHOME'}) =~ s@\\@\/@g;
687 $gsdlhome_re = ".*" unless $$ENV{'GSDLHOME'};
688 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
689 if($test_contents =~ m@$tmpfile_regex@) {
690 # found a match, replace the tmp file name with "random", keeping the original file extension
691 # in <Metadata name="OrigSource|URL|UTF8URL|gsdlconvertedfilename">
692
693 my ($old_tmp_filename, $ext) = ($1, $2);
694 my $new_tmp_filename = "random";
695
696 $tmpfile_regex = "(<Metadata name=\"(URL|UTF8URL|gsdlconvertedfilename|OrigSource)\">(http://)?)($gsdlhome_re)?(/tmp/)?$old_tmp_filename($ext</Metadata>)";
697 if($5) {
698 $test_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
699 } else { # OrigSource contains only the filename
700 $test_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
701 }
702
703 # modelcol used a different gsdlhome, but also a tmp dir, so make the same changes to its random filename
704 $tmpfile_regex = "(<Metadata name=\"(URL|UTF8URL|gsdlconvertedfilename|OrigSource)\">(http://)?)(.*)?(/tmp/)?.*($ext</Metadata>)";
705 if($5) {
706 $model_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
707 } else { # OrigSource contains only the filename
708 $model_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
709 }
710 }
711
712# my $savepath = &getcwd."/../"; # TASK_HOME env var does not exist at this stage, but it's one level up from current directory
713# &gdbdiff::print_string_to_file($model_contents, $savepath."model_doc.xml");
714# &gdbdiff::print_string_to_file($test_contents, $savepath."test_doc.xml");
715
716 $strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
717
718 } else {
719 $strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
720 }
721
722 # The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
723 # these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
724 $strResult = &diffutil::GenerateOutput($strResult,"^\\s*<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\$");
725
726 #$strResult = GeneralOutput($strResult);
727 if ( $strOutputFormat eq "xml" ) {
728 #
729 } else {
730 VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
731 }
732 if ($strResult eq "")
733 {
734 if ( $strOutputFormat eq "xml" ) {
735 print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
736 } else {
737 AlignPrint("Comparing File","Succeed",$intLevel);
738 }
739 }
740 else
741 {
742# print STDERR "**** Diff is: $strResult\n"; # print any differences to the screen
743
744 my $strOutput = "Difference Report:\n$strResult\n";
745 if ( $strOutputFormat eq "xml" ) {
746 print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
747 } else {
748 AlignPrint("Comparing File","Failed",$intLevel);
749 }
750
751 #$result=`file -b $strModel`; # linux specific test for binary file
752 $result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
753 if ( "$result" =~ "data" ) {
754 VobPrint( "These binary files differ", $intLevel );
755 } else {
756 VobPrint ( "$strOutput" , $intLevel);
757 }
758
759
760 if ( $strOutputFormat eq "xml" ) {
761 print "</message></file-comparison>";
762 }
763
764 if($gv_blnErrorStop ne "off") { exit; }
765 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
766 }
767 }
768
769 return @Errors;
770}
771
772
773sub FolderTesting
774{
775 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
776 my %hashCount = ();
777 my @Errors = ();
778 my @CorrectFiles = ();
779 my @TwoPointers = (\@Errors,\@CorrectFiles);
780
781 if ( $strOutputFormat eq "xml" ) {
782 #print "<folder-comparison location=\"$strModelFolder\">\n";
783 } else {
784 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
785 }
786
787 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
788 foreach my $strEachItem (@$aryptTest)
789 {
790 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
791 else {$hashCount{$strEachItem} = 'T';}
792 }
793
794 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
795 {
796 if ( $strOutputFormat eq "xml" ) {
797 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
798 } else {
799 AlignPrint("Folder Comparsion","Succeed",$intLevel);
800 }
801 return @TwoPointers;
802 }
803 else
804 {
805 if ( $strOutputFormat eq "xml" ) {
806 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
807 } else {
808 AlignPrint("Folder Comparsion","Failed",$intLevel);
809 }
810
811 foreach my $strEachItem (keys %hashCount)
812 {
813 if($hashCount{$strEachItem} ne 'B')
814 {
815 my $strOutput = "";
816 my $strReport = "";
817
818 if($hashCount{$strEachItem} eq 'M')
819 {
820 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
821 $strReport = "Difference Report: difference found at $strTestFolder";
822 }
823 elsif($hashCount{$strEachItem} eq 'T')
824 {
825 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
826 $strReport = "Difference Report: difference found at $strModelFolder";
827 }
828 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
829
830 VobPrint ("$strOutput\n",$intLevel);
831 $strOutput = $strOutput."\n\t".$strReport."\n";
832 push(@Errors,$strOutput);
833 }
834 else {push(@CorrectFiles,$strEachItem);}
835 }
836 if( $strOutputFormat eq "xml" ) {
837 print "</message></folder-comparison>";
838 }
839
840 return @TwoPointers;
841 }
842}
843
844sub VobPrint
845{
846 my ($strOutput, $intLevel) = @_;
847 my $strTab = "";
848 my $intTab = int($intLevel/2);
849 if($intLevel <= $gv_intVerbosity)
850 {
851 if($intLevel >= 1)
852 {
853 $strTab = "\t"x($intTab+1);
854 $strOutput =~ s/\n$//;
855 $strOutput =~ s/\n/\n$strTab/g;
856 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
857 }
858
859 if( $strOutputFormat eq "xml" ) {
860 $strOutput =~ s/&/&amp;/g;
861 $strOutput =~ s/</&lt;/g;
862 $strOutput =~ s/>/&gt;/g;
863 }
864
865 if ( length( $strOutput ) > 1000 ) {
866 $strOutput = substr( $strOutput, 0, 978);
867
868 # make sure there are no stray ampersands/partial ampersands that need to be completed as &lt; or &gt;
869 if($strOutput =~ m/&(.{1,2})?$/ || $strOutput =~ m/&amp$/) { # &lt => &lt; or &g => &gt; or &a(m)=> &amp; or &amp => &amp;
870 if(defined $1 && $1) {
871 my $rest = $1;
872 if($rest =~ m/^a/) {
873 $strOutput =~ s@am?p?$@amp;@;
874 }
875 elsif($rest eq "g" || $rest eq "l") {
876 $strOutput .= "t;"; # close the known tag
877 }
878 elsif($rest eq "gt" || $rest eq "lt") {
879 $strOutput .= ";";
880 }
881 } else { # & on its own
882 #$strOutput = substr( $strOutput, 0, 977); # lop off the &
883 $strOutput .= "gt;"; # 50% chance the closing tag is what was missing (else can make this &amp;)
884 # but even so, when the xslt is applied to report it doesn't break as long as & is not left dangling
885 }
886 }
887 $strOutput .= "... (output truncated)";
888 }
889
890
891 print $strTab.$strOutput."\n";
892 }
893}
894#----##
895
896
897#--Main System----------------------------
898#-----------------------------------------
899# Name: main
900# Perameters: arguments from command line
901# Pre-condition: testing will start by calling this main function.
902# Post-condition: output the test results for one or more collections.
903#-----------------------------------------
904sub main
905{
906 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
907 my $strProgName = $0;
908 my $intArgc = scalar(@ARGV);
909
910 #--System Arguments Setup
911 if (!parsargv::parse(\@ARGV,
912 'estop//off', \$strErrorStop,
913 'eshow//off', \$strErrorShow,
914 'verbosity/\d+/1', \$intVerbosity,
915 'mode/[\w\-]+/all', \$strMode,
916 'output/[\w\-]+/text', \$strOutputFormat
917 )) {
918 PrintUsage($strProgName);
919 die "\n";
920 }
921
922 if ($intArgc<1) {
923 PrintUsage($strProgName);
924 die "\n";
925 }
926
927 $gv_blnErrorStop = $strErrorStop;
928 $gv_blnErrorShow = $strErrorShow;
929 $gv_intVerbosity = $intVerbosity;
930 $gv_strMode = SetMode($strMode);
931
932 #----##
933
934 #--Collection(s) Testing
935 foreach $strColName (@ARGV)
936 {
937 my @ErrorsInEachCol;
938 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
939 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
940
941 #--Output(Start)
942 OutputStart($strColName);
943 #----##
944
945 if(-e $strModelCol && -e $strTestCol )
946 {
947
948 #--Individual Testing
949 if ($gv_strMode eq "Individual")
950 {
951 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol,$strColName);
952 }
953 #----##
954
955 #--Initial Testing
956 elsif ($gv_strMode eq "Initial")
957 {
958 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
959 }
960 #----##
961
962 #--Full Testing
963 elsif ($gv_strMode eq "Full")
964 {
965 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
966 }
967 #----##
968
969 #--Error Checking
970 else
971 {
972 if ( $strOutputFormat eq "xml" ) {
973 die "<error>Error occoured in main function</error>\n";
974 } else {
975 die "Error occoured in main function.\n";
976 }
977 }
978 #----##
979
980 }
981 else
982 {
983 if( $strOutputFormat eq "xml" ) {
984 die "<error>Cannot find collection: $strColName</error>\n";
985 } else {
986 die "Error: cannot find collection: $strColName\n";
987 }
988 }
989 #----##
990
991 #--Output(Results and Errors)
992 OutputEnd($strColName,\@ErrorsInEachCol);
993 #----##
994
995 }
996}
997#----##
998
999&main();
Note: See TracBrowser for help on using the repository browser.