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

Last change on this file since 27666 was 27666, checked in by kjdon, 11 years ago

Using perl rather than bash to test if file is binary, so that this test does not become unrecognised on windows.
File size: 25.0 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
539sub TestEach
540{
541 my ($strModel,$strTest,$intLevel) = @_;
542 my @Errors = ();
543
544 $intLevel++;
545 if (-d $strModel && -d $strTest)
546 {
547 my @aryInModel = &diffutil::files_in_dir($strModel);
548 my @aryInTest = &diffutil::files_in_dir($strTest);
549 my @aryTwoPointers = FolderTesting(\@aryInModel,\@aryInTest,$strModel,$strTest,$intLevel);
550 my @aryCorrectFiles = @{$aryTwoPointers[1]};
551 @Errors = @{$aryTwoPointers[0]};
552
553 if(scalar(@Errors) == 0)
554 {
555 foreach my $strEachFile (@aryInModel)
556 {
557 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
558 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
559 # now additionally ignoring the earliestDatestamp file and the index/idx/*.idh binary file when diffing file
560 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.((g|j|l|b)db|idh)$/g))
561 {
562 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
563 }
564 else
565 {
566 if ( $strOutputFormat eq "xml" ) {
567 print "<file-comparision location=\"$strEachFile\" blocked=\"yes\" succeeded=\"yes\"/>";
568 } else {
569 VobPrint ("Blocked File Report: Test \"$strEachFile\" by using -mode \"init\"\n",$intLevel);
570 }
571 }
572 }
573 }
574 else
575 {
576 foreach my $strEachFile (@aryCorrectFiles)
577 {
578 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
579 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
580 if(!($strEachFile eq "log" || $strEachFile eq "earliestDatestamp" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.((g|j|l|b)db|idh)$/g))
581 {
582 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
583 }
584 }
585 }
586 if($intLevel == $gv_intVerbosity)
587 {
588 if(scalar(@Errors) == 0){ AlignPrint("Contents Comparsion","Succeed",$intLevel);}
589 else { AlignPrint("Contents Comparsion","Failed",$intLevel);}
590 }
591 }
592 else
593 {
594 my $ignore_line_re = "<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\\n*";
595 my $strResult;
596
597 # for doc.xml files, need to ignore many date fields. Filter these out before diffing,
598 # in case these don't appear in the same order between collections, since
599 # diffutil::GenerateOutput only handles the ignore_regex after a diff has been done
600 # when they can show up as unnecessary diff 'errors'
601 if($strModel =~ m/doc\.xml$/) {
602 my ($model_contents, $test_contents);
603 open(FIN,"<$strModel") or die "Unable to open $strModel...ERROR: $!\n";
604 sysread(FIN, $model_contents, -s FIN);
605 close(FIN);
606 open(FIN,"<$strTest") or die "Unable to open $strTest...ERROR: $!\n";
607 sysread(FIN, $test_contents, -s FIN);
608 close(FIN);
609
610 $model_contents =~ s/$ignore_line_re//g;
611 $test_contents =~ s/$ignore_line_re//g;
612
613 $strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
614
615 } else {
616 $strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
617 }
618
619 # The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
620 # these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
621 $strResult = &diffutil::GenerateOutput($strResult,"^\\s*<Metadata name=\"(lastmodified|lastmodifieddate|oailastmodified|oailastmodifieddate)\">.*</Metadata>\\s*\$");
622
623 #$strResult = GeneralOutput($strResult);
624 if ( $strOutputFormat eq "xml" ) {
625 #
626 } else {
627 VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
628 }
629 if ($strResult eq "")
630 {
631 if ( $strOutputFormat eq "xml" ) {
632 print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
633 } else {
634 AlignPrint("Comparing File","Succeed",$intLevel);
635 }
636 }
637 else
638 {
639 my $strOutput = "Difference Report:\n$strResult\n";
640 if ( $strOutputFormat eq "xml" ) {
641 print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
642 } else {
643 AlignPrint("Comparing File","Failed",$intLevel);
644 }
645
646 #$result=`file -b $strModel`; # linux specific test for binary file
647 $result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
648 if ( "$result" =~ "data" ) {
649 VobPrint( "These binary files differ", $intLevel );
650 } else {
651 VobPrint ( "$strOutput" , $intLevel);
652 }
653
654
655 if ( $strOutputFormat eq "xml" ) {
656 print "</message></file-comparison>";
657 }
658
659 if($gv_blnErrorStop ne "off") { exit; }
660 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
661 }
662 }
663
664 return @Errors;
665}
666
667
668sub FolderTesting
669{
670 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
671 my %hashCount = ();
672 my @Errors = ();
673 my @CorrectFiles = ();
674 my @TwoPointers = (\@Errors,\@CorrectFiles);
675
676 if ( $strOutputFormat eq "xml" ) {
677 #print "<folder-comparison location=\"$strModelFolder\">\n";
678 } else {
679 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
680 }
681
682 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
683 foreach my $strEachItem (@$aryptTest)
684 {
685 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
686 else {$hashCount{$strEachItem} = 'T';}
687 }
688
689 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
690 {
691 if ( $strOutputFormat eq "xml" ) {
692 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
693 } else {
694 AlignPrint("Folder Comparsion","Succeed",$intLevel);
695 }
696 return @TwoPointers;
697 }
698 else
699 {
700 if ( $strOutputFormat eq "xml" ) {
701 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
702 } else {
703 AlignPrint("Folder Comparsion","Failed",$intLevel);
704 }
705
706 foreach my $strEachItem (keys %hashCount)
707 {
708 if($hashCount{$strEachItem} ne 'B')
709 {
710 my $strOutput = "";
711 my $strReport = "";
712
713 if($hashCount{$strEachItem} eq 'M')
714 {
715 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
716 $strReport = "Difference Report: difference found at $strTestFolder";
717 }
718 elsif($hashCount{$strEachItem} eq 'T')
719 {
720 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
721 $strReport = "Difference Report: difference found at $strModelFolder";
722 }
723 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
724
725 VobPrint ("$strOutput\n",$intLevel);
726 $strOutput = $strOutput."\n\t".$strReport."\n";
727 push(@Errors,$strOutput);
728 }
729 else {push(@CorrectFiles,$strEachItem);}
730 }
731 if( $strOutputFormat eq "xml" ) {
732 print "</message></folder-comparison>";
733 }
734
735 return @TwoPointers;
736 }
737}
738
739sub VobPrint
740{
741 my ($strOutput, $intLevel) = @_;
742 my $strTab = "";
743 my $intTab = int($intLevel/2);
744 if($intLevel <= $gv_intVerbosity)
745 {
746 if($intLevel >= 1)
747 {
748 $strTab = "\t"x($intTab+1);
749 $strOutput =~ s/\n$//;
750 $strOutput =~ s/\n/\n$strTab/g;
751 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
752 }
753
754 if( $strOutputFormat eq "xml" ) {
755 $strOutput =~ s/&/&amp;/g;
756 $strOutput =~ s/</&lt;/g;
757 $strOutput =~ s/>/&gt;/g;
758 }
759
760 if ( length( $strOutput ) > 1000 ) {
761 $strOutput = substr( $strOutput, 0, 978) . "... (output truncated)";
762 }
763
764
765 print $strTab.$strOutput."\n";
766 }
767}
768#----##
769
770
771#--Main System----------------------------
772#-----------------------------------------
773# Name: main
774# Perameters: arguments from command line
775# Pre-condition: testing will start by calling this main function.
776# Post-condition: output the test results for one or more collections.
777#-----------------------------------------
778sub main
779{
780 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
781 my $strProgName = $0;
782 my $intArgc = scalar(@ARGV);
783
784 #--System Arguments Setup
785 if (!parsargv::parse(\@ARGV,
786 'estop//off', \$strErrorStop,
787 'eshow//off', \$strErrorShow,
788 'verbosity/\d+/1', \$intVerbosity,
789 'mode/[\w\-]+/all', \$strMode,
790 'output/[\w\-]+/text', \$strOutputFormat
791 )) {
792 PrintUsage($strProgName);
793 die "\n";
794 }
795
796 if ($intArgc<1) {
797 PrintUsage($strProgName);
798 die "\n";
799 }
800
801 $gv_blnErrorStop = $strErrorStop;
802 $gv_blnErrorShow = $strErrorShow;
803 $gv_intVerbosity = $intVerbosity;
804 $gv_strMode = SetMode($strMode);
805
806 #----##
807
808 #--Collection(s) Testing
809 foreach $strColName (@ARGV)
810 {
811 my @ErrorsInEachCol;
812 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
813 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
814
815 #--Output(Start)
816 OutputStart($strColName);
817 #----##
818
819 if(-e $strModelCol && -e $strTestCol )
820 {
821
822 #--Individual Testing
823 if ($gv_strMode eq "Individual")
824 {
825 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol);
826 }
827 #----##
828
829 #--Initial Testing
830 elsif ($gv_strMode eq "Initial")
831 {
832 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
833 }
834 #----##
835
836 #--Full Testing
837 elsif ($gv_strMode eq "Full")
838 {
839 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
840 }
841 #----##
842
843 #--Error Checking
844 else
845 {
846 if ( $strOutputFormat eq "xml" ) {
847 die "<error>Error occoured in main function</error>\n";
848 } else {
849 die "Error occoured in main function.\n";
850 }
851 }
852 #----##
853
854 }
855 else
856 {
857 if( $strOutputFormat eq "xml" ) {
858 die "<error>Cannot find collection: $strColName</error>\n";
859 } else {
860 die "Error: cannot find collection: $strColName\n";
861 }
862 }
863 #----##
864
865 #--Output(Results and Errors)
866 OutputEnd($strColName,\@ErrorsInEachCol);
867 #----##
868
869 }
870}
871#----##
872
873&main();
Note: See TracBrowser for help on using the repository browser.