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

Last change on this file since 27695 was 27695, checked in by ak19, 9 years ago

Better diffing on Windows. If either the test or model collection was built on windows AND the other one was built on linux, there is now special handling for doc.xml and archiveinf-doc/src database files in order to normalise them to the linux situation for better results when diffing.

File size: 27.4 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;
47
48#--Global Variables Declaration-----------
49$gv_strModelColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/model-collect");
50$gv_strTestColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/collect");
51
52$gv_blnErrorStop = "false";
53$gv_blnErrorShow = "false";
54$gv_intVerbosity = 0;
55$gv_strMode = "Full";
56$strOutputFormat = "xml" unless defined $strOutputFormat; # global var with default
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{
117 my ($strModelCol,$strTestCol) = @_;
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);
126 my $strModelFolder = &FileUtils::filenameConcatenate($strModelCol,$strEachFolder);
127 my $strTestFolder = &FileUtils::filenameConcatenate($strTestCol,$strEachFolder);
128 $intNumberOfErrors = scalar(@Errors);
129 push(@Errors,TestEach($strModelFolder,$strTestFolder,0));
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
147# my $strModelLog = &FileUtils::filenameConcatenate($strModelCol,"log");
148# my $strTestLog = &FileUtils::filenameConcatenate($strTestCol,"log");
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
185 my $strModelBcfg = &FileUtils::filenameConcatenate($strModelCol,"index","build.cfg");
186 my $strTestBcfg = &FileUtils::filenameConcatenate($strTestCol,"index","build.cfg");
187
188 if(-e $strModelBcfg && -e $strTestBcfg)
189 {
190 my $strBcfgError = cfgdiff::test_cfg($strModelBcfg,$strTestBcfg,"build.cfg");
191 if($strBcfgError ne "")
192 {
193 if( $strOutputFormat eq "xml" ) {
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);
200 if( $strOutputFormat eq "xml" ) {
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
236 my $strModelCcfg = &FileUtils::filenameConcatenate($strModelCol,"etc","collect.cfg");
237 my $strTestCcfg = &FileUtils::filenameConcatenate($strTestCol,"etc","collect.cfg");
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
287 # Testing databases
288
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 }
296
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 }
304
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 }
311
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);
345 }
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;
358
359 if(!(-e $strModelGdb)){ $strErrorColName = $strErrorColName."(Model Collection)";}
360 if(!(-e $strTestGdb)){ $strErrorColName = $strErrorColName."(Test Collection)";}
361
362 AlignPrint("Database Comparsion Result","Failed",$intLevel);
363
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";
368
369 }
370
371 return $strGdbError;
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 }
406 push(@Errors,TestEach($strModelCol,$strTestCol,$intLevel));
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
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
564sub TestEach
565{
566 my ($strModel,$strTest,$intLevel) = @_;
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);
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
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 {
590 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
591 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
592 # now additionally ignoring the earliestDatestamp file and the index/idx/*.idh binary file when diffing file
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)$/g)) #$strEachFile =~ m/\.invf\.state\.\d+/
594 {
595 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
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 {
611 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
612 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
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)$/g))
614 {
615 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
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 {
627 my $ignore_line_re = "<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\\n*";
628 my $strResult;
629
630 # for doc.xml files, need to ignore many date fields. Filter these out before diffing,
631 # in case these don't appear in the same order between collections, since
632 # diffutil::GenerateOutput only handles the ignore_regex after a diff has been done
633 # when they can show up as unnecessary diff 'errors'
634 if($strModel =~ m/doc\.xml$/) {
635 my ($model_contents, $test_contents);
636 open(FIN,"<$strModel") or die "Unable to open $strModel...ERROR: $!\n";
637 sysread(FIN, $model_contents, -s FIN);
638 close(FIN);
639 open(FIN,"<$strTest") or die "Unable to open $strTest...ERROR: $!\n";
640 sysread(FIN, $test_contents, -s FIN);
641 close(FIN);
642
643 $model_contents =~ s/$ignore_line_re//g;
644 $test_contents =~ s/$ignore_line_re//g;
645
646 # equalise/normalise the two doc.xml files for OS differences, if there are any
647 my $testIsWin = &isDocXMLFileWindows($test_contents);
648 my $modelIsWin = &isDocXMLFileWindows($model_contents);
649
650 if($testIsWin != $modelIsWin) { # one of the 2 collections is built on windows, the other on linux, so need to make newlines constant
651
652 my $win_contents = $testIsWin ? \$test_contents : \$model_contents;
653
654 # make all windows slashes into unix slashes
655 $$win_contents =~ s@\\@\/@g;
656 # make windows \r newlines into constant \n newlines
657 $$win_contents =~ s@\r\n@\n@mg; # #http://stackoverflow.com/questions/650743/in-perl-how-to-do-you-remove-m-from-a-file
658
659 #FOR MAC: old macs use CR carriage return (see http://www.perlmonks.org/?node_id=745018), so replace with \n ?
660 # $$win_contents =~ s@\r@\n@mg;
661 }
662
663 $strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
664
665 } else {
666 $strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
667 }
668
669 # The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
670 # these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
671 $strResult = &diffutil::GenerateOutput($strResult,"^\\s*<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\$");
672
673 #$strResult = GeneralOutput($strResult);
674 if ( $strOutputFormat eq "xml" ) {
675 #
676 } else {
677 VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
678 }
679 if ($strResult eq "")
680 {
681 if ( $strOutputFormat eq "xml" ) {
682 print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
683 } else {
684 AlignPrint("Comparing File","Succeed",$intLevel);
685 }
686 }
687 else
688 {
689 my $strOutput = "Difference Report:\n$strResult\n";
690 if ( $strOutputFormat eq "xml" ) {
691 print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
692 } else {
693 AlignPrint("Comparing File","Failed",$intLevel);
694 }
695
696 #$result=`file -b $strModel`; # linux specific test for binary file
697 $result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
698 if ( "$result" =~ "data" ) {
699 VobPrint( "These binary files differ", $intLevel );
700 } else {
701 VobPrint ( "$strOutput" , $intLevel);
702 }
703
704
705 if ( $strOutputFormat eq "xml" ) {
706 print "</message></file-comparison>";
707 }
708
709 if($gv_blnErrorStop ne "off") { exit; }
710 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
711 }
712 }
713
714 return @Errors;
715}
716
717
718sub FolderTesting
719{
720 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
721 my %hashCount = ();
722 my @Errors = ();
723 my @CorrectFiles = ();
724 my @TwoPointers = (\@Errors,\@CorrectFiles);
725
726 if ( $strOutputFormat eq "xml" ) {
727 #print "<folder-comparison location=\"$strModelFolder\">\n";
728 } else {
729 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
730 }
731
732 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
733 foreach my $strEachItem (@$aryptTest)
734 {
735 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
736 else {$hashCount{$strEachItem} = 'T';}
737 }
738
739 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
740 {
741 if ( $strOutputFormat eq "xml" ) {
742 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
743 } else {
744 AlignPrint("Folder Comparsion","Succeed",$intLevel);
745 }
746 return @TwoPointers;
747 }
748 else
749 {
750 if ( $strOutputFormat eq "xml" ) {
751 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
752 } else {
753 AlignPrint("Folder Comparsion","Failed",$intLevel);
754 }
755
756 foreach my $strEachItem (keys %hashCount)
757 {
758 if($hashCount{$strEachItem} ne 'B')
759 {
760 my $strOutput = "";
761 my $strReport = "";
762
763 if($hashCount{$strEachItem} eq 'M')
764 {
765 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
766 $strReport = "Difference Report: difference found at $strTestFolder";
767 }
768 elsif($hashCount{$strEachItem} eq 'T')
769 {
770 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
771 $strReport = "Difference Report: difference found at $strModelFolder";
772 }
773 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
774
775 VobPrint ("$strOutput\n",$intLevel);
776 $strOutput = $strOutput."\n\t".$strReport."\n";
777 push(@Errors,$strOutput);
778 }
779 else {push(@CorrectFiles,$strEachItem);}
780 }
781 if( $strOutputFormat eq "xml" ) {
782 print "</message></folder-comparison>";
783 }
784
785 return @TwoPointers;
786 }
787}
788
789sub VobPrint
790{
791 my ($strOutput, $intLevel) = @_;
792 my $strTab = "";
793 my $intTab = int($intLevel/2);
794 if($intLevel <= $gv_intVerbosity)
795 {
796 if($intLevel >= 1)
797 {
798 $strTab = "\t"x($intTab+1);
799 $strOutput =~ s/\n$//;
800 $strOutput =~ s/\n/\n$strTab/g;
801 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
802 }
803
804 if( $strOutputFormat eq "xml" ) {
805 $strOutput =~ s/&/&amp;/g;
806 $strOutput =~ s/</&lt;/g;
807 $strOutput =~ s/>/&gt;/g;
808 }
809
810 if ( length( $strOutput ) > 1000 ) {
811 $strOutput = substr( $strOutput, 0, 978) . "... (output truncated)";
812 }
813
814
815 print $strTab.$strOutput."\n";
816 }
817}
818#----##
819
820
821#--Main System----------------------------
822#-----------------------------------------
823# Name: main
824# Perameters: arguments from command line
825# Pre-condition: testing will start by calling this main function.
826# Post-condition: output the test results for one or more collections.
827#-----------------------------------------
828sub main
829{
830 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
831 my $strProgName = $0;
832 my $intArgc = scalar(@ARGV);
833
834 #--System Arguments Setup
835 if (!parsargv::parse(\@ARGV,
836 'estop//off', \$strErrorStop,
837 'eshow//off', \$strErrorShow,
838 'verbosity/\d+/1', \$intVerbosity,
839 'mode/[\w\-]+/all', \$strMode,
840 'output/[\w\-]+/text', \$strOutputFormat
841 )) {
842 PrintUsage($strProgName);
843 die "\n";
844 }
845
846 if ($intArgc<1) {
847 PrintUsage($strProgName);
848 die "\n";
849 }
850
851 $gv_blnErrorStop = $strErrorStop;
852 $gv_blnErrorShow = $strErrorShow;
853 $gv_intVerbosity = $intVerbosity;
854 $gv_strMode = SetMode($strMode);
855
856 #----##
857
858 #--Collection(s) Testing
859 foreach $strColName (@ARGV)
860 {
861 my @ErrorsInEachCol;
862 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
863 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
864
865 #--Output(Start)
866 OutputStart($strColName);
867 #----##
868
869 if(-e $strModelCol && -e $strTestCol )
870 {
871
872 #--Individual Testing
873 if ($gv_strMode eq "Individual")
874 {
875 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol);
876 }
877 #----##
878
879 #--Initial Testing
880 elsif ($gv_strMode eq "Initial")
881 {
882 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
883 }
884 #----##
885
886 #--Full Testing
887 elsif ($gv_strMode eq "Full")
888 {
889 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
890 }
891 #----##
892
893 #--Error Checking
894 else
895 {
896 if ( $strOutputFormat eq "xml" ) {
897 die "<error>Error occoured in main function</error>\n";
898 } else {
899 die "Error occoured in main function.\n";
900 }
901 }
902 #----##
903
904 }
905 else
906 {
907 if( $strOutputFormat eq "xml" ) {
908 die "<error>Cannot find collection: $strColName</error>\n";
909 } else {
910 die "Error: cannot find collection: $strColName\n";
911 }
912 }
913 #----##
914
915 #--Output(Results and Errors)
916 OutputEnd($strColName,\@ErrorsInEachCol);
917 #----##
918
919 }
920}
921#----##
922
923&main();
Note: See TracBrowser for help on using the repository browser.