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

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

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