Context Navigation

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

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

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

Download in other formats: