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

Last change on this file since 21713 was 21711, checked in by oranfry, 14 years ago

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