source: other-projects/nightly-tasks/diffcol/trunk/diffcol/diffutil.pm@ 27604

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

Fixing up diffcol process so it works better. Current state finds no errors in Small-HTML model-collection. 1. Better handling of gdb database (and ignores .idh) by filtering out fields that are expected to differ such as date before doing the diff. Handles archiveinf-doc.gdb and -src.gdb files and with the sort flag Dr Bainbridge added to db2text and the sorting of keys in perllib/dbutil/gdbmtxtgz, the ordering of keys in the database is no longer affecting the outcome. 2. Better handling of doc.xml files. Once more date fields that will differ are filtered out before performing the diff. EarliestDatestamp file is ignored. 3. The task script now ensures that model-collect is up to date with the svn version when about to perform the diff col testing.

File size: 5.1 KB
Line 
1package diffutil;
2
3BEGIN {
4 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
5 die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
6 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
7 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
8}
9use util;
10
11
12
13sub files_in_dir
14{
15 my ($dirname) =@_;
16
17 opendir(DIR, $dirname) || die "can't opendir $dirname: $!";
18 @local_files = grep { /^\w/ && (-d &util::filename_cat($dirname,$_)|| -f &util::filename_cat($dirname,$_))} readdir(DIR);
19 closedir DIR;
20
21 return @local_files;
22}
23
24sub GetErrors
25{
26 my ($aryErrors,$aryReturnErrors,$intLineCount) = @_;
27 for(my $intCounter = 0; $intCounter < $intLineCount ; $intCounter++)
28 {
29 if(my $strAError = shift(@{$aryErrors}))
30 {
31 $strAError =~ s/^(<( )*)|^(>( )*)//g;
32 push(@{$aryReturnErrors},$strAError);
33 }
34 else {return 0;}
35 }
36 return 1;
37}
38
39sub IgnoreExp
40{
41 my ($strModel,$strTest,$strIgnoreExp) = @_;
42
43 if($strIgnoreExp eq "")
44 {
45 return 0;
46 }
47 else
48 {
49 if($strModel =~ m/$strIgnoreExp/ && $strTest =~ m/$strIgnoreExp/) #if($strModel =~ m/$strIgnoreExp/mg && $strTest =~ m/$strIgnoreExp/mg)
50 {
51 return 1;
52 }
53 else {return 0;}
54 }
55}
56
57sub GenerateOutput
58{
59 my ($strResult,$strIgnoreExp) = @_;
60 if($strResult eq "") {return "";}
61
62 my @aryErrors = split ("\n",$strResult);
63 my $strErrorMessage = "";
64 my $intCounter = 0;
65 my $hashptErrorLines;
66
67 while(my $strFirstLine = shift(@aryErrors))
68 {
69 my $charResultChar;
70 my @aryModelErrors;
71 my @aryTestErrors;
72 my $strAError = "";
73
74 if($strFirstLine =~ m/(\d+,)*\d+[a-z]\d+(,\d+)*/)
75 {
76 $charResultChar = $strFirstLine;
77 $charResultChar =~ s/\d|\W//g;
78 my @aryRightLeft = split($charResultChar,$strFirstLine);
79 my @aryModelLines = split(",",$aryRightLeft[0]);
80 my @aryTestLines = split(",",$aryRightLeft[1]);
81 my $intModelLineCount = 0;
82 my $intTestLineCount = 0;
83
84 if(scalar(@aryModelLines)> 2 || scalar(@aryTestLines)> 2){die "Error Found!!\n";}
85
86 $intModelLineCount = (scalar(@aryModelLines) == 1) ? 1 : ($aryModelLines[1] - $aryModelLines[0] + 1);
87 $intTestLineCount = (scalar(@aryTestLines) == 1) ? 1 : ($aryTestLines[1] - $aryTestLines[0] + 1);
88
89 if($charResultChar eq "c")
90 {
91 die "Nothing to parse 1\n" unless(&GetErrors(\@aryErrors,\@aryModelErrors,$intModelLineCount) == 1);
92
93 if($aryErrors[0] eq "---")
94 {
95 my $strExtra = shift(@aryErrors);
96 }
97 else
98 {
99 print "Incorrect format of diff program\n";
100 }
101 #die "Nothing to parse 2\n" unless(my $strExtra = shift(@aryErrors));
102 #die "Error Occoured: $strResult\n" unless($strExtra eq "---");
103
104 die "Nothing to parse 3\n" unless(&GetErrors(\@aryErrors,\@aryTestErrors,$intTestLineCount) == 1);
105
106 if($intModelLineCount == 1 && $intTestLineCount == 1 &&
107 &IgnoreExp($aryModelErrors[0],$aryModelErrors[0],$strIgnoreExp) == 1)
108 #&IgnoreExp($aryModelErrors[0],$aryTestErrors[0],$strIgnoreExp) == 1) # 2nd param should be aryTestErrors?
109 {
110 $strAError = "";
111 }
112 else
113 {
114 $strAError .= "Differences found between Model and Test Collection\n";
115 $strAError .= "--------------------------------------------------------------------------\n";
116
117 $strAError .= "Model Collection:\n";
118 for(my $intCounter = 0; $intCounter < $intModelLineCount ; $intCounter++)
119 {
120 my $intOutLine = $aryModelLines[0] + $intCounter;
121 $strAError .= " Line $intOutLine \t($aryModelErrors[$intCounter])\n";
122 }
123 $strAError .= "Test Collection:\n";
124 for(my $intCounter = 0; $intCounter < $intTestLineCount ; $intCounter++)
125 {
126 my $intOutLine = $aryTestLines[0] + $intCounter;
127 $strAError .= " Line $intOutLine \t($aryTestErrors[$intCounter])\n";
128 }
129 }
130 }
131
132 elsif($charResultChar eq "a")
133 {
134 die "Nothing to parse 4\n" unless(&GetErrors(\@aryErrors,\@aryTestErrors,$intTestLineCount) == 1);
135 $strAError .= "Missing in Model Collection\n";
136 $strAError .= "--------------------------------------------------------------------------\n";
137 $strAError .= "In Test Collection but not in Model Collection (Mismatch from Line $aryModelLines[0]):\n";
138 for(my $intCounter = 0; $intCounter < $intTestLineCount ; $intCounter++)
139 {
140 my $intOutLine = $aryTestLines[0] + $intCounter;
141 $strAError .= " Line $intOutLine \t($aryTestErrors[$intCounter])\n";
142 }
143 }
144
145 elsif($charResultChar eq "d")
146 {
147 die "Nothing to parse 5:$strResult\n" unless( &GetErrors(\@aryErrors,\@aryModelErrors,$intModelLineCount) == 1);
148 $strAError .= "Missing in Test Collection\n";
149 $strAError .= "--------------------------------------------------------------------------\n";
150 $strAError .= "In Model Collection but not in Test Collection (Mismatch from Line $aryTestLines[0]):\n";
151 for(my $intCounter = 0; $intCounter < $intModelLineCount ; $intCounter++)
152 {
153 my $intOutLine = $aryModelLines[0] + $intCounter;
154 $strAError .= " Line $intOutLine \t($aryModelErrors[$intCounter])\n";
155 }
156 }
157 else
158 {
159 die "Missing comparsion type!!\n";
160 }
161
162 }
163 else
164 {
165 die "$strResult\n";
166 }
167 if($strAError ne ""){$strErrorMessage .= "\n".$strAError;}
168 }
169
170 return $strErrorMessage;
171}
172
1731;
Note: See TracBrowser for help on using the repository browser.