Context Navigation

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

Last change on this file since 27969 was 27969, checked in by ak19, 11 years ago
When test-running diffcol on the Enhanced-PDF tutorial, it would choke on intermediate ~ files, the cached directory (see previous commit), and the FileSize metadata could differ slightly between OS. Further, the XSLT processing of the report would break if error messages were truncated at an incomplete entity (& symbol) since it becomes invalid xml.
File size: 31.1 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
30	package diffcol_mk2;
31
32	BEGIN {
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
39	use parsargv;
40	use util;
41	use FileUtils;
42	use logdiff;
43	use cfgdiff;
44	use gdbdiff;
45	use diffutil;
46	use Text::Diff;
47	use Cwd;
48
49	#--Global Variables Declaration-----------
50	$gv_strModelColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/model-collect");
51	$gv_strTestColRoot = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"/collect");
52
53	$gv_blnErrorStop = "false";
54	$gv_blnErrorShow = "false";
55	$gv_intVerbosity = 0;
56	$gv_strMode = "Full";
57	$strOutputFormat = "xml" unless defined $strOutputFormat; # global var with default
58
59	%gv_IndivList = ("archives" => 0,
60	"etc" => 0,
61	"images" => 0,
62	"building" => 0,
63	"import" => 0,
64	"index" => 0,
65	"log" => 0,
66	"metadata" => 0,
67	"perllib" => 0,
68	"temp" => 0);
69	#----##
70
71	#--System Setup---------------------------
72	sub SetMode
73	{
74	my ($strModeList) = @_;
75	$strModeList =~ s/\\|/ /g;
76	my @Modes = split(" ",$strModeList);
77
78	my $blnIndividual = "true";
79	my $blnInitial = "false";
80	my $blnFull = "false";
81
82
83	foreach $strEachMode (@Modes)
84	{
85	if($strEachMode eq "all")
86	{
87	$blnFull = "true";
88	$blnIndividual = "false";
89	}
90	elsif($strEachMode eq "init")
91	{
92	$blnInitial = "true";
93	$blnIndividual = "false";
94	}
95	else
96	{
97	if(defined $gv_IndivList{$strEachMode})
98	{
99	$gv_IndivList{$strEachMode} = 1;
100	}
101	else
102	{
103	die Help("Error: used undefined mode");
104	}
105	}
106	}
107
108	if($blnFull eq "true") {return "Full";}
109	elsif($blnInitial eq "true") {return "Initial";}
110	elsif($blnIndividual eq "true") {return "Individual";}
111	else {die "Error occured in function SetMode!!\n";}
112	}
113	#----##
114
115	#--System Process-------------------------
116	sub IndivTest
117	{
118	my ($strModelCol,$strTestCol,$strColName) = @_;
119	my @Errors = ();
120	my $intNumberOfErrors = 0;
121	foreach $strEachFolder (keys %gv_IndivList)
122	{
123	if($gv_IndivList{$strEachFolder} == 1)
124	{
125
126	VobPrint("Start Comparing \"$strEachFolder\"\n",0);
127	my $strModelFolder = &FileUtils::filenameConcatenate($strModelCol,$strEachFolder);
128	my $strTestFolder = &FileUtils::filenameConcatenate($strTestCol,$strEachFolder);
129	$intNumberOfErrors = scalar(@Errors);
130	push(@Errors,TestEach($strModelFolder,$strTestFolder,0,$strColName));
131	$intNumberOfErrors = scalar(@Errors) - $intNumberOfErrors;
132	VobPrint("End Comparing \"$strEachFolder\"\n",0);
133	VobPrint("Difference Found: $intNumberOfErrors\n",0);
134	VobPrint ("\n",0);
135	}
136	}
137	return @Errors;
138	}
139
140	sub InitTest
141	{
142
143	my ($strModelCol,$strTestCol,$strColName) = @_;
144	my $intLevel = 1;
145	my @Errors;
146
147	# Testing Log files
148	# my $strModelLog = &FileUtils::filenameConcatenate($strModelCol,"log");
149	# my $strTestLog = &FileUtils::filenameConcatenate($strTestCol,"log");
150	#
151	# if(-e $strModelLog && -e $strTestLog)
152	# {
153	# my $strLogError = logdiff::test_log($strModelLog,$strTestLog);
154	# if($strLogError ne "")
155	# {
156	# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
157	# VobPrint ("$strLogError\n",$intLevel);
158	#
159	# $strLogError = "$strLogError";
160	# $strLogError = "Difference Found at Log Folder Testing\n".$strLogError."\n";
161	# push(@Errors,$strLogError);
162	# }
163	# else
164	# {
165	# AlignPrint("Log Folder Comparison Result","Succeed",$intLevel);
166	# }
167	# }
168	# else
169	# {
170	# my $strErrorColName;
171	# my $strLogError;
172	#
173	# if(!(-e $strModelLog)){ $strErrorColName = $strErrorColName."(Model Collection)";}
174	# if(!(-e $strTestLog)){ $strErrorColName = $strErrorColName."(Test Collection)";}
175	#
176	# AlignPrint("Log Folder Comparison Result","Failed",$intLevel);
177	# $strLogError = "Difference Report: No Log Folder found in $strErrorColName";
178	# VobPrint ("$strLogError\n",$intLevel);
179	# $strLogError = "Difference Found at Log Folder Testing (Log folders are only created using GLI)\n".$strLogError."\n";
180	#
181	# push(@Errors,$strLogError);
182	# }
183	# VobPrint ("\n",$intLevel);
184
185	# Testing the build.cfg
186	my $strModelBcfg = &FileUtils::filenameConcatenate($strModelCol,"index","build.cfg");
187	my $strTestBcfg = &FileUtils::filenameConcatenate($strTestCol,"index","build.cfg");
188
189	if(-e $strModelBcfg && -e $strTestBcfg)
190	{
191	my $strBcfgError = cfgdiff::test_cfg($strModelBcfg,$strTestBcfg,"build.cfg");
192	if($strBcfgError ne "")
193	{
194	if( $strOutputFormat eq "xml" ) {
195	print "<build-cfg succeeded=\"no\">\n<message>";
196	} else {
197	AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
198	}
199
200	VobPrint ("$strBcfgError",$intLevel);
201	if( $strOutputFormat eq "xml" ) {
202	print "</message></build-cfg>";
203	}
204
205	$strBcfgError = "$strBcfgError";
206	$strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
207	push(@Errors,$strBcfgError);
208	}
209	else
210	{
211	if( $strOutputFormat eq "xml" ) {
212	print "<build-cfg succeeded=\"yes\"/>";
213	} else {
214	AlignPrint("Config File(build.cfg) Comparison Result","Succeed",$intLevel);
215	}
216	}
217	}
218	else
219	{
220	my $strErrorColName;
221	my $strBcfgError;
222
223	if(!(-e $strModelBcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
224	if(!(-e $strTestBcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
225
226	AlignPrint("Config File(build.cfg) Comparison Result","Failed",$intLevel);
227	$strBcfgError = "Difference Report: No Config files found in $strErrorColName";
228	VobPrint ("$strBcfgError\n",$intLevel);
229	$strBcfgError = "Difference Found at Config File(build.cfg) Comparison\n".$strBcfgError."\n";
230
231	push(@Errors,$strBcfgError);
232	}
233	VobPrint ("\n",$intLevel);
234
235	# Testing the collect.cfg
236
237	my $strModelCcfg = &FileUtils::filenameConcatenate($strModelCol,"etc","collect.cfg");
238	my $strTestCcfg = &FileUtils::filenameConcatenate($strTestCol,"etc","collect.cfg");
239
240	if(-e $strModelCcfg && -e $strTestCcfg)
241	{
242	my $strCcfgError = cfgdiff::test_cfg($strModelCcfg,$strTestCcfg,"collect.cfg");
243	if($strCcfgError ne "")
244	{
245	if( $strOutputFormat eq "xml" ) {
246	print "<collect-cfg succeeded=\"no\"><message>";
247	} else {
248	AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
249	}
250
251	VobPrint ("$strCcfgError",$intLevel);
252
253	if( $strOutputFormat eq "xml" ) {
254	print "</message></collect-cfg>";
255	}
256
257	$strCcfgError = "$strCcfgError";
258	$strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
259	push(@Errors,$strCcfgError);
260	}
261	else
262	{
263	if( $strOutputFormat eq "xml" ) {
264	print "<collect-cfg succeeded=\"yes\"/>";
265	} else {
266	AlignPrint("Config File(collect.cfg) Comparison Result","Succeed",$intLevel);
267	}
268	}
269	}
270	else
271	{
272	my $strErrorColName;
273	my $strCcfgError;
274
275	if(!(-e $strModelCcfg)){ $strErrorColName = $strErrorColName."(Model Collection)";}
276	if(!(-e $strTestCcfg)){ $strErrorColName = $strErrorColName."(Test Collection)";}
277
278	AlignPrint("Config File(collect.cfg) Comparison Result","Failed",$intLevel);
279	$strCcfgError = "Difference Report: No Config files found in $strErrorColName";
280	VobPrint ("$strCcfgError\n",$intLevel);
281	$strCcfgError = "Difference Found at Config File(collect.cfg) Comparison\n".$strCcfgError."\n";
282
283	push(@Errors,$strCcfgError);
284	}
285
286	VobPrint ("\n",$intLevel);
287
288	# Testing databases
289
290	# index
291	my $strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"index","text","$strColName.gdb");
292	my $strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"index","text","$strColName.gdb");
293	my $strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName); # returns 0 if no error
294	if($strGdbError) {
295	push(@Errors,$strGdbError);
296	}
297
298	# archives
299	$strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"archives","archiveinf-doc.gdb");
300	$strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"archives","archiveinf-doc.gdb");
301	$strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName);
302	if($strGdbError) {
303	push(@Errors,$strGdbError);
304	}
305
306	$strModelGdb = &FileUtils::filenameConcatenate($strModelCol,"archives","archiveinf-src.gdb");
307	$strTestGdb = &FileUtils::filenameConcatenate($strTestCol,"archives","archiveinf-src.gdb");
308	$strGdbError = &GdbDiff($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName);
309	if($strGdbError) {
310	push(@Errors,$strGdbError);
311	}
312
313	VobPrint ("\n",$intLevel);
314
315	return @Errors;
316	}
317
318
319	# At present handles gdbm - need to expand to allow for jdbm and other db types
320	sub GdbDiff
321	{
322	my ($strModelGdb,$strTestGdb,$strOutputFormat,$intLevel,$strColName) = @_;
323
324	my $strGdbError = 0;
325
326	if(-e $strModelGdb && -e $strTestGdb)
327	{
328	#my $strGdbError = gdbdiff::test_gdb($strModelGdb, $strTestGdb);
329	$strGdbError = gdbdiff::test_gdb($strModelGdb, $strTestGdb,$strColName);
330	if($strGdbError ne "")
331	{
332	if( $strOutputFormat eq "xml" ) {
333	print "<database succeeded=\"no\" location=\"$strModelGdb\"><message>";
334	} else {
335	AlignPrint("Database Comparsion Result","Failed",$intLevel);
336	}
337	VobPrint ("$strGdbError\n",$intLevel);
338
339	if( $strOutputFormat eq "xml" ) {
340	print "</message></database>";
341	}
342
343	$strGdbError = "$strGdbError";
344	$strGdbError = "Difference Found at Database Comparsion\n".$strGdbError."\n";
345	#push(@Errors,$strGdbError);
346	}
347	else
348	{
349	if( $strOutputFormat eq "xml" ) {
350	print "<database succeeded=\"yes\" location=\"$strModelGdb\"/>";
351	} else {
352	AlignPrint("Database Comparsion Result","Succeed",$intLevel);
353	}
354	}
355	}
356	else
357	{
358	my $strErrorColName;
359
360	if(!(-e $strModelGdb)){ $strErrorColName = $strErrorColName."(Model Collection)";}
361	if(!(-e $strTestGdb)){ $strErrorColName = $strErrorColName."(Test Collection)";}
362
363	AlignPrint("Database Comparsion Result","Failed",$intLevel);
364
365	$strGdbError = "Difference Report: No Database files found in $strErrorColName";
366	VobPrint ("$strGdbError\n",$intLevel);
367
368	$strGdbError = "Difference Found at Database Comparison\n".$strGdbError."\n";
369
370	}
371
372	return $strGdbError;
373	}
374
375	sub FullTest
376	{
377	my ($strModelCol,$strTestCol,$strColName) = @_;
378	my @Errors = ();
379	my $intLevel = 0;
380	my $intNumberDiffs = 0;
381
382	# <Initial Test>
383	if( $strOutputFormat eq "xml" ) {
384	#print "<initial-test>";
385	} else {
386	VobPrint("Initial Testing Start\n",$intLevel);
387	}
388
389	@Errors = InitTest($strModelCol,$strTestCol,$strColName);
390	$intNumberDiffs = scalar(@Errors);
391
392	if( $strOutputFormat eq "xml" ) {
393	#print "</initial-test>";
394	} else {
395	VobPrint("Initial Testing End\n",$intLevel);
396	VobPrint("Difference Found in Initial Testing: $intNumberDiffs\n",$intLevel);
397	VobPrint("\n",$intLevel);
398	}
399	# </Initial Test>
400
401	# <Detailed Test>
402	if( $strOutputFormat eq "xml" ) {
403	#print "<detailed-test>";
404	} else {
405	VobPrint("Detail Testing Start\n",$intLevel);
406	}
407	push(@Errors,TestEach($strModelCol,$strTestCol,$intLevel,$strColName));
408	$intNumberDiffs = scalar(@Errors) - $intNumberDiffs;
409
410	if( $strOutputFormat eq "xml" ) {
411	#print "</detailed-test>";
412	} else {
413	VobPrint("Detail Testing End\n",$intLevel);
414	VobPrint("Difference Found in Detail Testing: $intNumberDiffs\n",$intLevel);
415	}
416	# </Detailed Test>
417
418	return @Errors;
419	}
420	#----##
421
422
423	#--Other System Utilities
424	sub PrintUsage
425	{
426	my ($strProgName) = @_;
427	if ( $strOutputFormat eq "xml" ) {
428	print "<error>usage incorrect</error>\n";
429	} else {
430	print STDERR "Usage: $strProgName test-col [more-col] [-verbosity d] [-mode modes] [-eshow] [-estop]\n";
431	}
432	Help("Error: used incorrect parameters");
433	}
434
435	sub Help
436	{
437	my ($strError) = @_;
438	my $aryptHelps =
439	[ { 'name' => "verbosity",
440	'type' => "scale",
441	'argu' => "a integer" ,
442	'descrip' => "this parameter setup the verbosity of the testing result"},
443	{ 'name' => "mode",
444	'type' => "option",
445	'argu' => "mode type \"[all\|init\|archives\|building\|etc\|images\|import\|index\|perllib\|tmp]\" default to \"all\"" ,
446	'descrip' => "setup testing mode: all-full testing, init-initial testing (include configuration file test,database testing and log testing), others-for individual folder testing"},
447	{ 'name' => "estop",
448	'type' => "flag",
449	'argu' => "NULL" ,
450	'descrip' => "Set then system will stop once it meet an error"},
451	{ 'name' => "eshow",
452	'type' => "flag",
453	'argu' => "NULL" ,
454	'descrip' => "Set then system will show the error summary"}
455	];
456
457
458	if ( $strOutputFormat ne "xml" ) {
459	print "$strError\n";
460
461	foreach my $hashOneArg (@{$aryptHelps})
462	{
463	print "\n----------------------------\n";
464	print "Parameters: -".$hashOneArg->{"name"}."\n";
465	print "Type: ".$hashOneArg->{"type"}."\n";
466	print "Supply Argument: ".$hashOneArg->{"argu"}."\n";
467	print "Description: ".$hashOneArg->{"descrip"}."\n";
468	print "----------------------------\n";
469	}
470	}
471	}
472
473	sub OutputStart
474	{
475	my ($strColName) = @_;
476	my $intPadding = 17 - length($strColName);
477
478	if ( $strOutputFormat eq "xml" ) {
479	print "<diffcol>\n";
480	} else {
481	print "+---------------------------------------------------------+\n";
482	print "\| \|\n";
483	print "\| Start Testing Collection: $strColName"," " x $intPadding,"\|\n";
484	print "\| \|\n";
485	print "+---------------------------------------------------------+\n\n";
486	}
487	}
488
489	sub OutputEnd
490	{
491	my ($strColName,$aryptErrors) = @_;
492	my $intPadding = 12 - length($strColName);
493	if ( $strOutputFormat eq "xml" ) {
494	print "</diffcol>\n";
495	} else {
496	print "\n";
497	print "+---------------------------------------------------------+\n";
498	print "\| \|\n";
499	print "\| Result of Collection Testing: $strColName"," " x $intPadding,"\|\n";
500	print "\| \|\n";
501	print "+---------------------------------------------------------+\n\n";
502	}
503
504	my $intTotalErrors = scalar(@{$aryptErrors});
505	if ( $strOutputFormat ne "xml" ) {
506	print "Checking completed, there is $intTotalErrors error(s) found.\n";
507	}
508
509	if($gv_blnErrorShow ne "off")
510	{
511	foreach my $strEachError (@{$aryptErrors})
512	{
513	if ( $strOutputFormat eq "xml" ) {
514	print "<error>";
515	print $strEachError;
516	print "</error>\n";
517	} else {
518	print "+---------------------------------------------------------+\n";
519	print "\| Error \|\n";
520	print "+---------------------------------------------------------+\n\n";
521	print "$strEachError\n\n";
522	}
523	}
524	}
525	else
526	{
527	if ( $strOutputFormat ne "xml" ) {
528	print "Use -eshow to show the error detail\n\n";
529	}
530	}
531	}
532
533	sub AlignPrint
534	{
535	my ($strMainString,$strStatus,$intLevel) = @_;
536	my $intDot = 100 - length($strMainString) - length($strStatus);
537	VobPrint ($strMainString."."x$intDot."$strStatus\n",$intLevel);
538	}
539
540
541	# this function is only called on DocXMLFiles.
542	# so far, only doc.xml files need special Windows processing (db files' OS-sensitivity are handled in gdbdiff.pm)
543	# Returns true if the doc.xml contains windows style slashes in the gsdlsourcefilename meta field
544	sub isDocXMLFileWindows
545	{
546	my ($file_contents) = @_;
547
548	#return ($file_contents =~ m/\\/) ? 1 : 0; # windows slashes detected.
549
550	# Is this a better test? look for gsdlsourcefilename, see if it contains windows slashes.
551	# what if $gsdlsourcefilename is not guaranteed to exist in all doc.xml files?
552
553	# for doc.xml:
554	# <Metadata name="gsdlsourcefilename">import/html_files/cleves.html</Metadata>
555	if($file_contents =~ m@<Metadata name="gsdlsourcefilename">([^>]*)</Metadata>@m) {
556	$gsdlsourcefilename = $1;
557	if($gsdlsourcefilename =~ m/\\/) { # windows slashes detected.
558	return 1;
559	}
560	}
561
562	return 0;
563	}
564
565	sub TestEach
566	{
567	my ($strModel,$strTest,$intLevel,$strColName) = @_;
568	my @Errors = ();
569
570	$intLevel++;
571	if (-d $strModel && -d $strTest)
572	{
573	my @aryInModel = &diffutil::files_in_dir($strModel);
574	my @aryInTest = &diffutil::files_in_dir($strTest);
575
576	# Files to be skipped because they get generated on one OS but not the other
577	# On windows, files of the form col.invf.state.\d\d\d\d get generated (e.g. Small-HTML.invf.state.1228) that aren't there on linux
578	my $skipfiles_re = qr/(\.invf\.state\.\d+$)\|~$/; # Create a regex of all files to be skipped, see http://perldoc.perl.org/perlop.html
579	@aryInModel = grep { $_ !~ m/$skipfiles_re/ } @aryInModel; # http://stackoverflow.com/questions/174292/what-is-the-best-way-to-delete-a-value-from-an-array-in-perl
580	@aryInTest = grep { $_ !~ m/$skipfiles_re/ } @aryInTest;
581
582	# Now check all remaining files in the folder exist in both model and test collections
583	my @aryTwoPointers = FolderTesting(\@aryInModel,\@aryInTest,$strModel,$strTest,$intLevel);
584	my @aryCorrectFiles = @{$aryTwoPointers[1]};
585	@Errors = @{$aryTwoPointers[0]};
586
587	if(scalar(@Errors) == 0)
588	{
589	foreach my $strEachFile (@aryInModel)
590	{
591	my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
592	my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
593	# now additionally ignoring the earliestDatestamp file and the index/idx/*.idh binary file when diffing file
594	if(!($strEachFile eq "log" \|\| $strEachFile eq "earliestDatestamp" \|\| $strEachFile =~ m/\.cfg$/g \|\| $strEachFile =~ m/collect\.bak$/g \|\| $strEachFile =~ m/\.((g\|j\|l\|b)db\|idh\|i.*\|wa\|td\|tsd\|ti\|t\|tl\|w\|jpe?g\|gif\|png\|wmf)$/g)) # wmf = windows meta file # \|\| $strEachFile =~ m/\~$/g to get rid of ~ files
595	{
596	push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
597	}
598	else
599	{
600	if ( $strOutputFormat eq "xml" ) {
601	print "<file-comparision location=\"$strEachFile\" blocked=\"yes\" succeeded=\"yes\"/>";
602	} else {
603	VobPrint ("Blocked File Report: Test \"$strEachFile\" by using -mode \"init\"\n",$intLevel);
604	}
605	}
606	}
607	}
608	else
609	{
610	foreach my $strEachFile (@aryCorrectFiles)
611	{
612	my $strNewModel = &FileUtils::filenameConcatenate($strModel,$strEachFile);
613	my $strNewTest = &FileUtils::filenameConcatenate($strTest,$strEachFile);
614	if(!($strEachFile eq "log" \|\| $strEachFile eq "earliestDatestamp" \|\| $strEachFile =~ m/\.cfg$/g \|\| $strEachFile =~ m/collect\.bak$/g \|\| $strEachFile =~ m/\.((g\|j\|l\|b)db\|idh\|i.*\|wa\|td\|tsd\|ti\|t\|tl\|w\|jpe?g\|gif\|png\|wmf)$/g)) # \|\| $strEachFile =~ m/\~$/g to get rid of ~ files
615	{
616	push(@Errors,TestEach($strNewModel,$strNewTest,$intLevel,$strColName));
617	}
618	}
619	}
620	if($intLevel == $gv_intVerbosity)
621	{
622	if(scalar(@Errors) == 0){ AlignPrint("Contents Comparsion","Succeed",$intLevel);}
623	else { AlignPrint("Contents Comparsion","Failed",$intLevel);}
624	}
625	}
626	else
627	{
628	my $ignore_line_re = "<Metadata name=\"(lastmodified\|lastmodifieddate\|oailastmodified\|oailastmodifieddate\|ex.File.FileModifyDate\|ex.File.FilePermissions\|ImageSize)\">.</Metadata>\\s\\n*";
629
630	my $strResult;
631
632	# for doc.xml files, need to ignore many date fields. Filter these out before diffing,
633	# in case these don't appear in the same order between collections, since
634	# diffutil::GenerateOutput only handles the ignore_regex after a diff has been done
635	# when they can show up as unnecessary diff 'errors'
636	if($strModel =~ m/doc\.xml$/) {
637	my ($model_contents, $test_contents);
638	open(FIN,"<$strModel") or die "Unable to open $strModel...ERROR: $!\n";
639	sysread(FIN, $model_contents, -s FIN);
640	close(FIN);
641	open(FIN,"<$strTest") or die "Unable to open $strTest...ERROR: $!\n";
642	sysread(FIN, $test_contents, -s FIN);
643	close(FIN);
644
645	$model_contents =~ s/$ignore_line_re//g;
646	$test_contents =~ s/$ignore_line_re//g;
647
648
649	# equalise/normalise the two doc.xml files for OS differences, if there are any
650	my $testIsWin = &isDocXMLFileWindows($test_contents);
651	my $modelIsWin = &isDocXMLFileWindows($model_contents);
652
653	if($testIsWin != $modelIsWin) { # one of the 2 collections is built on windows, the other on linux, so need to make newlines constant
654
655	my $win_contents = $testIsWin ? \$test_contents : \$model_contents;
656
657	# remove all carriage returns \r - introduced into doc.xml by multiread after pdf converted to html
658	$$win_contents =~ s@[\r]@@g;
659
660	# make all single windows slashes into single unix slashes
661	$$win_contents =~ s@([^\\])\\([^\\])@$1\/$2@g;
662	# make windows \r newlines into constant \n newlines. Already handled when \r got replaced
663	#$$win_contents =~ s@\r\n@\n@mg; # #http://stackoverflow.com/questions/650743/in-perl-how-to-do-you-remove-m-from-a-file
664
665	#FOR MAC: old macs use CR carriage return (see http://www.perlmonks.org/?node_id=745018), so replace with \n?)
666	# $$win_contents =~ s@\r@\n@mg;
667	}
668
669
670	# tmp dirs have subdirs with random numbers in name, remove randomly named subdir portion of path
671	# these tmpdirs are located inside the collection directory
672	$model_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
673	$test_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
674
675	# remove all absolute paths upto collect folder from <Metadata /> elements
676	$model_contents =~ s@(<Metadata name=\"[^\"]\">(http:\/\/)?).(collect[\\\/]$strColName)@$1$3@g;
677	$test_contents =~ s@(<Metadata name=\"[^\"]\">(http:\/\/)?).(collect[\\\/]$strColName)@$1$3@g;
678
679	# The following block of code is necessary to deal with tmp (html) source files generated when using PDFBox
680	# These tmpdirs are located inside the toplevel greenstone directory
681	(my $gsdlhome_re = $ENV{'GSDLHOME'}) =~ s@\\@\/@g;
682	$gsdlhome_re = ".*" unless $$ENV{'GSDLHOME'};
683	my $tmpfile_regex = "<Metadata name=\"URL\">http://$gsdlhome_re/tmp/([^\.]*)(\..{3,4})</Metadata>"; # $gsdlhome/tmp/randomfilename.html, file ext can be 3 or 4 chars long
684	if($test_contents =~ m@$tmpfile_regex@) {
685	# found a match, replace the tmp file name with "random", keeping the original file extension
686	# in <Metadata name="OrigSource\|URL\|UTF8URL\|gsdlconvertedfilename">
687
688	my ($old_tmp_filename, $ext) = ($1, $2);
689	my $new_tmp_filename = "random";
690
691	$tmpfile_regex = "(<Metadata name=\"(URL\|UTF8URL\|gsdlconvertedfilename\|OrigSource)\">(http://)?)($gsdlhome_re)?(/tmp/)?$old_tmp_filename($ext</Metadata>)";
692	if($5) {
693	$test_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
694	} else { # OrigSource contains only the filename
695	$test_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
696	}
697
698	# modelcol used a different gsdlhome, but also a tmp dir, so make the same changes to its random filename
699	$tmpfile_regex = "(<Metadata name=\"(URL\|UTF8URL\|gsdlconvertedfilename\|OrigSource)\">(http://)?)(.)?(/tmp/)?.($ext</Metadata>)";
700	if($5) {
701	$model_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
702	} else { # OrigSource contains only the filename
703	$model_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
704	}
705	}
706
707	# my $savepath = &getcwd."/../"; # TASK_HOME env var does not exist at this stage, but it's one level up from current directory
708	# &gdbdiff::print_string_to_file($model_contents, $savepath."model_doc.xml");
709	# &gdbdiff::print_string_to_file($test_contents, $savepath."test_doc.xml");
710
711	$strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
712
713	} else {
714	$strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
715	}
716
717	# The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
718	# these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
719	$strResult = &diffutil::GenerateOutput($strResult,"^\\s<Metadata name=\"(lastmodified\|lastmodifieddate\|oailastmodified\|oailastmodifieddate)\">.</Metadata>\\s*\$");
720
721	#$strResult = GeneralOutput($strResult);
722	if ( $strOutputFormat eq "xml" ) {
723	#
724	} else {
725	VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
726	}
727	if ($strResult eq "")
728	{
729	if ( $strOutputFormat eq "xml" ) {
730	print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
731	} else {
732	AlignPrint("Comparing File","Succeed",$intLevel);
733	}
734	}
735	else
736	{
737	# print STDERR "**** Diff is: $strResult\n"; # print any differences to the screen
738
739	my $strOutput = "Difference Report:\n$strResult\n";
740	if ( $strOutputFormat eq "xml" ) {
741	print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
742	} else {
743	AlignPrint("Comparing File","Failed",$intLevel);
744	}
745
746	#$result=`file -b $strModel`; # linux specific test for binary file
747	$result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
748	if ( "$result" =~ "data" ) {
749	VobPrint( "These binary files differ", $intLevel );
750	} else {
751	VobPrint ( "$strOutput" , $intLevel);
752	}
753
754
755	if ( $strOutputFormat eq "xml" ) {
756	print "</message></file-comparison>";
757	}
758
759	if($gv_blnErrorStop ne "off") { exit; }
760	push(@Errors,"File content comparison failed($strModel):\n$strOutput");
761	}
762	}
763
764	return @Errors;
765	}
766
767
768	sub FolderTesting
769	{
770	my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
771	my %hashCount = ();
772	my @Errors = ();
773	my @CorrectFiles = ();
774	my @TwoPointers = (\@Errors,\@CorrectFiles);
775
776	if ( $strOutputFormat eq "xml" ) {
777	#print "<folder-comparison location=\"$strModelFolder\">\n";
778	} else {
779	VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
780	}
781
782	foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
783	foreach my $strEachItem (@$aryptTest)
784	{
785	if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
786	else {$hashCount{$strEachItem} = 'T';}
787	}
788
789	if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
790	{
791	if ( $strOutputFormat eq "xml" ) {
792	print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
793	} else {
794	AlignPrint("Folder Comparsion","Succeed",$intLevel);
795	}
796	return @TwoPointers;
797	}
798	else
799	{
800	if ( $strOutputFormat eq "xml" ) {
801	print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
802	} else {
803	AlignPrint("Folder Comparsion","Failed",$intLevel);
804	}
805
806	foreach my $strEachItem (keys %hashCount)
807	{
808	if($hashCount{$strEachItem} ne 'B')
809	{
810	my $strOutput = "";
811	my $strReport = "";
812
813	if($hashCount{$strEachItem} eq 'M')
814	{
815	$strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
816	$strReport = "Difference Report: difference found at $strTestFolder";
817	}
818	elsif($hashCount{$strEachItem} eq 'T')
819	{
820	$strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
821	$strReport = "Difference Report: difference found at $strModelFolder";
822	}
823	else {die "Error occours in diffcol_mk2::TestingFolder\n"}
824
825	VobPrint ("$strOutput\n",$intLevel);
826	$strOutput = $strOutput."\n\t".$strReport."\n";
827	push(@Errors,$strOutput);
828	}
829	else {push(@CorrectFiles,$strEachItem);}
830	}
831	if( $strOutputFormat eq "xml" ) {
832	print "</message></folder-comparison>";
833	}
834
835	return @TwoPointers;
836	}
837	}
838
839	sub VobPrint
840	{
841	my ($strOutput, $intLevel) = @_;
842	my $strTab = "";
843	my $intTab = int($intLevel/2);
844	if($intLevel <= $gv_intVerbosity)
845	{
846	if($intLevel >= 1)
847	{
848	$strTab = "\t"x($intTab+1);
849	$strOutput =~ s/\n$//;
850	$strOutput =~ s/\n/\n$strTab/g;
851	#$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
852	}
853
854	if( $strOutputFormat eq "xml" ) {
855	$strOutput =~ s/&/&/g;
856	$strOutput =~ s/</</g;
857	$strOutput =~ s/>/>/g;
858	}
859
860	if ( length( $strOutput ) > 1000 ) {
861	$strOutput = substr( $strOutput, 0, 978);
862
863	# make sure there are no stray ampersands/partial ampersands that need to be completed as < or >
864	if($strOutput =~ m/&(.{1,2})?$/) { # &lt => < or &g => >
865	if(defined $1 && $1) {
866	my $rest = $1;
867	if($rest eq "g" \|\| $rest eq "l") {
868	$strOutput .= "t;"; # close the known tag
869	}
870	elsif($1 eq "gt" \|\| $1 eq "lt") {
871	$strOutput .= ";";
872	}
873	} else { # & on its own
874	#$strOutput = substr( $strOutput, 0, 977); # lop off the &
875	$strOutput .= "gt;"; # 50% chance the closing tag is what was missing (else can make this &)
876	# but even so, when the xslt is applied to report it doesn't break as long as & is not left dangling
877	}
878	}
879	$strOutput .= "... (output truncated)";
880	}
881
882
883	print $strTab.$strOutput."\n";
884	}
885	}
886	#----##
887
888
889	#--Main System----------------------------
890	#-----------------------------------------
891	# Name: main
892	# Perameters: arguments from command line
893	# Pre-condition: testing will start by calling this main function.
894	# Post-condition: output the test results for one or more collections.
895	#-----------------------------------------
896	sub main
897	{
898	my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
899	my $strProgName = $0;
900	my $intArgc = scalar(@ARGV);
901
902	#--System Arguments Setup
903	if (!parsargv::parse(\@ARGV,
904	'estop//off', \$strErrorStop,
905	'eshow//off', \$strErrorShow,
906	'verbosity/\d+/1', \$intVerbosity,
907	'mode/[\w\-]+/all', \$strMode,
908	'output/[\w\-]+/text', \$strOutputFormat
909	)) {
910	PrintUsage($strProgName);
911	die "\n";
912	}
913
914	if ($intArgc<1) {
915	PrintUsage($strProgName);
916	die "\n";
917	}
918
919	$gv_blnErrorStop = $strErrorStop;
920	$gv_blnErrorShow = $strErrorShow;
921	$gv_intVerbosity = $intVerbosity;
922	$gv_strMode = SetMode($strMode);
923
924	#----##
925
926	#--Collection(s) Testing
927	foreach $strColName (@ARGV)
928	{
929	my @ErrorsInEachCol;
930	my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
931	my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
932
933	#--Output(Start)
934	OutputStart($strColName);
935	#----##
936
937	if(-e $strModelCol && -e $strTestCol )
938	{
939
940	#--Individual Testing
941	if ($gv_strMode eq "Individual")
942	{
943	@ErrorsInEachCol = IndivTest($strModelCol,$strTestCol,$strColName);
944	}
945	#----##
946
947	#--Initial Testing
948	elsif ($gv_strMode eq "Initial")
949	{
950	@ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
951	}
952	#----##
953
954	#--Full Testing
955	elsif ($gv_strMode eq "Full")
956	{
957	@ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
958	}
959	#----##
960
961	#--Error Checking
962	else
963	{
964	if ( $strOutputFormat eq "xml" ) {
965	die "<error>Error occoured in main function</error>\n";
966	} else {
967	die "Error occoured in main function.\n";
968	}
969	}
970	#----##
971
972	}
973	else
974	{
975	if( $strOutputFormat eq "xml" ) {
976	die "<error>Cannot find collection: $strColName</error>\n";
977	} else {
978	die "Error: cannot find collection: $strColName\n";
979	}
980	}
981	#----##
982
983	#--Output(Results and Errors)
984	OutputEnd($strColName,\@ErrorsInEachCol);
985	#----##
986
987	}
988	}
989	#----##
990
991	&main();

Note: See TracBrowser for help on using the repository browser.

Download in other formats: