Context Navigation

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

Last change on this file since 28008 was 28008, checked in by ak19, 11 years ago
Updates to diffcol's doc.xml processing necessary for diffcol to behave correctly on the Paged image collections, in particular the Scanned-Img-Advanced collection, where the doc.xml produced in the linux-generated model coll had a backslash, whereas the windows version gets all backslashes without exception replaced with forward slashes when doing diffcol
File size: 32.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\|FileSize)\">.</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	my $lin_contents = $testIsWin ? \$model_contents : \$test_contents;
657
658	# remove all carriage returns \r - introduced into doc.xml by multiread after pdf converted to html
659	$$win_contents =~ s@[\r]@@g;
660
661	# make all single windows slashes into single unix slashes
662	$$win_contents =~ s@([^\\])\\([^\\])@$1\/$2@g;
663	# make windows \r newlines into constant \n newlines. Already handled when \r got replaced
664	#$$win_contents =~ s@\r\n@\n@mg; # #http://stackoverflow.com/questions/650743/in-perl-how-to-do-you-remove-m-from-a-file
665
666	#FOR MAC: old macs use CR carriage return (see http://www.perlmonks.org/?node_id=745018), so replace with \n?)
667	# $$win_contents =~ s@\r@\n@mg;
668
669	# remove solitary, stray carriage returns \r in the linux doc.xml, as occurs in the tudor collection owing to the source material
670	# containing solitary carriage returns instead of linefeed
671	$$lin_contents =~ s@[\r]@@g; #$$lin_contents =~ s@[\r][^\n]@@g;
672
673
674	# make all single back slash in the linux file into / slash, if when \ was used as a linux escape char in a path
675	# since we've converted all single backslashes in the windows doc.xml to / (whether it was meant as a windows path slash or not).
676	# Doing so is okay, since we're not modifying the doc.xml in the model or test collections, just normalising them in-memory for comparison
677	$$lin_contents =~ s@([^\\])\\([^\\])@$1\/$2@g;
678	}
679
680
681	# tmp dirs have subdirs with random numbers in name, remove randomly named subdir portion of path
682	# these tmpdirs are located inside the collection directory
683	$model_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
684	$test_contents =~ s@(tmp[\\\/])(\d*[\\\/])@$1@g;
685
686	# remove all absolute paths upto collect folder from <Metadata /> elements
687	$model_contents =~ s@(<Metadata name=\"[^\"]\">(http:\/\/)?).(collect[\\\/]$strColName)@$1$3@g;
688	$test_contents =~ s@(<Metadata name=\"[^\"]\">(http:\/\/)?).(collect[\\\/]$strColName)@$1$3@g;
689
690	# The following block of code is necessary to deal with tmp (html) source files generated when using PDFBox
691	# These tmpdirs are located inside the toplevel greenstone directory
692	(my $gsdlhome_re = $ENV{'GSDLHOME'}) =~ s@\\@\/@g;
693	$gsdlhome_re = ".*" unless $$ENV{'GSDLHOME'};
694	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
695	if($test_contents =~ m@$tmpfile_regex@) {
696	# found a match, replace the tmp file name with "random", keeping the original file extension
697	# in <Metadata name="OrigSource\|URL\|UTF8URL\|gsdlconvertedfilename">
698
699	my ($old_tmp_filename, $ext) = ($1, $2);
700	my $new_tmp_filename = "random";
701
702	$tmpfile_regex = "(<Metadata name=\"(URL\|UTF8URL\|gsdlconvertedfilename\|OrigSource)\">(http://)?)($gsdlhome_re)?(/tmp/)?$old_tmp_filename($ext</Metadata>)";
703	if($5) {
704	$test_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
705	} else { # OrigSource contains only the filename
706	$test_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
707	}
708
709	# modelcol used a different gsdlhome, but also a tmp dir, so make the same changes to its random filename
710	$tmpfile_regex = "(<Metadata name=\"(URL\|UTF8URL\|gsdlconvertedfilename\|OrigSource)\">(http://)?)(.)?(/tmp/)?.($ext</Metadata>)";
711	if($5) {
712	$model_contents =~ s@$tmpfile_regex@$1$5$new_tmp_filename$6@g;
713	} else { # OrigSource contains only the filename
714	$model_contents =~ s@$tmpfile_regex@$1$new_tmp_filename$6@g;
715	}
716	}
717
718	# my $savepath = &getcwd."/../"; # TASK_HOME env var does not exist at this stage, but it's one level up from current directory
719	# &gdbdiff::print_string_to_file($model_contents, $savepath."model_doc.xml");
720	# &gdbdiff::print_string_to_file($test_contents, $savepath."test_doc.xml");
721
722	$strResult = diff \$model_contents, \$test_contents, { STYLE => "OldStyle" };
723
724	} else {
725	$strResult = diff $strModel, $strTest, { STYLE => "OldStyle" };
726	}
727
728	# The following tries to apply a regex to exclude fields after diffing. This is now no longer necessary since we filter
729	# these fields out now before the diff, but leaving it in in case different regexes at this point helps with single line diffs
730	$strResult = &diffutil::GenerateOutput($strResult,"^\\s<Metadata name=\"(lastmodified\|lastmodifieddate\|oailastmodified\|oailastmodifieddate)\">.</Metadata>\\s*\$");
731
732	#$strResult = GeneralOutput($strResult);
733	if ( $strOutputFormat eq "xml" ) {
734	#
735	} else {
736	VobPrint ("Comparing Files:\n\"$strModel\"\n\"$strTest\"\n",$intLevel);
737	}
738	if ($strResult eq "")
739	{
740	if ( $strOutputFormat eq "xml" ) {
741	print "<file-comparison location=\"$strModel\" succeeded=\"yes\"/>\n";
742	} else {
743	AlignPrint("Comparing File","Succeed",$intLevel);
744	}
745	}
746	else
747	{
748	# print STDERR "**** Diff is: $strResult\n"; # print any differences to the screen
749
750	my $strOutput = "Difference Report:\n$strResult\n";
751	if ( $strOutputFormat eq "xml" ) {
752	print "<file-comparison location=\"$strModel\" succeeded=\"no\"><message>";
753	} else {
754	AlignPrint("Comparing File","Failed",$intLevel);
755	}
756
757	#$result=`file -b $strModel`; # linux specific test for binary file
758	$result = (-B $strModel) ? 1 : 0; # perl test for binary file, see http://perldoc.perl.org/functions/-X.html
759	if ( "$result" =~ "data" ) {
760	VobPrint( "These binary files differ", $intLevel );
761	} else {
762	VobPrint ( "$strOutput" , $intLevel);
763	}
764
765
766	if ( $strOutputFormat eq "xml" ) {
767	print "</message></file-comparison>";
768	}
769
770	if($gv_blnErrorStop ne "off") { exit; }
771	push(@Errors,"File content comparison failed($strModel):\n$strOutput");
772	}
773	}
774
775	return @Errors;
776	}
777
778
779	sub FolderTesting
780	{
781	my ($aryptModel,$aryptTest,$strModelFolder,$strTestFolder,$intLevel) = @_;
782	my %hashCount = ();
783	my @Errors = ();
784	my @CorrectFiles = ();
785	my @TwoPointers = (\@Errors,\@CorrectFiles);
786
787	if ( $strOutputFormat eq "xml" ) {
788	#print "<folder-comparison location=\"$strModelFolder\">\n";
789	} else {
790	VobPrint ("Comparing Folder contents at \"$strModelFolder\"\n",$intLevel);
791	}
792
793	foreach my $strEachItem (@$aryptModel) {$hashCount{$strEachItem} = 'M'}
794	foreach my $strEachItem (@$aryptTest)
795	{
796	if(defined $hashCount{$strEachItem} && $hashCount{$strEachItem} eq 'M') {$hashCount{$strEachItem} = 'B';}
797	else {$hashCount{$strEachItem} = 'T';}
798	}
799
800	if( scalar(@$aryptModel)==scalar(@$aryptTest) && scalar(@$aryptModel)==scalar(keys %hashCount) )
801	{
802	if ( $strOutputFormat eq "xml" ) {
803	print "<folder-comparison location=\"$strModelFolder\" succeeded=\"yes\"/>\n";
804	} else {
805	AlignPrint("Folder Comparsion","Succeed",$intLevel);
806	}
807	return @TwoPointers;
808	}
809	else
810	{
811	if ( $strOutputFormat eq "xml" ) {
812	print "<folder-comparison location=\"$strModelFolder\" succeeded=\"no\"><message>\n";
813	} else {
814	AlignPrint("Folder Comparsion","Failed",$intLevel);
815	}
816
817	foreach my $strEachItem (keys %hashCount)
818	{
819	if($hashCount{$strEachItem} ne 'B')
820	{
821	my $strOutput = "";
822	my $strReport = "";
823
824	if($hashCount{$strEachItem} eq 'M')
825	{
826	$strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Test Collection";
827	$strReport = "Difference Report: difference found at $strTestFolder";
828	}
829	elsif($hashCount{$strEachItem} eq 'T')
830	{
831	$strOutput = "Difference Found at FolderTesting: \"$strEachItem\" is not found in the Model Collection";
832	$strReport = "Difference Report: difference found at $strModelFolder";
833	}
834	else {die "Error occours in diffcol_mk2::TestingFolder\n"}
835
836	VobPrint ("$strOutput\n",$intLevel);
837	$strOutput = $strOutput."\n\t".$strReport."\n";
838	push(@Errors,$strOutput);
839	}
840	else {push(@CorrectFiles,$strEachItem);}
841	}
842	if( $strOutputFormat eq "xml" ) {
843	print "</message></folder-comparison>";
844	}
845
846	return @TwoPointers;
847	}
848	}
849
850	sub VobPrint
851	{
852	my ($strOutput, $intLevel) = @_;
853	my $strTab = "";
854	my $intTab = int($intLevel/2);
855	if($intLevel <= $gv_intVerbosity)
856	{
857	if($intLevel >= 1)
858	{
859	$strTab = "\t"x($intTab+1);
860	$strOutput =~ s/\n$//;
861	$strOutput =~ s/\n/\n$strTab/g;
862	#$strTab =~ s/"\n"/"\n"."\t"x($intTab+1)/g;
863	}
864
865	if( $strOutputFormat eq "xml" ) {
866	$strOutput =~ s/&/&/g;
867	$strOutput =~ s/</</g;
868	$strOutput =~ s/>/>/g;
869	}
870
871	if ( length( $strOutput ) > 1000 ) {
872	$strOutput = substr( $strOutput, 0, 978);
873
874	# make sure there are no stray ampersands/partial ampersands that need to be completed as < or >
875	if($strOutput =~ m/&(.{1,2})?$/ \|\| $strOutput =~ m/&amp$/) { # &lt => < or &g => > or &a(m)=> & or &amp => &
876	if(defined $1 && $1) {
877	my $rest = $1;
878	if($rest =~ m/^a/) {
879	$strOutput =~ s@am?p?$@amp;@;
880	}
881	elsif($rest eq "g" \|\| $rest eq "l") {
882	$strOutput .= "t;"; # close the known tag
883	}
884	elsif($rest eq "gt" \|\| $rest eq "lt") {
885	$strOutput .= ";";
886	}
887	} else { # & on its own
888	#$strOutput = substr( $strOutput, 0, 977); # lop off the &
889	$strOutput .= "gt;"; # 50% chance the closing tag is what was missing (else can make this &)
890	# but even so, when the xslt is applied to report it doesn't break as long as & is not left dangling
891	}
892	}
893	$strOutput .= "... (output truncated)";
894	}
895
896
897	print $strTab.$strOutput."\n";
898	}
899	}
900	#----##
901
902
903	#--Main System----------------------------
904	#-----------------------------------------
905	# Name: main
906	# Perameters: arguments from command line
907	# Pre-condition: testing will start by calling this main function.
908	# Post-condition: output the test results for one or more collections.
909	#-----------------------------------------
910	sub main
911	{
912	my ($intVerbosity,$strErrorStop,$strErrorShow,$strMode);
913	my $strProgName = $0;
914	my $intArgc = scalar(@ARGV);
915
916	#--System Arguments Setup
917	if (!parsargv::parse(\@ARGV,
918	'estop//off', \$strErrorStop,
919	'eshow//off', \$strErrorShow,
920	'verbosity/\d+/1', \$intVerbosity,
921	'mode/[\w\-]+/all', \$strMode,
922	'output/[\w\-]+/text', \$strOutputFormat
923	)) {
924	PrintUsage($strProgName);
925	die "\n";
926	}
927
928	if ($intArgc<1) {
929	PrintUsage($strProgName);
930	die "\n";
931	}
932
933	$gv_blnErrorStop = $strErrorStop;
934	$gv_blnErrorShow = $strErrorShow;
935	$gv_intVerbosity = $intVerbosity;
936	$gv_strMode = SetMode($strMode);
937
938	#----##
939
940	#--Collection(s) Testing
941	foreach $strColName (@ARGV)
942	{
943	my @ErrorsInEachCol;
944	my $strModelCol = &FileUtils::filenameConcatenate($gv_strModelColRoot,$strColName);
945	my $strTestCol = &FileUtils::filenameConcatenate($gv_strTestColRoot,$strColName);
946
947	#--Output(Start)
948	OutputStart($strColName);
949	#----##
950
951	if(-e $strModelCol && -e $strTestCol )
952	{
953
954	#--Individual Testing
955	if ($gv_strMode eq "Individual")
956	{
957	@ErrorsInEachCol = IndivTest($strModelCol,$strTestCol,$strColName);
958	}
959	#----##
960
961	#--Initial Testing
962	elsif ($gv_strMode eq "Initial")
963	{
964	@ErrorsInEachCol = InitTest($strModelCol,$strTestCol,$strColName);
965	}
966	#----##
967
968	#--Full Testing
969	elsif ($gv_strMode eq "Full")
970	{
971	@ErrorsInEachCol = FullTest($strModelCol,$strTestCol,$strColName);
972	}
973	#----##
974
975	#--Error Checking
976	else
977	{
978	if ( $strOutputFormat eq "xml" ) {
979	die "<error>Error occoured in main function</error>\n";
980	} else {
981	die "Error occoured in main function.\n";
982	}
983	}
984	#----##
985
986	}
987	else
988	{
989	if( $strOutputFormat eq "xml" ) {
990	die "<error>Cannot find collection: $strColName</error>\n";
991	} else {
992	die "Error: cannot find collection: $strColName\n";
993	}
994	}
995	#----##
996
997	#--Output(Results and Errors)
998	OutputEnd($strColName,\@ErrorsInEachCol);
999	#----##
1000
1001	}
1002	}
1003	#----##
1004
1005	&main();

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

Download in other formats: