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

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

FileUtils functions instead of util.pm
File size: 22.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
57%gv_IndivList = ("archives" => 0,
58 "etc" => 0,
59 "images" => 0,
60 "building" => 0,
61 "import" => 0,
62 "index" => 0,
63 "log" => 0,
64 "metadata" => 0,
65 "perllib" => 0,
66 "temp" => 0);
67#----##
68
69#--System Setup---------------------------
70sub SetMode
71{
72 my ($strModeList) = @_;
73 $strModeList =~ s/\|/ /g;
74 my @Modes = split(" ",$strModeList);
75
76 my $blnIndividual = "true";
77 my $blnInitial = "false";
78 my $blnFull = "false";
79
80
81 foreach $strEachMode (@Modes)
82 {
83 if($strEachMode eq "all")
84 {
85 $blnFull = "true";
86 $blnIndividual = "false";
87 }
88 elsif($strEachMode eq "init")
89 {
90 $blnInitial = "true";
91 $blnIndividual = "false";
92 }
93 else
94 {
95 if(defined $gv_IndivList{$strEachMode})
96 {
97 $gv_IndivList{$strEachMode} = 1;
98 }
99 else
100 {
101 die Help("Error: used undefined mode");
102 }
103 }
104 }
105
106 if($blnFull eq "true") {return "Full";}
107 elsif($blnInitial eq "true") {return "Initial";}
108 elsif($blnIndividual eq "true") {return "Individual";}
109 else {die "Error occured in function SetMode!!\n";}
110}
111#----##
112
113#--System Process-------------------------
114sub IndivTest
115{
116 my ($strModelCol,$strTestCol) = @_;
117 my @Errors = ();
118 my $intNumberOfErrors = 0;
119 foreach $strEachFolder (keys %gv_IndivList)
120 {
121 if($gv_IndivList{$strEachFolder} == 1)
122 {
123
124 VobPrint("Start Comparing \"$strEachFolder\"\n",0);
125 my $strModelFolder = &FileUtils::filenameConcatenate($strModelCol,$strEachFolder);
126 my $strTestFolder = &FileUtils::filenameConcatenate($strTestCol,$strEachFolder);
127 $intNumberOfErrors = scalar(@Errors);
128 push(@Errors,TestEach($strModelFolder,$strTestFolder,0));
129 $intNumberOfErrors = scalar(@Errors) - $intNumberOfErrors;
130 VobPrint("End Comparing \"$strEachFolder\"\n",0);
131 VobPrint("Difference Found: $intNumberOfErrors\n",0);
132 VobPrint ("\n",0);
133 }
134 }
135 return @Errors;
136}
137
138sub InitTest
139{
140
141 my ($strModelCol,$strTestCol,$strColName) = @_;
142 my $intLevel = 1;
143 my @Errors;
144
145 # Testing Log files
146# my $strModelLog = &FileUtils::filenameConcatenate($strModelCol,"log");
147# my $strTestLog = &FileUtils::filenameConcatenate($strTestCol,"log");
148#
149# if(-e $strModelLog && -e $strTestLog)
150# {
151# my $strLogError = logdiff::test_log($strModelLog,$strTestLog);
152# if($strLogError ne "")
153# {
154# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
155# VobPrint ("$strLogError\n",$intLevel);
156#
157# $strLogError = "$strLogError";
158# $strLogError = "Difference Found at Log Folder Testing\n".$strLogError."\n";
159# push(@Errors,$strLogError);
160# }
161# else
162# {
163# AlignPrint("Log Folder Comparison Result","Succeed",$intLevel);
164# }
165# }
166# else
167# {
168# my $strErrorColName;
169# my $strLogError;
170#
171# if(!(-e $strModelLog)){ $strErrorColName = $strErrorColName."(Model Collection)";}
172# if(!(-e $strTestLog)){ $strErrorColName = $strErrorColName."(Test Collection)";}
173#
174# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
175# $strLogError = "Difference Report: No Log Folder found in $strErrorColName";
176# VobPrint ("$strLogError\n",$intLevel);
177# $strLogError = "Difference Found at Log Folder Testing (Log folders are only created using GLI)\n".$strLogError."\n";
178#
179# push(@Errors,$strLogError);
180# }
181# VobPrint ("\n",$intLevel);
182
183 # Testing the build.cfg
184 my $strModelBcfg = &FileUtils::filenameConcatenate($strModelCol,"index","build.cfg");
185 my $strTestBcfg = &FileUtils::filenameConcatenate($strTestCol,"index","build.cfg");
186
187 if(-e $strModelBcfg && -e $strTestBcfg)
188 {
189 my $strBcfgError = cfgdiff::test_cfg($strModelBcfg,$strTestBcfg,"build.cfg");
190 if($strBcfgError ne "")
191 {
192 if( $strOutput eq "xml" ) {
193 print "<build-cfg succeeded=\"no\">\n<message>";
194 } else {
195 AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
196 }
197
198 VobPrint ("$strBcfgError",$intLevel);
199 if( $strOutput eq "xml" ) {
200 print "</message></build-cfg>";
201 }
202
203 $strBcfgError = "$strBcfgError";
204 $strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
205 push(@Errors,$strBcfgError);
206 }
207 else
208 {
209 if( $strOutputFormat eq "xml" ) {
210 print "<build-cfg succeeded=\"yes\"/>";
211 } else {
212 AlignPrint("Config File(build.cfg) Comparison Result","Succeed",$intLevel);
213 }
214 }
215 }
216 else
217 {
218 my $strErrorColName;
219 my $strBcfgError;
220
221 if(!(-e $strModelBcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
222 if(!(-e $strTestBcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
223
224 AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
225 $strBcfgError = "Difference Report: No Config files found in $strErrorColName";
226 VobPrint ("$strBcfgError\n",$intLevel);
227 $strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
228
229 push(@Errors,$strBcfgError);
230 }
231 VobPrint ("\n",$intLevel);
232
233 # Testing the collect.cfg
234
235 my $strModelCcfg = &FileUtils::filenameConcatenate($strModelCol,"etc","collect.cfg");
236 my $strTestCcfg = &FileUtils::filenameConcatenate($strTestCol,"etc","collect.cfg");
237
238 if(-e $strModelCcfg && -e $strTestCcfg)
239 {
240 my $strCcfgError = cfgdiff::test_cfg($strModelCcfg,$strTestCcfg,"collect.cfg");
241 if($strCcfgError ne "")
242 {
243 if( $strOutputFormat eq "xml" ) {
244 print "<collect-cfg succeeded=\"no\"><message>";
245 } else {
246 AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
247 }
248
249 VobPrint ("$strCcfgError",$intLevel);
250
251 if( $strOutputFormat eq "xml" ) {
252 print "</message></collect-cfg>";
253 }
254
255 $strCcfgError = "$strCcfgError";
256 $strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
257 push(@Errors,$strCcfgError);
258 }
259 else
260 {
261 if( $strOutputFormat eq "xml" ) {
262 print "<collect-cfg succeeded=\"yes\"/>";
263 } else {
264 AlignPrint("Config File(collect.cfg) Comparison Result","Succeed",$intLevel);
265 }
266 }
267 }
268 else
269 {
270 my $strErrorColName;
271 my $strCcfgError;
272
273 if(!(-e $strModelCcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
274 if(!(-e $strTestCcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
275
276 AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
277 $strCcfgError = "Difference Report: No Config files found in $strErrorColName";
278 VobPrint ("$strCcfgError\n",$intLevel);
279 $strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
280
281 push(@Errors,$strCcfgError);
282 }
283
284 VobPrint ("\n",$intLevel);
285
286 # Testing database
287
288 my $strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"index","text","$strColName.ldb");
289 my $strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"index","text","$strColName.ldb");
290
291 if(-e $strModelGdb && -e $strTestGdb)
292 {
293 my $strGdbError = gdbdiff::test_gdb($strModelGdb, $strTestGdb);
294 if($strGdbError ne "")
295 {
296 if( $strOutputFormat eq "xml" ) {
297 print "<database succeeded=\"no\"><message>";
298 } else {
299 AlignPrint("Database Comparsion Result","Failed",$intLevel);
300 }
301 VobPrint ("$strGdbError\n",$intLevel);
302
303 if( $strOutputFormat eq "xml" ) {
304 print "</message></database>";
305 }
306
307 $strGdbError = "$strGdbError";
308 $strGdbError = "Difference Found at Database Comparsion\n".$strGdbError."\n";
309 push(@Errors,$strGdbError);
310 }
311 else
312 {
313 if( $strOutputFormat eq "xml" ) {
314 print "<database succeeded=\"yes\"/>";
315 } else {
316 AlignPrint("Database Comparsion Result","Succeed",$intLevel);
317 }
318 }
319 }
320 else
321 {
322 my $strErrorColName;
323 my $strGdbError;
324
325 if(!(-e $strModelGdb)){ $strErrorColName = $strErrorColName."(Model Collection)";}
326 if(!(-e $strTestGdb)){ $strErrorColName = $strErrorColName."(Test Collection)";}
327
328 AlignPrint("Database Comparsion Result","Failed",$intLevel);
329
330 $strGdbError = "Difference Report: No Database files found in $strErrorColName";
331 VobPrint ("$strGdbError\n",$intLevel);
332
333 $strGdbError = "Difference Found at Database Comparison\n".$strGdbError."\n";
334
335 push(@Errors,$strGdbError);
336 }
337
338 VobPrint ("\n",$intLevel);
339
340 return @Errors;
341}
342
343sub FullTest
344{
345 my ($strModelCol,$strTestCol,$strColName) = @_;
346 my @Errors = ();
347 my $intLevel = 0;
348 my $intNumberDiffs = 0;
349
350 # <Initial Test>
351 if( $strOutputFormat eq "xml" ) {
352 #print "<initial-test>";
353 } else {
354 VobPrint("Initial Testing Start\n",$intLevel);
355 }
356
357 @Errors = InitTest($strModelCol,$strTestCol,$strColName);
358 $intNumberDiffs = scalar(@Errors);
359
360 if( $strOutputFormat eq "xml" ) {
361 #print "</initial-test>";
362 } else {
363 VobPrint("Initial Testing End\n",$intLevel);
364 VobPrint("Difference Found in Initial Testing: $intNumberDiffs\n",$intLevel);
365 VobPrint("\n",$intLevel);
366 }
367 # </Initial Test>
368
369 # <Detailed Test>
370 if( $strOutputFormat eq "xml" ) {
371 #print "<detailed-test>";
372 } else {
373 VobPrint("Detail Testing Start\n",$intLevel);
374 }
375 push(@Errors,TestEach($strModelCol,$strTestCol,$intLevel));
376 $intNumberDiffs = scalar(@Errors) - $intNumberDiffs;
377
378 if( $strOutputFormat eq "xml" ) {
379 #print "</detailed-test>";
380 } else {
381 VobPrint("Detail Testing End\n",$intLevel);
382 VobPrint("Difference Found in Detail Testing: $intNumberDiffs\n",$intLevel);
383 }
384 # </Detailed Test>
385
386 return @Errors;
387}
388#----##
389
390
391#--Other System Utilities
392sub PrintUsage
393{
394 my ($strProgName) = @_;
395 if ( $strOutputFormat eq "xml" ) {
396 print "<error>usage incorrect</error>\n";
397 } else {
398 print STDERR "Usage: $strProgName test-col [more-col] [-verbosity d] [-mode modes] [-eshow] [-estop]\n";
399 }
400 Help("Error: used incorrect parameters");
401}
402
403sub Help
404{
405 my ($strError) = @_;
406 my $aryptHelps =
407 [ { 'name' => "verbosity",
408 'type' => "scale",
409 'argu' => "a integer" ,
410 'descrip' => "this parameter setup the verbosity of the testing result"},
411 { 'name' => "mode",
412 'type' => "option",
413 'argu' => "mode type \"[all|init|archives|building|etc|images|import|index|perllib|tmp]\" default to \"all\"" ,
414 'descrip' => "setup testing mode: all-full testing, init-initial testing (include configuration file test,database testing and log testing), others-for individual folder testing"},
415 { 'name' => "estop",
416 'type' => "flag",
417 'argu' => "NULL" ,
418 'descrip' => "Set then system will stop once it meet an error"},
419 { 'name' => "eshow",
420 'type' => "flag",
421 'argu' => "NULL" ,
422 'descrip' => "Set then system will show the error summary"}
423 ];
424
425
426 if ( $strOutputFormat ne "xml" ) {
427 print "$strError\n";
428
429 foreach my $hashOneArg (@{$aryptHelps})
430 {
431 print "\n----------------------------\n";
432 print "Parameters: -".$hashOneArg->{"name"}."\n";
433 print "Type: ".$hashOneArg->{"type"}."\n";
434 print "Supply Argument: ".$hashOneArg->{"argu"}."\n";
435 print "Description: ".$hashOneArg->{"descrip"}."\n";
436 print "----------------------------\n";
437 }
438 }
439}
440
441sub OutputStart
442{
443 my ($strColName) = @_;
444 my $intPadding = 17 - length($strColName);
445
446 if ( $strOutputFormat eq "xml" ) {
447 print "<diffcol>\n";
448 } else {
449 print "+---------------------------------------------------------+\n";
450 print "| |\n";
451 print "| Start Testing Collection: $strColName"," " x $intPadding,"|\n";
452 print "| |\n";
453 print "+---------------------------------------------------------+\n\n";
454 }
455}
456
457sub OutputEnd
458{
459 my ($strColName,$aryptErrors) = @_;
460 my $intPadding = 12 - length($strColName);
461 if ( $strOutputFormat eq "xml" ) {
462 print "</diffcol>\n";
463 } else {
464 print "\n";
465 print "+---------------------------------------------------------+\n";
466 print "| |\n";
467 print "| Result of Collection Testing: $strColName"," " x $intPadding,"|\n";
468 print "| |\n";
469 print "+---------------------------------------------------------+\n\n";
470 }
471
472 my $intTotalErrors = scalar(@{$aryptErrors});
473 if ( $strOutputFormat ne "xml" ) {
474 print "Checking completed, there is $intTotalErrors error(s) found.\n";
475 }
476
477 if($gv_blnErrorShow ne "off")
478 {
479 foreach my $strEachError (@{$aryptErrors})
480 {
481 if ( $strOutputFormat eq "xml" ) {
482 print "<error>";
483 print $strEachError;
484 print "</error>\n";
485 } else {
486 print "+---------------------------------------------------------+\n";
487 print "| Error |\n";
488 print "+---------------------------------------------------------+\n\n";
489 print "$strEachError\n\n";
490 }
491 }
492 }
493 else
494 {
495 if ( $strOutputFormat ne "xml" ) {
496 print "Use -eshow to show the error detail\n\n";
497 }
498 }
499}
500
501sub AlignPrint
502{
503 my ($strMainString,$strStatus,$intLevel) = @_;
504 my $intDot = 100 - length($strMainString) - length($strStatus);
505 VobPrint ($strMainString."."x$intDot."$strStatus\n",$intLevel);
506}
507
508sub TestEach
509{
510 my ($strModel,$strTest,$intLevel) = @_;
511 my @Errors = ();
512
513 $intLevel++;
514 if (-d $strModel && -d $strTest)
515 {
516 my @aryInModel = &diffutil::files_in_dir($strModel);
517 my @aryInTest = &diffutil::files_in_dir($strTest);
518 my @aryTwoPointers = FolderTesting(\@aryInModel,\@aryInTest,$strModel,$strTest,$intLevel);
519 my @aryCorrectFiles = @{$aryTwoPointers[1]};
520 @Errors = @{$aryTwoPointers[0]};
521
522 if(scalar(@Errors) == 0)
523 {
524 foreach my $strEachFile (@aryInModel)
525 {
526 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
527 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
528 if(!($strEachFile eq "log" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.(l|b)db$/g))
529 {
530 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
531 }
532 else
533 {
534 if ( $strOutputFormat eq "xml" ) {
535 print "<file-comparision location=\"$strEachFile\" blocked=\"yes\" succeeded=\"yes\"/>";
536 } else {
537 VobPrint ("Blocked File Report: Test \"$strEachFile\" by using -mode \"init\"\n",$intLevel);
538 }
539 }
540 }
541 }
542 else
543 {
544 foreach my $strEachFile (@aryCorrectFiles)
545 {
546 my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
547 my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
548 if(!($strEachFile eq "log" || $strEachFile =~ m/\.cfg$/g || $strEachFile =~ m/\.(l|b)db$/g))
549 {
550 push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel));
551 }
552 }
553 }
554 if($intLevel == $gv_intVerbosity)
555 {
556 if(scalar(@Errors) == 0){ AlignPrint("Contents Comparsion","Succeed",$intLevel);}
557 else { AlignPrint("Contents Comparsion","Failed",$intLevel);}
558 }
559 }
560 else
561 {
562 my $strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
563 $strResult = &diffutil::GenerateOutput($strResult,"^<Metadata name=\"lastmodified\">.*</Metadata>\$");
564 #$strResult = GeneralOutput($strResult);
565 if ( $strOutputFormat eq "xml" ) {
566 #
567 } else {
568 VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
569 }
570 if ($strResult eq "")
571 {
572 if ( $strOutputFormat eq "xml" ) {
573 print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
574 } else {
575 AlignPrint("Comparing File","Succeed",$intLevel);
576 }
577 }
578 else
579 {
580 my $strOutput = "Difference Report:\n$strResult\n";
581 if ( $strOutputFormat eq "xml" ) {
582 print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
583 } else {
584 AlignPrint("Comparing File","Failed",$intLevel);
585 }
586
587 $result=`file -b $strModel`;
588 if ( "$result" =~ "data" ) {
589 VobPrint( "These binary files differ", $intLevel );
590 } else {
591 VobPrint ( "$strOutput" , $intLevel);
592 }
593
594
595 if ( $strOutputFormat eq "xml" ) {
596 print "</message></file-comparison>";
597 }
598
599 if($gv_blnErrorStop ne "off") { exit; }
600 push(@Errors,"File content comparison failed($strModel):\n$strOutput");
601 }
602 }
603
604 return @Errors;
605}
606
607
608sub FolderTesting
609{
610 my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
611 my %hashCount = ();
612 my @Errors = ();
613 my @CorrectFiles = ();
614 my @TwoPointers = (\@Errors,\@CorrectFiles);
615
616 if ( $strOutputFormat eq "xml" ) {
617 #print "<folder-comparison location=\"$strModelFolder\">\n";
618 } else {
619 VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
620 }
621
622 foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
623 foreach my $strEachItem (@$aryptTest)
624 {
625 if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
626 else {$hashCount{$strEachItem} = 'T';}
627 }
628
629 if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
630 {
631 if ( $strOutputFormat eq "xml" ) {
632 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
633 } else {
634 AlignPrint("Folder Comparsion","Succeed",$intLevel);
635 }
636 return @TwoPointers;
637 }
638 else
639 {
640 if ( $strOutputFormat eq "xml" ) {
641 print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
642 } else {
643 AlignPrint("Folder Comparsion","Failed",$intLevel);
644 }
645
646 foreach my $strEachItem (keys %hashCount)
647 {
648 if($hashCount{$strEachItem} ne 'B')
649 {
650 my $strOutput = "";
651 my $strReport = "";
652
653 if($hashCount{$strEachItem} eq 'M')
654 {
655 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collcetion";
656 $strReport = "Difference Report: difference found at $strTestFolder";
657 }
658 elsif($hashCount{$strEachItem} eq 'T')
659 {
660 $strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collcetion";
661 $strReport = "Difference Report: difference found at $strModelFolder";
662 }
663 else {die "Error occours in diffcol_mk2::TestingFolder\n"}
664
665 VobPrint ("$strOutput\n",$intLevel);
666 $strOutput = $strOutput."\n\t".$strReport."\n";
667 push(@Errors,$strOutput);
668 }
669 else {push(@CorrectFiles,$strEachItem);}
670 }
671 if( $strOutputFormat eq "xml" ) {
672 print "</message></folder-comparison>";
673 }
674
675 return @TwoPointers;
676 }
677}
678
679sub VobPrint
680{
681 my ($strOutput, $intLevel) = @_;
682 my $strTab = "";
683 my $intTab = int($intLevel/2);
684 if($intLevel <= $gv_intVerbosity)
685 {
686 if($intLevel >= 1)
687 {
688 $strTab = "\t"x($intTab+1);
689 $strOutput =~ s/\n$//;
690 $strOutput =~ s/\n/\n$strTab/g;
691 #$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
692 }
693
694 if( $strOutputFormat eq "xml" ) {
695 $strOutput =~ s/&/&amp;/g;
696 $strOutput =~ s/</&lt;/g;
697 $strOutput =~ s/>/&gt;/g;
698 }
699
700 if ( length( $strOutput ) > 1000 ) {
701 $strOutput = substr( $strOutput, 0, 978) . "... (output truncated)";
702 }
703
704
705 print $strTab.$strOutput."\n";
706 }
707}
708#----##
709
710
711#--Main System----------------------------
712#-----------------------------------------
713# Name: main
714# Perameters: arguments from command line
715# Pre-condition: testing will start by calling this main function.
716# Post-condition: output the test results for one or more collections.
717#-----------------------------------------
718sub main
719{
720 my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
721 my $strProgName = $0;
722 my $intArgc = scalar(@ARGV);
723
724 #--System Arguments Setup
725 if (!parsargv::parse(\@ARGV,
726 'estop//off', \$strErrorStop,
727 'eshow//off', \$strErrorShow,
728 'verbosity/\d+/1', \$intVerbosity,
729 'mode/[\w\-]+/all', \$strMode,
730 'output/[\w\-]+/text', \$strOutputFormat
731 )) {
732 PrintUsage($strProgName);
733 die "\n";
734 }
735
736 if ($intArgc<1) {
737 PrintUsage($strProgName);
738 die "\n";
739 }
740
741 $gv_blnErrorStop = $strErrorStop;
742 $gv_blnErrorShow = $strErrorShow;
743 $gv_intVerbosity = $intVerbosity;
744 $gv_strMode = SetMode($strMode);
745
746 #----##
747
748 #--Collection(s) Testing
749 foreach $strColName (@ARGV)
750 {
751 my @ErrorsInEachCol;
752 my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
753 my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
754
755 #--Output(Start)
756 OutputStart($strColName);
757 #----##
758
759 if(-e $strModelCol && -e $strTestCol )
760 {
761
762 #--Individual Testing
763 if ($gv_strMode eq "Individual")
764 {
765 @ErrorsInEachCol = IndivTest($strModelCol,$strTestCol);
766 }
767 #----##
768
769 #--Initial Testing
770 elsif ($gv_strMode eq "Initial")
771 {
772 @ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
773 }
774 #----##
775
776 #--Full Testing
777 elsif ($gv_strMode eq "Full")
778 {
779 @ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
780 }
781 #----##
782
783 #--Error Checking
784 else
785 {
786 if ( $strOutputFormat eq "xml" ) {
787 die "<error>Error occoured in main function</error>\n";
788 } else {
789 die "Error occoured in main function.\n";
790 }
791 }
792 #----##
793
794 }
795 else
796 {
797 if( $strOutputFormat eq "xml" ) {
798 die "<error>Cannot find collection: $strColName</error>\n";
799 } else {
800 die "Error: cannot find collection: $strColName\n";
801 }
802 }
803 #----##
804
805 #--Output(Results and Errors)
806 OutputEnd($strColName,\@ErrorsInEachCol);
807 #----##
808
809 }
810}
811#----##
812
813&main();
Note: See TracBrowser for help on using the repository browser.