line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
$Test::Excel::VERSION = '1.52'; |
3
|
|
|
|
|
|
|
$Test::Excel::AUTHORITY = 'cpan:MANWAR'; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Test::Excel - Interface to test and compare Excel files (.xls/.xlsx). |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 VERSION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Version 1.52 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use strict; use warnings; |
16
|
7
|
|
|
7
|
|
624783
|
|
|
7
|
|
|
7
|
|
66
|
|
|
7
|
|
|
|
|
166
|
|
|
7
|
|
|
|
|
33
|
|
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
158
|
|
17
|
|
|
|
|
|
|
use 5.006; |
18
|
7
|
|
|
7
|
|
145
|
use IO::File; |
|
7
|
|
|
|
|
19
|
|
19
|
7
|
|
|
7
|
|
2762
|
use Data::Dumper; |
|
7
|
|
|
|
|
50138
|
|
|
7
|
|
|
|
|
637
|
|
20
|
7
|
|
|
7
|
|
3974
|
use Test::Builder (); |
|
7
|
|
|
|
|
43454
|
|
|
7
|
|
|
|
|
450
|
|
21
|
7
|
|
|
7
|
|
52
|
use Spreadsheet::Read; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
105
|
|
22
|
7
|
|
|
7
|
|
4122
|
use Scalar::Util 'blessed'; |
|
7
|
|
|
|
|
3035955
|
|
|
7
|
|
|
|
|
644
|
|
23
|
7
|
|
|
7
|
|
100
|
|
|
7
|
|
|
|
|
51
|
|
|
7
|
|
|
|
|
336
|
|
24
|
|
|
|
|
|
|
use parent 'Exporter'; |
25
|
7
|
|
|
7
|
|
49
|
our @ISA = qw(Exporter); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
39
|
|
26
|
|
|
|
|
|
|
our @EXPORT = qw(cmp_excel compare_excel cmp_excel_ok cmp_excel_not_ok); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$|=1; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $ALMOST_ZERO = 10**-16; |
31
|
|
|
|
|
|
|
my $IGNORE = 1; |
32
|
|
|
|
|
|
|
my $SPECIAL_CASE = 2; |
33
|
|
|
|
|
|
|
my $REGEX_CASE = 3; |
34
|
|
|
|
|
|
|
my $MAX_ERRORS_PER_SHEET = 0; |
35
|
|
|
|
|
|
|
my $TESTER = Test::Builder->new; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 DESCRIPTION |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
This module is meant to be used for testing custom generated Excel files, it |
40
|
|
|
|
|
|
|
provides interfaces to compare_excel two Excel files if they are I<visually> same. |
41
|
|
|
|
|
|
|
It now supports Excel file with extension C<.xls> and C<.xlsx>. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 SYNOPSIS |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Using as unit test as below: |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
use strict; use warnings; |
48
|
|
|
|
|
|
|
use Test::More tests => 2; |
49
|
|
|
|
|
|
|
use Test::Excel; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
cmp_excel_ok("foo.xls", "foo.xls"); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
cmp_excel_not_ok("foo.xls", "bar.xls"); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
done_testing(); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Using as standalone as below: |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
use strict; use warnings; |
60
|
|
|
|
|
|
|
use Test::Excel; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
if (compare_excel("foo.xls", "foo.xls")) { |
63
|
|
|
|
|
|
|
print "Excels are similar.\n"; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else { |
66
|
|
|
|
|
|
|
print "Excels aren't similar.\n"; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 METHODS |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 cmp_excel($got, $exp, \%rule, $message) |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
This function will tell you whether the two Excel files are "visually" different, |
74
|
|
|
|
|
|
|
ignoring differences in embedded fonts / images and metadata.Both C<$got> and |
75
|
|
|
|
|
|
|
C<$exp> can be either instance of L<Spreadsheet::Read> / file path (which is in |
76
|
|
|
|
|
|
|
turn passed to the L<Spreadsheet::Read> constructor). |
77
|
|
|
|
|
|
|
This one is for use in TEST MODE. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
use strict; use warnings; |
80
|
|
|
|
|
|
|
use Test::More tests => 1; |
81
|
|
|
|
|
|
|
use Test::Excel; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
cmp_excel('foo.xls', 'bar.xls', {}, 'EXCELs are identical.'); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
done_testing(); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 cmp_excel_ok($got, $exp, \%rule, $message) |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Test OK if excel files are identical. Same as C<cmp_excel()>. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 cmp_excel_not_ok($got, $exp, \%rule, $message) |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Test OK if excel files are NOT identical. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my ($got, $exp, $rule, $message) = @_; |
98
|
|
|
|
|
|
|
|
99
|
14
|
|
|
14
|
1
|
8277
|
my $status = compare_excel($got, $exp, $rule); |
100
|
|
|
|
|
|
|
$TESTER->ok($status, $message); |
101
|
14
|
|
|
|
|
43
|
} |
102
|
7
|
|
|
|
|
37
|
|
103
|
|
|
|
|
|
|
my ($got, $exp, $rule, $message) = @_; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my $status = compare_excel($got, $exp, $rule); |
106
|
1
|
|
|
1
|
1
|
325
|
$TESTER->ok($status, $message); |
107
|
|
|
|
|
|
|
} |
108
|
1
|
|
|
|
|
5
|
|
109
|
1
|
|
|
|
|
11
|
my ($got, $exp, $rule, $message) = @_; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $status = compare_excel($got, $exp, $rule); |
112
|
|
|
|
|
|
|
if ($status == 0) { |
113
|
1
|
|
|
1
|
1
|
504
|
$TESTER->ok(1, $message); |
114
|
|
|
|
|
|
|
} |
115
|
1
|
|
|
|
|
5
|
else { |
116
|
1
|
50
|
|
|
|
7
|
$TESTER->ok(0, $message); |
117
|
1
|
|
|
|
|
44
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
0
|
=head2 compare_excel($got, $exp, \%rule) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Same as C<cmp_excel_ok()> but ideal for non TEST MODE. |
123
|
|
|
|
|
|
|
This function will tell you whether the two Excel files are "visually" different, |
124
|
|
|
|
|
|
|
ignoring differences in embedded fonts / images and metadata.Both C<$got> and |
125
|
|
|
|
|
|
|
C<$exp> can be either instance of L<Spreadsheet::Read> / file path (which is in |
126
|
|
|
|
|
|
|
turn passed to the L<Spreadsheet::Read> constructor). |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
use strict; use warnings; |
129
|
|
|
|
|
|
|
use Test::Excel; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
print "EXCELs are identical.\n" if compare_excel("foo.xls", "bar.xls"); |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
my ($got, $exp, $rule) = @_; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
local $SIG{__WARN__} = sub { |
138
|
|
|
|
|
|
|
my ($error) = @_; |
139
|
|
|
|
|
|
|
warn $error unless ($error =~ /Use of uninitialized value/); |
140
|
45
|
|
|
45
|
1
|
7107
|
}; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
die("ERROR: Unable to locate file [$got][$!].\n") unless (-f $got); |
143
|
52
|
|
|
52
|
|
125
|
die("ERROR: Unable to locate file [$exp][$!].\n") unless (-f $exp); |
144
|
52
|
50
|
|
|
|
319
|
|
145
|
45
|
|
|
|
|
339
|
_log_message("INFO: Excel comparison [$got] [$exp]\n"); |
146
|
|
|
|
|
|
|
unless (blessed($got) && $got->isa('Spreadsheet::Read')) { |
147
|
45
|
100
|
|
|
|
1046
|
$got = Spreadsheet::Read->new($got) |
148
|
43
|
100
|
|
|
|
453
|
|| die("ERROR: Couldn't create Spreadsheet::Read instance with: [$got]\n"); |
149
|
|
|
|
|
|
|
} |
150
|
41
|
|
|
|
|
250
|
|
151
|
41
|
50
|
33
|
|
|
199
|
unless (blessed($exp) && $exp->isa('Spreadsheet::Read')) { |
152
|
41
|
|
50
|
|
|
203
|
$exp = Spreadsheet::Read->new($exp) |
153
|
|
|
|
|
|
|
|| die("ERROR: Couldn't create Spreadsheet::Read instance with: [$exp]\n"); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
41
|
50
|
33
|
|
|
1119206
|
_validate_rule($rule); |
157
|
41
|
|
50
|
|
|
159
|
|
158
|
|
|
|
|
|
|
my $spec = _get_hashval($rule, 'spec'); |
159
|
|
|
|
|
|
|
my $error_limit = _get_hashval($rule, 'error_limit'); |
160
|
|
|
|
|
|
|
my $sheet = _get_hashval($rule, 'sheet'); |
161
|
41
|
|
|
|
|
1109484
|
my @gotWorkSheets = $got->sheets(); |
162
|
|
|
|
|
|
|
my @expWorkSheets = $exp->sheets(); |
163
|
30
|
|
|
|
|
123
|
|
164
|
30
|
|
|
|
|
89
|
$spec = _parse($spec) if defined $spec; |
165
|
30
|
|
|
|
|
52
|
$error_limit = $MAX_ERRORS_PER_SHEET unless defined $error_limit; |
166
|
30
|
|
|
|
|
92
|
|
167
|
30
|
|
|
|
|
472
|
if (@gotWorkSheets != @expWorkSheets) { |
168
|
|
|
|
|
|
|
my $error = 'ERROR: Sheets count mismatch. '; |
169
|
30
|
100
|
|
|
|
348
|
$error .= 'Got: [' . @gotWorkSheets . |
170
|
29
|
100
|
|
|
|
72
|
'] exp: [' . @expWorkSheets . "]\n"; |
171
|
|
|
|
|
|
|
_log_message($error); |
172
|
29
|
100
|
|
|
|
83
|
return 0; |
173
|
1
|
|
|
|
|
3
|
} |
174
|
1
|
|
|
|
|
6
|
|
175
|
|
|
|
|
|
|
my @sheets; |
176
|
1
|
|
|
|
|
3
|
my $status = 1; |
177
|
1
|
|
|
|
|
28
|
@sheets = split(/\|/, $sheet) if defined $sheet; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
for (my $i = 0; $i < @gotWorkSheets; $i++) { |
180
|
28
|
|
|
|
|
42
|
my $error_on_sheet = 0; |
181
|
28
|
|
|
|
|
35
|
my $gotWorkSheet = $gotWorkSheets[$i]; |
182
|
28
|
100
|
|
|
|
70
|
my $expWorkSheet = $expWorkSheets[$i]; |
183
|
|
|
|
|
|
|
my $gotSheetName = $gotWorkSheet; |
184
|
28
|
|
|
|
|
81
|
my $expSheetName = $expWorkSheet; |
185
|
50
|
|
|
|
|
73
|
|
186
|
50
|
|
|
|
|
87
|
unless (exists $spec->{ALL}) { |
187
|
50
|
|
|
|
|
76
|
if (uc($gotSheetName) ne uc($expSheetName)) { |
188
|
50
|
|
|
|
|
73
|
my $error = "ERROR: Sheetname mismatch. Got: [$gotSheetName] exp: [$expSheetName].\n"; |
189
|
50
|
|
|
|
|
60
|
_log_message($error); |
190
|
|
|
|
|
|
|
return 0; |
191
|
50
|
100
|
|
|
|
96
|
} |
192
|
24
|
50
|
|
|
|
65
|
} |
193
|
0
|
|
|
|
|
0
|
|
194
|
0
|
|
|
|
|
0
|
my $got_sheet = $got->sheet($gotSheetName); |
195
|
0
|
|
|
|
|
0
|
my $exp_sheet = $exp->sheet($expSheetName); |
196
|
|
|
|
|
|
|
my ($gotRowMin, $gotRowMax) = (1, $got_sheet->maxrow); |
197
|
|
|
|
|
|
|
my ($gotColMin, $gotColMax) = (1, $got_sheet->maxcol); |
198
|
|
|
|
|
|
|
my ($expRowMin, $expRowMax) = (1, $exp_sheet->maxrow); |
199
|
50
|
|
|
|
|
143
|
my ($expColMin, $expColMax) = (1, $exp_sheet->maxcol); |
200
|
50
|
|
|
|
|
696
|
|
201
|
50
|
|
|
|
|
482
|
_log_message("INFO: [$gotSheetName]:[$gotRowMin][$gotColMin]:[$gotRowMax][$gotColMax]\n"); |
202
|
50
|
|
|
|
|
316
|
_log_message("INFO: [$expSheetName]:[$expRowMin][$expColMin]:[$expRowMax][$expColMax]\n"); |
203
|
50
|
|
|
|
|
239
|
|
204
|
50
|
|
|
|
|
221
|
if (defined($gotRowMax) && defined($expRowMax) && ($gotRowMax != $expRowMax)) { |
205
|
|
|
|
|
|
|
my $error = "ERROR: Max row counts mismatch in sheet [$gotSheetName]. "; |
206
|
50
|
|
|
|
|
334
|
$error .= "Got[$gotRowMax] Expected: [$expRowMax]\n"; |
207
|
50
|
|
|
|
|
184
|
_log_message($error); |
208
|
|
|
|
|
|
|
return 0; |
209
|
50
|
50
|
33
|
|
|
267
|
} |
|
|
|
33
|
|
|
|
|
210
|
0
|
|
|
|
|
0
|
|
211
|
0
|
|
|
|
|
0
|
if (defined($gotColMax) && defined($expColMax) && ($gotColMax != $expColMax)) { |
212
|
0
|
|
|
|
|
0
|
my $error = "ERROR: Max column counts mismatch in sheet [$gotSheetName]. "; |
213
|
0
|
|
|
|
|
0
|
$error .= "Got[$gotColMax] Expected: [$expColMax]\n"; |
214
|
|
|
|
|
|
|
_log_message($error); |
215
|
|
|
|
|
|
|
return 0; |
216
|
50
|
50
|
33
|
|
|
228
|
} |
|
|
|
33
|
|
|
|
|
217
|
0
|
|
|
|
|
0
|
|
218
|
0
|
|
|
|
|
0
|
my ($swap); |
219
|
0
|
|
|
|
|
0
|
for (my $row = $gotRowMin; $row <= $gotRowMax; $row++) { |
220
|
0
|
|
|
|
|
0
|
for (my $col = $gotColMin; $col <= $gotColMax; $col++) { |
221
|
|
|
|
|
|
|
my $gotData = $got_sheet->cell($col, $row); |
222
|
|
|
|
|
|
|
my $expData = $exp_sheet->cell($col, $row); |
223
|
50
|
|
|
|
|
69
|
|
224
|
50
|
|
|
|
|
129
|
next if (defined $spec |
225
|
287
|
|
|
|
|
496
|
&& |
226
|
1879
|
|
|
|
|
3201
|
(( exists $spec->{ALL} |
227
|
1879
|
|
|
|
|
14167
|
&& exists $spec->{ALL}->{$col} |
228
|
|
|
|
|
|
|
&& exists $spec->{ALL}->{$col}->{$row} |
229
|
|
|
|
|
|
|
&& exists $spec->{ALL}->{$col}->{$row}->{$IGNORE} |
230
|
|
|
|
|
|
|
) |
231
|
|
|
|
|
|
|
|| |
232
|
|
|
|
|
|
|
( exists $spec->{uc($gotSheetName)} |
233
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col} |
234
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row} |
235
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row}->{$IGNORE} |
236
|
|
|
|
|
|
|
)) |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
if (defined $gotData && defined $expData) { |
240
|
1879
|
100
|
100
|
|
|
16859
|
# Number like data? |
|
|
|
66
|
|
|
|
|
241
|
|
|
|
|
|
|
if ( |
242
|
|
|
|
|
|
|
($gotData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/) |
243
|
|
|
|
|
|
|
&& |
244
|
1859
|
100
|
66
|
|
|
4317
|
($expData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/) |
245
|
|
|
|
|
|
|
) { |
246
|
1787
|
100
|
66
|
|
|
7872
|
if (($gotData < $ALMOST_ZERO) && ($expData < $ALMOST_ZERO)) { |
247
|
|
|
|
|
|
|
# Can be treated as the same. |
248
|
|
|
|
|
|
|
next; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
else { |
251
|
1555
|
50
|
33
|
|
|
2982
|
if (defined $rule && scalar(keys %$rule)) { |
252
|
|
|
|
|
|
|
my $compare_with; |
253
|
0
|
|
|
|
|
0
|
my $difference = abs($expData - $gotData) / abs($expData); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
if (( defined $spec |
256
|
1555
|
100
|
100
|
|
|
3536
|
&& exists $spec->{uc($gotSheetName)} |
257
|
101
|
|
|
|
|
127
|
&& exists $spec->{uc($gotSheetName)}->{$col} |
258
|
101
|
|
|
|
|
192
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row} |
259
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row}->{$SPECIAL_CASE} |
260
|
101
|
100
|
66
|
|
|
876
|
) |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
261
|
|
|
|
|
|
|
|| |
262
|
|
|
|
|
|
|
(@sheets && grep(/$gotSheetName/,@sheets)) |
263
|
|
|
|
|
|
|
) { |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
_log_message("INFO: [NUMBER]:[$gotSheetName]:[SPC][". |
266
|
|
|
|
|
|
|
($row)."][".($col)."]:[$gotData][$expData] ... "); |
267
|
|
|
|
|
|
|
$compare_with = $rule->{sheet_tolerance}; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
else { |
270
|
65
|
|
|
|
|
398
|
_log_message("INFO: [NUMBER]:[$gotSheetName]:[STD][".( |
271
|
|
|
|
|
|
|
$row)."][".($col)."]:[$gotData][$expData] ... "); |
272
|
65
|
|
|
|
|
110
|
$compare_with = $rule->{tolerance} || 0; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
36
|
|
|
|
|
193
|
if (defined $compare_with && ($compare_with < $difference)) { |
276
|
|
|
|
|
|
|
_log_message("[FAIL]\n"); |
277
|
36
|
|
50
|
|
|
84
|
$difference = sprintf("%02f", $difference); |
278
|
|
|
|
|
|
|
$status = 0; |
279
|
|
|
|
|
|
|
} |
280
|
101
|
100
|
66
|
|
|
266
|
else { |
281
|
8
|
|
|
|
|
19
|
$status = 1; |
282
|
8
|
|
|
|
|
40
|
_log_message("[PASS]\n"); |
283
|
8
|
|
|
|
|
18
|
} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
else { |
286
|
93
|
|
|
|
|
119
|
_log_message("INFO: [NUMBER]:[$gotSheetName]:[N/A][". |
287
|
93
|
|
|
|
|
149
|
($row)."][".($col)."]:[$gotData][$expData] ... "); |
288
|
|
|
|
|
|
|
if ($expData != $gotData) { |
289
|
|
|
|
|
|
|
_log_message("[FAIL]\n"); |
290
|
|
|
|
|
|
|
return 0; |
291
|
1454
|
|
|
|
|
4219
|
} |
292
|
|
|
|
|
|
|
else { |
293
|
1454
|
100
|
|
|
|
2148
|
$status = 1; |
294
|
2
|
|
|
|
|
6
|
_log_message("[PASS]\n"); |
295
|
2
|
|
|
|
|
320
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
1452
|
|
|
|
|
1586
|
} |
299
|
1452
|
|
|
|
|
1741
|
else { |
300
|
|
|
|
|
|
|
# Is it regex? |
301
|
|
|
|
|
|
|
if (( defined $spec |
302
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)} |
303
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col} |
304
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row} |
305
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row}->{$REGEX_CASE} |
306
|
232
|
100
|
66
|
|
|
1979
|
) |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
307
|
|
|
|
|
|
|
|| |
308
|
|
|
|
|
|
|
( exists $spec->{ALL}->{$col} |
309
|
|
|
|
|
|
|
&& exists $spec->{ALL}->{$col}->{$row} |
310
|
|
|
|
|
|
|
&& exists $spec->{ALL}->{$col}->{$row}->{$REGEX_CASE} |
311
|
|
|
|
|
|
|
) |
312
|
|
|
|
|
|
|
|| |
313
|
|
|
|
|
|
|
(@sheets && grep(/$gotSheetName/,@sheets)) |
314
|
|
|
|
|
|
|
) { |
315
|
|
|
|
|
|
|
my $exp = qr{$spec->{uc($gotSheetName)}->{$col}->{$row}->{$REGEX_CASE}}; |
316
|
|
|
|
|
|
|
if (($gotData =~ /$exp/i) && ($expData =~ /$exp/i)) { |
317
|
|
|
|
|
|
|
$status = 1; |
318
|
|
|
|
|
|
|
_log_message("INFO: [REGEX]:[$gotSheetName]:[". |
319
|
|
|
|
|
|
|
($row)."][".($col)."]:[$gotData][$expData] ... [PASS]\n"); |
320
|
60
|
|
|
|
|
692
|
} |
321
|
60
|
100
|
66
|
|
|
684
|
else { |
322
|
59
|
|
|
|
|
100
|
_log_message("INFO: [REGEX]:[$gotSheetName]:[$expData][$gotData][$exp] ... [FAIL]\n"); |
323
|
59
|
|
|
|
|
180
|
$status = 0; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
else { |
327
|
1
|
|
|
|
|
8
|
# String like data? |
328
|
1
|
|
|
|
|
2
|
if (uc($gotData) ne uc($expData)) { |
329
|
|
|
|
|
|
|
_log_message("INFO: [STRING]:[$gotSheetName]:[$expData][$gotData] ... [FAIL]\n"); |
330
|
|
|
|
|
|
|
if (defined $rule) { |
331
|
|
|
|
|
|
|
$error_on_sheet++; |
332
|
|
|
|
|
|
|
$status = 0; |
333
|
172
|
100
|
|
|
|
322
|
} |
334
|
10
|
|
|
|
|
61
|
else { |
335
|
10
|
50
|
|
|
|
27
|
return 0; |
336
|
10
|
|
|
|
|
16
|
} |
337
|
10
|
|
|
|
|
31
|
} |
338
|
|
|
|
|
|
|
else { |
339
|
|
|
|
|
|
|
$status = 1; |
340
|
0
|
|
|
|
|
0
|
_log_message("INFO: [STRING]:[$gotSheetName]:[STD][". |
341
|
|
|
|
|
|
|
($row)."][".($col)."]:[$gotData][$expData] ... [PASS]\n"); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
162
|
|
|
|
|
186
|
} |
345
|
162
|
|
|
|
|
501
|
|
346
|
|
|
|
|
|
|
if ( exists $rule->{swap_check} |
347
|
|
|
|
|
|
|
&& defined $rule->{swap_check} |
348
|
|
|
|
|
|
|
&& $rule->{swap_check} |
349
|
|
|
|
|
|
|
) { |
350
|
|
|
|
|
|
|
if ($status == 0) { |
351
|
1785
|
100
|
66
|
|
|
3349
|
$error_on_sheet++; |
|
|
|
66
|
|
|
|
|
352
|
|
|
|
|
|
|
push @{$swap->{exp}->{_number_to_letter($col)}}, $expData; |
353
|
|
|
|
|
|
|
push @{$swap->{got}->{_number_to_letter($col)}}, $gotData; |
354
|
|
|
|
|
|
|
|
355
|
62
|
100
|
|
|
|
152
|
if (($error_on_sheet >= $error_limit) |
356
|
16
|
|
|
|
|
25
|
&& ($error_on_sheet % 2 == 0) |
357
|
16
|
|
|
|
|
22
|
&& !_is_swapping($swap)) { |
|
16
|
|
|
|
|
34
|
|
358
|
16
|
|
|
|
|
22
|
_log_message("ERROR: Max error per sheet reached.[$error_on_sheet]\n"); |
|
16
|
|
|
|
|
39
|
|
359
|
|
|
|
|
|
|
return $status; |
360
|
16
|
50
|
100
|
|
|
68
|
} |
|
|
|
66
|
|
|
|
|
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} |
363
|
0
|
|
|
|
|
0
|
else { |
364
|
0
|
|
|
|
|
0
|
return $status if ($status == 0); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} # col |
368
|
|
|
|
|
|
|
|
369
|
1723
|
100
|
|
|
|
3582
|
if (($error_on_sheet > 0) |
370
|
|
|
|
|
|
|
&& ($error_on_sheet >= $error_limit) |
371
|
|
|
|
|
|
|
&& ($error_on_sheet % 2 == 0) |
372
|
|
|
|
|
|
|
&& !_is_swapping($swap)) { |
373
|
|
|
|
|
|
|
return $status if ($status == 0); |
374
|
282
|
50
|
100
|
|
|
685
|
} |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
375
|
|
|
|
|
|
|
} # row |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
if ( exists $rule->{swap_check} |
378
|
0
|
0
|
|
|
|
0
|
&& defined $rule->{swap_check} |
379
|
|
|
|
|
|
|
&& $rule->{swap_check} |
380
|
|
|
|
|
|
|
) { |
381
|
|
|
|
|
|
|
if (($error_on_sheet > 0) && _is_swapping($swap)) { |
382
|
45
|
50
|
66
|
|
|
135
|
_log_message("WARN: SWAP OCCURRED.\n"); |
|
|
|
66
|
|
|
|
|
383
|
|
|
|
|
|
|
$status = 1; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
9
|
100
|
66
|
|
|
25
|
|
387
|
3
|
|
|
|
|
7
|
_log_message("INFO: [$gotSheetName]: ..... [OK].\n"); |
388
|
3
|
|
|
|
|
4
|
} # sheet |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
return $status; |
391
|
|
|
|
|
|
|
} |
392
|
45
|
|
|
|
|
103
|
|
393
|
|
|
|
|
|
|
=head1 RULE |
394
|
|
|
|
|
|
|
|
395
|
23
|
|
|
|
|
861
|
The paramter C<rule> can be used optionally to apply exception when comparing the |
396
|
|
|
|
|
|
|
contents. This should be passed in as has ref and may contain keys from the table |
397
|
|
|
|
|
|
|
below. |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
+-----------------+---------------------------------------------------------+ |
400
|
|
|
|
|
|
|
| Key | Description | |
401
|
|
|
|
|
|
|
+-----------------+---------------------------------------------------------+ |
402
|
|
|
|
|
|
|
| sheet | "|" seperated sheet names. | |
403
|
|
|
|
|
|
|
| tolerance | Number. Apply to all NUMBERS except on 'sheet'/'spec'. | |
404
|
|
|
|
|
|
|
| | e.g. 10**-12 | |
405
|
|
|
|
|
|
|
| sheet_tolerance | Number. Apply to sheets/ranges in the spec. e.g. 0.20 | |
406
|
|
|
|
|
|
|
| spec | Path to the specification file. | |
407
|
|
|
|
|
|
|
| swap_check | Number (optional) (1 or 0). Row swapping check. | |
408
|
|
|
|
|
|
|
| | Default is 0. | |
409
|
|
|
|
|
|
|
| error_limit | Number (optional). Limit error per sheet. Default is 0. | |
410
|
|
|
|
|
|
|
+-----------------+---------------------------------------------------------+ |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=head1 SPECIFICATION FILE |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Spec file containing rules used should be in the format mentioned below. Key and |
415
|
|
|
|
|
|
|
values are space seperated. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sheet Sheet1 |
418
|
|
|
|
|
|
|
range A3:B14 |
419
|
|
|
|
|
|
|
range B5:C5 |
420
|
|
|
|
|
|
|
sheet Sheet2 |
421
|
|
|
|
|
|
|
range A1:B2 |
422
|
|
|
|
|
|
|
ignorerange B3:B8 |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
As in C<v1.51> or above, we now support the use of C<regex> in the specification |
425
|
|
|
|
|
|
|
file. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
The following specification forces regex comparison in all sheets in range C<B2:B4>. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sheet ALL |
430
|
|
|
|
|
|
|
range B2:B4 |
431
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
The following specification forces regex comparison in all sheets. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sheet ALL |
436
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
The following specification forces regex comparison in the sheet named C<Demo> |
439
|
|
|
|
|
|
|
in range C<B2:B4>. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sheet Demo |
442
|
|
|
|
|
|
|
range B2:B4 |
443
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=head1 What is "Visually" Similar? |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
This module uses the L<Spreadsheet::Read> module to parse the Excel files, then |
448
|
|
|
|
|
|
|
compares the parsed data structure for differences.We ignore certain components |
449
|
|
|
|
|
|
|
of the Excel file, such as embedded fonts, images, forms and annotations, and |
450
|
|
|
|
|
|
|
focus entirely on the layout of each Excel page instead. Future versions will |
451
|
|
|
|
|
|
|
likely support font and image comparisons. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head1 How to find out what failed the comparison? |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
By turning the environment variable DEBUG ON would spit out PASS/FAIL comparison. |
456
|
|
|
|
|
|
|
For example: |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
$/> $DEBUG=1 perl your-test-script.pl |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=cut |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# |
463
|
|
|
|
|
|
|
# |
464
|
|
|
|
|
|
|
# PRIVATE METHODS |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
my ($cell) = @_; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
return unless defined $cell; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
die("ERROR: Invalid cell address [$cell].\n") unless ($cell =~ /([A-Za-z]+)(\d+)/); |
471
|
|
|
|
|
|
|
|
472
|
61
|
|
|
61
|
|
269
|
return ($1, $2); |
473
|
|
|
|
|
|
|
} |
474
|
61
|
50
|
|
|
|
102
|
|
475
|
|
|
|
|
|
|
my ($letter) = @_; |
476
|
61
|
50
|
|
|
|
157
|
|
477
|
|
|
|
|
|
|
return col2int($letter); |
478
|
61
|
|
|
|
|
164
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# -------------------------------------------------------------------------- |
481
|
|
|
|
|
|
|
# col2int (for Spreadsheet::ParseExcel::Utility) |
482
|
61
|
|
|
61
|
|
1394
|
# -------------------------------------------------------------------------- |
483
|
|
|
|
|
|
|
my $result = 0; |
484
|
61
|
|
|
|
|
88
|
my $str = shift; |
485
|
|
|
|
|
|
|
my $incr = 0; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
for ( my $i = length($str) ; $i > 0 ; $i-- ) { |
488
|
|
|
|
|
|
|
my $char = substr( $str, $i - 1 ); |
489
|
|
|
|
|
|
|
my $curr += ord( lc($char) ) - ord('a') + 1; |
490
|
|
|
|
|
|
|
$curr *= $incr if ($incr); |
491
|
61
|
|
|
61
|
0
|
70
|
$result += $curr; |
492
|
61
|
|
|
|
|
72
|
$incr += 26; |
493
|
61
|
|
|
|
|
67
|
} |
494
|
|
|
|
|
|
|
|
495
|
61
|
|
|
|
|
119
|
# this is one out as we range 0..x-1 not 1..x |
496
|
62
|
|
|
|
|
89
|
$result--; |
497
|
62
|
|
|
|
|
99
|
|
498
|
62
|
100
|
|
|
|
89
|
return $result; |
499
|
62
|
|
|
|
|
68
|
} |
500
|
62
|
|
|
|
|
111
|
|
501
|
|
|
|
|
|
|
my ($number) = @_; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
return int2col($number); |
504
|
61
|
|
|
|
|
77
|
} |
505
|
|
|
|
|
|
|
|
506
|
61
|
|
|
|
|
84
|
# -------------------------------------------------------------------------- |
507
|
|
|
|
|
|
|
# int2col (for Spreadsheet::ParseExcel::Utility) |
508
|
|
|
|
|
|
|
# -------------------------------------------------------------------------- |
509
|
|
|
|
|
|
|
my $out = ""; |
510
|
33
|
|
|
33
|
|
582
|
my $val = shift; |
511
|
|
|
|
|
|
|
|
512
|
33
|
|
|
|
|
51
|
do { |
513
|
|
|
|
|
|
|
$out .= chr( ( $val % 26 ) + ord('A') ); |
514
|
|
|
|
|
|
|
$val = int( $val / 26 ) - 1; |
515
|
|
|
|
|
|
|
} while ( $val >= 0 ); |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
return scalar reverse $out; |
518
|
|
|
|
|
|
|
} |
519
|
33
|
|
|
33
|
0
|
40
|
|
520
|
33
|
|
|
|
|
60
|
my ($range) = @_; |
521
|
|
|
|
|
|
|
|
522
|
33
|
|
|
|
|
51
|
return unless defined $range; |
523
|
34
|
|
|
|
|
56
|
|
524
|
34
|
|
|
|
|
76
|
my $cells = []; |
525
|
|
|
|
|
|
|
foreach my $_range (split /\,/,$range) { |
526
|
|
|
|
|
|
|
die("ERROR: Invalid range [$_range].\n") |
527
|
33
|
|
|
|
|
108
|
unless ($_range =~ /(\w+\d+):(\w+\d+)/); |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
my $from = $1; |
530
|
|
|
|
|
|
|
my $to = $2; |
531
|
28
|
|
|
28
|
|
1332
|
my ($min_col, $min_row) = Test::Excel::_column_row($from); |
532
|
|
|
|
|
|
|
my ($max_col, $max_row) = Test::Excel::_column_row($to); |
533
|
28
|
50
|
|
|
|
53
|
|
534
|
|
|
|
|
|
|
$min_col = Test::Excel::_letter_to_number($min_col); |
535
|
28
|
|
|
|
|
46
|
$max_col = Test::Excel::_letter_to_number($max_col); |
536
|
28
|
|
|
|
|
87
|
|
537
|
30
|
50
|
|
|
|
135
|
for (my $row = $min_row; $row <= $max_row; $row++) { |
538
|
|
|
|
|
|
|
for (my $col = $min_col; $col <= $max_col; $col++) { |
539
|
|
|
|
|
|
|
push @{$cells}, { col => $col, row => $row }; |
540
|
30
|
|
|
|
|
56
|
} |
541
|
30
|
|
|
|
|
65
|
} |
542
|
30
|
|
|
|
|
70
|
} |
543
|
30
|
|
|
|
|
60
|
|
544
|
|
|
|
|
|
|
return $cells; |
545
|
30
|
|
|
|
|
61
|
} |
546
|
30
|
|
|
|
|
44
|
|
547
|
|
|
|
|
|
|
my ($spec) = @_; |
548
|
30
|
|
|
|
|
82
|
|
549
|
78
|
|
|
|
|
132
|
return unless defined $spec; |
550
|
83
|
|
|
|
|
104
|
|
|
83
|
|
|
|
|
325
|
|
551
|
|
|
|
|
|
|
die("ERROR: Unable to locate spec file [$spec][$!].\n") unless (-f $spec); |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
my $data = undef; |
554
|
|
|
|
|
|
|
my $sheet = undef; |
555
|
28
|
|
|
|
|
53
|
my $regex = undef; |
556
|
|
|
|
|
|
|
my $handle = IO::File->new($spec) || die("ERROR: Couldn't open file [$spec][$!].\n"); |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
while (my $row = <$handle>) { |
559
|
17
|
|
|
17
|
|
1046
|
chomp($row); |
560
|
|
|
|
|
|
|
next unless ($row =~ /\w/); |
561
|
17
|
50
|
|
|
|
34
|
next if ($row =~ /^#/); |
562
|
|
|
|
|
|
|
|
563
|
17
|
100
|
|
|
|
383
|
if ($row =~ /^sheet\s+(.*)/i) { |
564
|
|
|
|
|
|
|
$sheet = $1; |
565
|
16
|
|
|
|
|
36
|
} |
566
|
16
|
|
|
|
|
30
|
elsif (defined $sheet && ($row =~ /^range\s+(.*)/i)) { |
567
|
16
|
|
|
|
|
23
|
my $cells = Test::Excel::_cells_within_range($1); |
568
|
16
|
|
50
|
|
|
96
|
foreach my $cell (@{$cells}) { |
569
|
|
|
|
|
|
|
$data->{uc($sheet)}->{$cell->{col}+1}->{$cell->{row}}->{$SPECIAL_CASE} = 1 |
570
|
16
|
|
|
|
|
1461
|
} |
571
|
62
|
|
|
|
|
113
|
} |
572
|
62
|
50
|
|
|
|
194
|
elsif (defined($sheet) && ($row =~ /^regex\s+(.*)/i)) { |
573
|
62
|
50
|
|
|
|
123
|
foreach my $c (keys %{$data->{uc($sheet)}}) { |
574
|
|
|
|
|
|
|
foreach my $r (keys %{$data->{uc($sheet)}->{$c}}) { |
575
|
62
|
100
|
66
|
|
|
332
|
# Needs overriding to be regex friendly |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
576
|
29
|
|
|
|
|
186
|
$data->{uc($sheet)}->{$c}->{$r}->{$REGEX_CASE} = $1; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
} |
579
|
21
|
|
|
|
|
53
|
} |
580
|
21
|
|
|
|
|
28
|
elsif (defined($sheet) && ($row =~ /^ignorerange\s+(.*)/i)) { |
|
21
|
|
|
|
|
45
|
|
581
|
55
|
|
|
|
|
249
|
my $cells = Test::Excel::_cells_within_range($1); |
582
|
|
|
|
|
|
|
foreach my $cell (@{$cells}) { |
583
|
|
|
|
|
|
|
$data->{uc($sheet)}->{$cell->{col}+1}->{$cell->{row}}->{$IGNORE} = 1; |
584
|
|
|
|
|
|
|
} |
585
|
5
|
|
|
|
|
8
|
} |
|
5
|
|
|
|
|
29
|
|
586
|
4
|
|
|
|
|
5
|
else { |
|
4
|
|
|
|
|
11
|
|
587
|
|
|
|
|
|
|
die("ERROR: Invalid format data [$row] found in spec file.\n"); |
588
|
12
|
|
|
|
|
70
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
$handle->close(); |
592
|
|
|
|
|
|
|
|
593
|
6
|
|
|
|
|
15
|
return $data; |
594
|
6
|
|
|
|
|
9
|
} |
|
6
|
|
|
|
|
11
|
|
595
|
22
|
|
|
|
|
99
|
|
596
|
|
|
|
|
|
|
my ($hash, $key) = @_; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
return unless (defined $hash && defined $key); |
599
|
1
|
|
|
|
|
46
|
die "_get_hashval(): Not a hash." unless (ref($hash) eq 'HASH'); |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
return unless (exists $hash->{$key}); |
602
|
|
|
|
|
|
|
return $hash->{$key}; |
603
|
15
|
|
|
|
|
82
|
} |
604
|
|
|
|
|
|
|
|
605
|
15
|
|
|
|
|
278
|
my ($data) = @_; |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
return 0 unless defined $data; |
608
|
|
|
|
|
|
|
|
609
|
90
|
|
|
90
|
|
153
|
foreach (keys %{$data->{exp}}) { |
610
|
|
|
|
|
|
|
my $exp = $data->{exp}->{$_}; |
611
|
90
|
100
|
66
|
|
|
244
|
my $out = $data->{out}->{$_}; |
612
|
81
|
50
|
|
|
|
144
|
|
613
|
|
|
|
|
|
|
return 0 if grep(/$exp->[0]/,@{$out}); |
614
|
81
|
100
|
|
|
|
154
|
} |
615
|
26
|
|
|
|
|
57
|
|
616
|
|
|
|
|
|
|
return 1; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
13
|
|
|
13
|
|
21
|
my ($message) = @_; |
620
|
|
|
|
|
|
|
|
621
|
13
|
50
|
|
|
|
24
|
return unless defined($message); |
622
|
|
|
|
|
|
|
|
623
|
13
|
|
|
|
|
15
|
print {*STDOUT} $message if ($ENV{DEBUG}); |
|
13
|
|
|
|
|
31
|
|
624
|
24
|
|
|
|
|
36
|
} |
625
|
24
|
|
|
|
|
31
|
|
626
|
|
|
|
|
|
|
my ($rule) = @_; |
627
|
24
|
50
|
|
|
|
25
|
|
|
24
|
|
|
|
|
62
|
|
628
|
|
|
|
|
|
|
return unless defined $rule; |
629
|
|
|
|
|
|
|
|
630
|
13
|
|
|
|
|
47
|
die("ERROR: Invalid RULE definitions. It has to be reference to a HASH.\n") |
631
|
|
|
|
|
|
|
unless (ref($rule) eq 'HASH'); |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
my ($keys, $valid); |
634
|
3532
|
|
|
3532
|
|
4400
|
$keys = scalar(keys(%{$rule})); |
635
|
|
|
|
|
|
|
return if (($keys == 1) && exists $rule->{message}); |
636
|
3532
|
50
|
|
|
|
4941
|
|
637
|
|
|
|
|
|
|
die("ERROR: Rule has more than 8 keys defined.\n") |
638
|
3532
|
50
|
|
|
|
5861
|
if $keys > 8; |
|
0
|
|
|
|
|
0
|
|
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
$valid = {'message' => 1, |
641
|
|
|
|
|
|
|
'sheet' => 2, |
642
|
41
|
|
|
41
|
|
107
|
'spec' => 3, |
643
|
|
|
|
|
|
|
'tolerance' => 4, |
644
|
41
|
100
|
|
|
|
97
|
'sheet_tolerance' => 5, |
645
|
|
|
|
|
|
|
'error_limit' => 6, |
646
|
38
|
100
|
|
|
|
197
|
'swap_check' => 7, |
647
|
|
|
|
|
|
|
'test' => 8,}; |
648
|
|
|
|
|
|
|
|
649
|
36
|
|
|
|
|
59
|
foreach my $key (keys %{$rule}) { |
650
|
36
|
|
|
|
|
62
|
die "ERROR: Invalid key '$key' found in the rule definitions.\n" |
|
36
|
|
|
|
|
99
|
|
651
|
36
|
50
|
66
|
|
|
138
|
unless exists($valid->{$key}); |
652
|
|
|
|
|
|
|
} |
653
|
36
|
100
|
|
|
|
125
|
|
654
|
|
|
|
|
|
|
return if (exists $rule->{spec} && (keys %$rule == 1)); |
655
|
|
|
|
|
|
|
|
656
|
35
|
|
|
|
|
231
|
if ((exists $rule->{spec} && defined $rule->{spec}) |
657
|
|
|
|
|
|
|
|| |
658
|
|
|
|
|
|
|
(exists $rule->{sheet} && defined $rule->{sheet}) |
659
|
|
|
|
|
|
|
) { |
660
|
|
|
|
|
|
|
die "ERROR: Missing key sheet_tolerance in the rule definitions.\n" |
661
|
|
|
|
|
|
|
unless ( exists $rule->{sheet_tolerance} |
662
|
|
|
|
|
|
|
&& defined $rule->{sheet_tolerance}); |
663
|
|
|
|
|
|
|
die "ERROR: Missing key tolerance in the rule definitions.\n" |
664
|
|
|
|
|
|
|
unless ( exists $rule->{tolerance} |
665
|
35
|
|
|
|
|
55
|
&& defined $rule->{tolerance}); |
|
35
|
|
|
|
|
100
|
|
666
|
|
|
|
|
|
|
} |
667
|
79
|
100
|
|
|
|
219
|
else { |
668
|
|
|
|
|
|
|
if ((exists $rule->{sheet_tolerance} && defined $rule->{sheet_tolerance}) |
669
|
|
|
|
|
|
|
|| |
670
|
33
|
100
|
100
|
|
|
160
|
(exists $rule->{tolerance} && defined $rule->{tolerance}) |
671
|
|
|
|
|
|
|
) { |
672
|
26
|
100
|
66
|
|
|
167
|
die "ERROR: Missing key sheet/spec in the rule definitions.\n" |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
673
|
|
|
|
|
|
|
unless ( |
674
|
|
|
|
|
|
|
(exists $rule->{sheet} && defined $rule->{sheet}) |
675
|
|
|
|
|
|
|
|| |
676
|
|
|
|
|
|
|
(exists $rule->{spec} && defined $rule->{spec}) |
677
|
|
|
|
|
|
|
); |
678
|
22
|
100
|
66
|
|
|
164
|
} |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
20
|
100
|
66
|
|
|
239
|
|
682
|
|
|
|
|
|
|
=head1 NOTES |
683
|
|
|
|
|
|
|
|
684
|
4
|
50
|
33
|
|
|
33
|
It should be clearly noted that this module does not claim to provide fool-proof |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
685
|
|
|
|
|
|
|
comparison of generated Excels. In fact there are still a number of ways in which |
686
|
|
|
|
|
|
|
I want to expand the existing comparison functionality. This module is no longer |
687
|
|
|
|
|
|
|
actively being developed as I moved to another company.This work was part of one |
688
|
|
|
|
|
|
|
of my project. Having said, I would be more than happy to add new features if its |
689
|
|
|
|
|
|
|
requested. Any suggestions / ideas most welcome. |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=head1 CAVEATS |
692
|
|
|
|
|
|
|
|
693
|
0
|
0
|
0
|
|
|
|
Testing of large Excels can take a long time, this is because, well, we are doing |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
694
|
|
|
|
|
|
|
a lot of computation. In fact, this module test suite includes tests against |
695
|
|
|
|
|
|
|
several large Excels, however I am not including those in this distibution for |
696
|
|
|
|
|
|
|
obvious reasons. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=head1 BUGS |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
None that I am aware of.Of course, if you find a bug, let me know, and I would do |
701
|
|
|
|
|
|
|
my best to fix it. This is still a very early version, so it is always possible |
702
|
|
|
|
|
|
|
that I have just "gotten it wrong" in some places. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head1 SEE ALSO |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=over 4 |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=item L<Spreadsheet::Read> - I could not have written without this module. |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=back |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=over 4 |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=item H.Merijn Brand (author of L<Spreadsheet::Read>). |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item Kawai Takanori (author of L<Spreadsheet::ParseExcel::Utility>). |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=item Stevan Little (author of L<Test::PDF>). |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=back |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=head1 AUTHOR |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >> |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head1 REPOSITORY |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
L<https://github.com/manwar/Test-Excel> |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head1 BUGS |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-test-excel at rt.cpan.org>, |
735
|
|
|
|
|
|
|
or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Excel>. |
736
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your |
737
|
|
|
|
|
|
|
bug as I make changes. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=head1 SUPPORT |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
perldoc Test::Excel |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
You can also look for information at: |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=over 4 |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Excel> |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Test-Excel> |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=item * CPAN Ratings |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Test-Excel> |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=item * Search CPAN |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Test-Excel/> |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=back |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Copyright (C) 2010 - 2016 Mohammad S Anwar. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
772
|
|
|
|
|
|
|
the terms of the the Artistic License (2.0). You may obtain a copy of the full |
773
|
|
|
|
|
|
|
license at: |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
L<http://www.perlfoundation.org/artistic_license_2_0> |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified Versions is |
778
|
|
|
|
|
|
|
governed by this Artistic License.By using, modifying or distributing the Package, |
779
|
|
|
|
|
|
|
you accept this license. Do not use, modify, or distribute the Package, if you do |
780
|
|
|
|
|
|
|
not accept this license. |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made by someone |
783
|
|
|
|
|
|
|
other than you,you are nevertheless required to ensure that your Modified Version |
784
|
|
|
|
|
|
|
complies with the requirements of this license. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service mark, |
787
|
|
|
|
|
|
|
tradename, or logo of the Copyright Holder. |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge patent license |
790
|
|
|
|
|
|
|
to make, have made, use, offer to sell, sell, import and otherwise transfer the |
791
|
|
|
|
|
|
|
Package with respect to any patent claims licensable by the Copyright Holder that |
792
|
|
|
|
|
|
|
are necessarily infringed by the Package. If you institute patent litigation |
793
|
|
|
|
|
|
|
(including a cross-claim or counterclaim) against any party alleging that the |
794
|
|
|
|
|
|
|
Package constitutes direct or contributory patent infringement,then this Artistic |
795
|
|
|
|
|
|
|
License to you shall terminate on the date that such litigation is filed. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND |
798
|
|
|
|
|
|
|
CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED |
799
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR |
800
|
|
|
|
|
|
|
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS |
801
|
|
|
|
|
|
|
REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, |
802
|
|
|
|
|
|
|
INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE |
803
|
|
|
|
|
|
|
OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=cut |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
1; # End of Test::Excel |