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

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

Fixing up diffcol process so it works better. Current state finds no errors in Small-HTML model-collection. 1. Better handling of gdb database (and ignores .idh) by filtering out fields that are expected to differ such as date before doing the diff. Handles archiveinf-doc.gdb and -src.gdb files and with the sort flag Dr Bainbridge added to db2text and the sorting of keys in perllib/dbutil/gdbmtxtgz, the ordering of keys in the database is no longer affecting the outcome. 2. Better handling of doc.xml files. Once more date fields that will differ are filtered out before performing the diff. EarliestDatestamp file is ignored. 3. The task script now ensures that model-collect is up to date with the svn version when about to perform the diff col testing.
File size: 24.8 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`;
647 if ( "$result" =~ "data" ) {
648 VobPrint( "These binary files differ", $intLevel );
649 } else {
650 VobPrint ( "$strOutput" , $intLevel);
651 }
652
653
654 if ( $strOutputFormat eq "xml" ) {
655 print "</message></file-comparison>";
656 }
657
658 if($gv_blnErrorStop ne "off") { exit; }
659 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
660 }
661 }
662
663 return @Errors;
664}
665
666
667sub FolderTesting
668{
669 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
670 my %hashCount = ();
671 my @Errors = ();
672 my @CorrectFiles = ();
673 my @TwoPointers = (\@Errors,\@CorrectFiles);
674
675 if ( $strOutputFormat eq "xml" ) {
676 #print "<folder-comparison location=\"$strModelFolder\">\n";
677 } else {
678 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
679 }
680
681 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
682 foreach my $strEachItem (@$aryptTest)
683 {
684 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
685 else {$hashCount{$strEachItem} = 'T';}
686 }
687
688 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
689 {
690 if ( $strOutputFormat eq "xml" ) {
691 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
692 } else {
693 AlignPrint("Folder Comparsion","Succeed",$intLevel);
694 }
695 return @TwoPointers;
696 }
697 else
698 {
699 if ( $strOutputFormat eq "xml" ) {
700 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
701 } else {
702 AlignPrint("Folder Comparsion","Failed",$intLevel);
703 }
704
705 foreach my $strEachItem (keys %hashCount)
706 {
707 if($hashCount{$strEachItem} ne 'B')
708 {
709 my $strOutput = "";
710 my $strReport = "";
711
712 if($hashCount{$strEachItem} eq 'M')
713 {
714 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
715 $strReport = "Difference Report: difference found at $strTestFolder";
716 }
717 elsif($hashCount{$strEachItem} eq 'T')
718 {
719 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
720 $strReport = "Difference Report: difference found at $strModelFolder";
721 }
722 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
723
724 VobPrint ("$strOutput\n",$intLevel);
725 $strOutput = $strOutput."\n\t".$strReport."\n";
726 push(@Errors,$strOutput);
727 }
728 else {push(@CorrectFiles,$strEachItem);}
729 }
730 if( $strOutputFormat eq "xml" ) {
731 print "</message></folder-comparison>";
732 }
733
734 return @TwoPointers;
735 }
736}
737
738sub VobPrint
739{
740 my ($strOutput, $intLevel) = @_;
741 my $strTab = "";
742 my $intTab = int($intLevel/2);
743 if($intLevel <= $gv_intVerbosity)
744 {
745 if($intLevel >= 1)
746 {
747 $strTab = "\t"x($intTab+1);
748 $strOutput =~ s/\n$//;
749 $strOutput =~ s/\n/\n$strTab/g;
750 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
751 }
752
753 if( $strOutputFormat eq "xml" ) {
754 $strOutput =~ s/&/&amp;/g;
755 $strOutput =~ s/</&lt;/g;
756 $strOutput =~ s/>/&gt;/g;
757 }
758
759 if ( length( $strOutput ) > 1000 ) {
760 $strOutput = substr( $strOutput, 0, 978) . "... (output truncated)";
761 }
762
763
764 print $strTab.$strOutput."\n";
765 }
766}
767#----##
768
769
770#--Main System----------------------------
771#-----------------------------------------
772# Name: main
773# Perameters: arguments from command line
774# Pre-condition: testing will start by calling this main function.
775# Post-condition: output the test results for one or more collections.
776#-----------------------------------------
777sub main
778{
779 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
780 my $strProgName = $0;
781 my $intArgc = scalar(@ARGV);
782
783 #--System Arguments Setup
784 if (!parsargv::parse(\@ARGV,
785 'estop//off', \$strErrorStop,
786 'eshow//off', \$strErrorShow,
787 'verbosity/\d+/1', \$intVerbosity,
788 'mode/[\w\-]+/all', \$strMode,
789 'output/[\w\-]+/text', \$strOutputFormat
790 )) {
791 PrintUsage($strProgName);
792 die "\n";
793 }
794
795 if ($intArgc<1) {
796 PrintUsage($strProgName);
797 die "\n";
798 }
799
800 $gv_blnErrorStop = $strErrorStop;
801 $gv_blnErrorShow = $strErrorShow;
802 $gv_intVerbosity = $intVerbosity;
803 $gv_strMode = SetMode($strMode);
804
805 #----##
806
807 #--Collection(s) Testing
808 foreach $strColName (@ARGV)
809 {
810 my @ErrorsInEachCol;
811 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
812 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
813
814 #--Output(Start)
815 OutputStart($strColName);
816 #----##
817
818 if(-e $strModelCol && -e $strTestCol )
819 {
820
821 #--Individual Testing
822 if ($gv_strMode eq "Individual")
823 {
824 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol);
825 }
826 #----##
827
828 #--Initial Testing
829 elsif ($gv_strMode eq "Initial")
830 {
831 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
832 }
833 #----##
834
835 #--Full Testing
836 elsif ($gv_strMode eq "Full")
837 {
838 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
839 }
840 #----##
841
842 #--Error Checking
843 else
844 {
845 if ( $strOutputFormat eq "xml" ) {
846 die "<error>Error occoured in main function</error>\n";
847 } else {
848 die "Error occoured in main function.\n";
849 }
850 }
851 #----##
852
853 }
854 else
855 {
856 if( $strOutputFormat eq "xml" ) {
857 die "<error>Cannot find collection: $strColName</error>\n";
858 } else {
859 die "Error: cannot find collection: $strColName\n";
860 }
861 }
862 #----##
863
864 #--Output(Results and Errors)
865 OutputEnd($strColName,\@ErrorsInEachCol);
866 #----##
867
868 }
869}
870#----##
871
872&main();
Note: See TracBrowser for help on using the repository browser.