line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
$Test::Excel::VERSION = '1.53'; |
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.53 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use strict; use warnings; |
16
|
7
|
|
|
7
|
|
615715
|
|
|
7
|
|
|
7
|
|
135
|
|
|
7
|
|
|
|
|
176
|
|
|
7
|
|
|
|
|
30
|
|
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
176
|
|
17
|
|
|
|
|
|
|
use 5.006; |
18
|
7
|
|
|
7
|
|
155
|
use IO::File; |
|
7
|
|
|
|
|
68
|
|
19
|
7
|
|
|
7
|
|
2787
|
use Data::Dumper; |
|
7
|
|
|
|
|
50739
|
|
|
7
|
|
|
|
|
636
|
|
20
|
7
|
|
|
7
|
|
4048
|
use Test::Builder (); |
|
7
|
|
|
|
|
43808
|
|
|
7
|
|
|
|
|
451
|
|
21
|
7
|
|
|
7
|
|
52
|
use Spreadsheet::Read; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
103
|
|
22
|
7
|
|
|
7
|
|
4175
|
use Scalar::Util 'blessed'; |
|
7
|
|
|
|
|
3069248
|
|
|
7
|
|
|
|
|
705
|
|
23
|
7
|
|
|
7
|
|
64
|
|
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
353
|
|
24
|
|
|
|
|
|
|
use parent 'Exporter'; |
25
|
7
|
|
|
7
|
|
38
|
our @ISA = qw(Exporter); |
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
36
|
|
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 files with the extensions C<.xls> or 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
|
8846
|
my $status = compare_excel($got, $exp, $rule); |
100
|
|
|
|
|
|
|
$TESTER->ok($status, $message); |
101
|
14
|
|
|
|
|
58
|
} |
102
|
7
|
|
|
|
|
73
|
|
103
|
|
|
|
|
|
|
my ($got, $exp, $rule, $message) = @_; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my $status = compare_excel($got, $exp, $rule); |
106
|
1
|
|
|
1
|
1
|
483
|
$TESTER->ok($status, $message); |
107
|
|
|
|
|
|
|
} |
108
|
1
|
|
|
|
|
4
|
|
109
|
1
|
|
|
|
|
14
|
my ($got, $exp, $rule, $message) = @_; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $status = compare_excel($got, $exp, $rule); |
112
|
|
|
|
|
|
|
if ($status == 0) { |
113
|
1
|
|
|
1
|
1
|
541
|
$TESTER->ok(1, $message); |
114
|
|
|
|
|
|
|
} |
115
|
1
|
|
|
|
|
6
|
else { |
116
|
1
|
50
|
|
|
|
8
|
$TESTER->ok(0, $message); |
117
|
1
|
|
|
|
|
62
|
} |
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
|
6471
|
}; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
die("ERROR: Unable to locate file [$got][$!].\n") unless (-f $got); |
143
|
52
|
|
|
52
|
|
109
|
die("ERROR: Unable to locate file [$exp][$!].\n") unless (-f $exp); |
144
|
52
|
50
|
|
|
|
311
|
|
145
|
45
|
|
|
|
|
394
|
_log_message("INFO: Excel comparison [$got] [$exp]\n"); |
146
|
|
|
|
|
|
|
unless (blessed($got) && $got->isa('Spreadsheet::Read')) { |
147
|
45
|
100
|
|
|
|
1344
|
$got = Spreadsheet::Read->new($got) |
148
|
43
|
100
|
|
|
|
501
|
|| die("ERROR: Couldn't create Spreadsheet::Read instance with: [$got]\n"); |
149
|
|
|
|
|
|
|
} |
150
|
41
|
|
|
|
|
336
|
|
151
|
41
|
50
|
33
|
|
|
207
|
unless (blessed($exp) && $exp->isa('Spreadsheet::Read')) { |
152
|
41
|
|
50
|
|
|
234
|
$exp = Spreadsheet::Read->new($exp) |
153
|
|
|
|
|
|
|
|| die("ERROR: Couldn't create Spreadsheet::Read instance with: [$exp]\n"); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
41
|
50
|
33
|
|
|
1105212
|
_validate_rule($rule); |
157
|
41
|
|
50
|
|
|
176
|
|
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
|
|
|
|
|
1099787
|
my @gotWorkSheets = $got->sheets(); |
162
|
|
|
|
|
|
|
my @expWorkSheets = $exp->sheets(); |
163
|
30
|
|
|
|
|
90
|
|
164
|
30
|
|
|
|
|
58
|
$spec = _parse($spec) if defined $spec; |
165
|
30
|
|
|
|
|
54
|
$error_limit = $MAX_ERRORS_PER_SHEET unless defined $error_limit; |
166
|
30
|
|
|
|
|
113
|
|
167
|
30
|
|
|
|
|
516
|
if (@gotWorkSheets != @expWorkSheets) { |
168
|
|
|
|
|
|
|
my $error = 'ERROR: Sheets count mismatch. '; |
169
|
30
|
100
|
|
|
|
346
|
$error .= 'Got: [' . @gotWorkSheets . |
170
|
29
|
100
|
|
|
|
83
|
'] exp: [' . @expWorkSheets . "]\n"; |
171
|
|
|
|
|
|
|
_log_message($error); |
172
|
29
|
100
|
|
|
|
79
|
return 0; |
173
|
1
|
|
|
|
|
3
|
} |
174
|
1
|
|
|
|
|
6
|
|
175
|
|
|
|
|
|
|
my @sheets; |
176
|
1
|
|
|
|
|
4
|
my $status = 1; |
177
|
1
|
|
|
|
|
25
|
@sheets = split(/\|/, $sheet) if defined $sheet; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
for (my $i = 0; $i < @gotWorkSheets; $i++) { |
180
|
28
|
|
|
|
|
50
|
my $error_on_sheet = 0; |
181
|
28
|
|
|
|
|
46
|
my $gotWorkSheet = $gotWorkSheets[$i]; |
182
|
28
|
100
|
|
|
|
79
|
my $expWorkSheet = $expWorkSheets[$i]; |
183
|
|
|
|
|
|
|
my $gotSheetName = $gotWorkSheet; |
184
|
28
|
|
|
|
|
83
|
my $expSheetName = $expWorkSheet; |
185
|
50
|
|
|
|
|
60
|
|
186
|
50
|
|
|
|
|
74
|
unless (exists $spec->{ALL}) { |
187
|
50
|
|
|
|
|
65
|
if (uc($gotSheetName) ne uc($expSheetName)) { |
188
|
50
|
|
|
|
|
59
|
my $error = "ERROR: Sheetname mismatch. Got: [$gotSheetName] exp: [$expSheetName].\n"; |
189
|
50
|
|
|
|
|
60
|
_log_message($error); |
190
|
|
|
|
|
|
|
return 0; |
191
|
50
|
100
|
|
|
|
95
|
} |
192
|
24
|
50
|
|
|
|
76
|
} |
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
|
|
|
|
|
140
|
my ($expColMin, $expColMax) = (1, $exp_sheet->maxcol); |
200
|
50
|
|
|
|
|
740
|
|
201
|
50
|
|
|
|
|
475
|
_log_message("INFO: [$gotSheetName]:[$gotRowMin][$gotColMin]:[$gotRowMax][$gotColMax]\n"); |
202
|
50
|
|
|
|
|
356
|
_log_message("INFO: [$expSheetName]:[$expRowMin][$expColMin]:[$expRowMax][$expColMax]\n"); |
203
|
50
|
|
|
|
|
233
|
|
204
|
50
|
|
|
|
|
199
|
if (defined($gotRowMax) && defined($expRowMax) && ($gotRowMax != $expRowMax)) { |
205
|
|
|
|
|
|
|
my $error = "ERROR: Max row counts mismatch in sheet [$gotSheetName]. "; |
206
|
50
|
|
|
|
|
387
|
$error .= "Got[$gotRowMax] Expected: [$expRowMax]\n"; |
207
|
50
|
|
|
|
|
181
|
_log_message($error); |
208
|
|
|
|
|
|
|
return 0; |
209
|
50
|
50
|
33
|
|
|
292
|
} |
|
|
|
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
|
|
|
202
|
} |
|
|
|
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
|
|
|
|
|
65
|
|
224
|
50
|
|
|
|
|
120
|
next if (defined $spec |
225
|
287
|
|
|
|
|
472
|
&& |
226
|
1879
|
|
|
|
|
3483
|
(( exists $spec->{ALL} |
227
|
1879
|
|
|
|
|
13983
|
&& 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
|
|
|
16775
|
# Number like data? |
|
|
|
66
|
|
|
|
|
241
|
|
|
|
|
|
|
if ( |
242
|
|
|
|
|
|
|
($gotData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/) |
243
|
|
|
|
|
|
|
&& |
244
|
1859
|
100
|
66
|
|
|
4236
|
($expData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/) |
245
|
|
|
|
|
|
|
) { |
246
|
1787
|
100
|
66
|
|
|
7679
|
if (($gotData < $ALMOST_ZERO) && ($expData < $ALMOST_ZERO)) { |
247
|
|
|
|
|
|
|
# Can be treated as the same. |
248
|
|
|
|
|
|
|
next; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
else { |
251
|
1555
|
50
|
33
|
|
|
3006
|
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
|
|
|
3376
|
&& exists $spec->{uc($gotSheetName)} |
257
|
101
|
|
|
|
|
135
|
&& exists $spec->{uc($gotSheetName)}->{$col} |
258
|
101
|
|
|
|
|
240
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row} |
259
|
|
|
|
|
|
|
&& exists $spec->{uc($gotSheetName)}->{$col}->{$row}->{$SPECIAL_CASE} |
260
|
101
|
100
|
66
|
|
|
954
|
) |
|
|
|
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
|
|
|
|
|
382
|
_log_message("INFO: [NUMBER]:[$gotSheetName]:[STD][".( |
271
|
|
|
|
|
|
|
$row)."][".($col)."]:[$gotData][$expData] ... "); |
272
|
65
|
|
|
|
|
100
|
$compare_with = $rule->{tolerance} || 0; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
36
|
|
|
|
|
214
|
if (defined $compare_with && ($compare_with < $difference)) { |
276
|
|
|
|
|
|
|
_log_message("[FAIL]\n"); |
277
|
36
|
|
50
|
|
|
78
|
$difference = sprintf("%02f", $difference); |
278
|
|
|
|
|
|
|
$status = 0; |
279
|
|
|
|
|
|
|
} |
280
|
101
|
100
|
66
|
|
|
278
|
else { |
281
|
8
|
|
|
|
|
20
|
$status = 1; |
282
|
8
|
|
|
|
|
48
|
_log_message("[PASS]\n"); |
283
|
8
|
|
|
|
|
14
|
} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
else { |
286
|
93
|
|
|
|
|
112
|
_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
|
|
|
|
|
4047
|
} |
292
|
|
|
|
|
|
|
else { |
293
|
1454
|
100
|
|
|
|
1963
|
$status = 1; |
294
|
2
|
|
|
|
|
10
|
_log_message("[PASS]\n"); |
295
|
2
|
|
|
|
|
504
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
1452
|
|
|
|
|
1508
|
} |
299
|
1452
|
|
|
|
|
1788
|
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
|
|
|
2028
|
) |
|
|
|
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
|
|
|
|
|
665
|
} |
321
|
60
|
100
|
66
|
|
|
358
|
else { |
322
|
59
|
|
|
|
|
84
|
_log_message("INFO: [REGEX]:[$gotSheetName]:[$expData][$gotData][$exp] ... [FAIL]\n"); |
323
|
59
|
|
|
|
|
194
|
$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
|
|
|
|
300
|
} |
334
|
10
|
|
|
|
|
45
|
else { |
335
|
10
|
50
|
|
|
|
26
|
return 0; |
336
|
10
|
|
|
|
|
14
|
} |
337
|
10
|
|
|
|
|
18
|
} |
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
|
|
|
|
|
179
|
} |
345
|
162
|
|
|
|
|
520
|
|
346
|
|
|
|
|
|
|
if ( exists $rule->{swap_check} |
347
|
|
|
|
|
|
|
&& defined $rule->{swap_check} |
348
|
|
|
|
|
|
|
&& $rule->{swap_check} |
349
|
|
|
|
|
|
|
) { |
350
|
|
|
|
|
|
|
if ($status == 0) { |
351
|
1785
|
100
|
66
|
|
|
3179
|
$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
|
|
|
|
139
|
if (($error_on_sheet >= $error_limit) |
356
|
16
|
|
|
|
|
19
|
&& ($error_on_sheet % 2 == 0) |
357
|
16
|
|
|
|
|
17
|
&& !_is_swapping($swap)) { |
|
16
|
|
|
|
|
32
|
|
358
|
16
|
|
|
|
|
22
|
_log_message("ERROR: Max error per sheet reached.[$error_on_sheet]\n"); |
|
16
|
|
|
|
|
28
|
|
359
|
|
|
|
|
|
|
return $status; |
360
|
16
|
50
|
100
|
|
|
73
|
} |
|
|
|
66
|
|
|
|
|
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} |
363
|
0
|
|
|
|
|
0
|
else { |
364
|
0
|
|
|
|
|
0
|
return $status if ($status == 0); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} # col |
368
|
|
|
|
|
|
|
|
369
|
1723
|
100
|
|
|
|
3476
|
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
|
|
|
657
|
} |
|
|
|
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
|
|
|
131
|
_log_message("WARN: SWAP OCCURRED.\n"); |
|
|
|
66
|
|
|
|
|
383
|
|
|
|
|
|
|
$status = 1; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
9
|
100
|
66
|
|
|
28
|
|
387
|
3
|
|
|
|
|
15
|
_log_message("INFO: [$gotSheetName]: ..... [OK].\n"); |
388
|
3
|
|
|
|
|
5
|
} # sheet |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
return $status; |
391
|
|
|
|
|
|
|
} |
392
|
45
|
|
|
|
|
102
|
|
393
|
|
|
|
|
|
|
=head1 RULE |
394
|
|
|
|
|
|
|
|
395
|
23
|
|
|
|
|
1240
|
The parameter 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
|
|
|
|
|
|
|
A spec file containing rules used should be in the format mentioned below. Keys |
415
|
|
|
|
|
|
|
and values are space-separated. |
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 |
425
|
|
|
|
|
|
|
specification file. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
The following specification forces regex comparison in all sheets in |
428
|
|
|
|
|
|
|
range C<B2:B4>. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sheet ALL |
431
|
|
|
|
|
|
|
range B2:B4 |
432
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
The following specification forces regex comparison in all sheets. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sheet ALL |
437
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
The following specification forces regex comparison in the sheet |
440
|
|
|
|
|
|
|
named C<Demo> in range C<B2:B4>. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sheet Demo |
443
|
|
|
|
|
|
|
range B2:B4 |
444
|
|
|
|
|
|
|
regex 2022\-\d\d\-\d\d |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head1 What Is "Visually" Similar? |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
This module uses the L<Spreadsheet::Read> module to parse the Excel |
449
|
|
|
|
|
|
|
files and then compares the parsed data structure for differences. It |
450
|
|
|
|
|
|
|
ignores certain components of the Excel file, such as embedded fonts, |
451
|
|
|
|
|
|
|
images, forms and annotations, and focuses entirely on the layout of |
452
|
|
|
|
|
|
|
each Excel page instead. Future versions may support font and image |
453
|
|
|
|
|
|
|
comparisons as well. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head1 How to find out what failed the comparison? |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Setting the environment variable DEBUG to a non-zero, non-empty value |
458
|
|
|
|
|
|
|
will output the PASS/FAIL comparison. For example: |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
$> $DEBUG=1 perl your-test-script.pl |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=cut |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# |
465
|
|
|
|
|
|
|
# |
466
|
|
|
|
|
|
|
# PRIVATE METHODS |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
my ($cell) = @_; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return unless defined $cell; |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
die "ERROR: Invalid cell address [$cell].\n" |
473
|
|
|
|
|
|
|
unless ($cell =~ /([A-Za-z]+)(\d+)/); |
474
|
61
|
|
|
61
|
|
230
|
|
475
|
|
|
|
|
|
|
return ($1, $2); |
476
|
61
|
50
|
|
|
|
99
|
} |
477
|
|
|
|
|
|
|
|
478
|
61
|
50
|
|
|
|
158
|
my ($letter) = @_; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
return col2int($letter); |
481
|
61
|
|
|
|
|
170
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
484
|
|
|
|
|
|
|
# col2int (for Spreadsheet::ParseExcel::Utility) |
485
|
61
|
|
|
61
|
|
1580
|
# ------------------------------------------------------------------- |
486
|
|
|
|
|
|
|
my $result = 0; |
487
|
61
|
|
|
|
|
87
|
my $str = shift; |
488
|
|
|
|
|
|
|
my $incr = 0; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
for ( my $i = length($str) ; $i > 0 ; $i-- ) { |
491
|
|
|
|
|
|
|
my $char = substr( $str, $i - 1 ); |
492
|
|
|
|
|
|
|
my $curr += ord( lc($char) ) - ord('a') + 1; |
493
|
|
|
|
|
|
|
$curr *= $incr if ($incr); |
494
|
61
|
|
|
61
|
0
|
72
|
$result += $curr; |
495
|
61
|
|
|
|
|
75
|
$incr += 26; |
496
|
61
|
|
|
|
|
61
|
} |
497
|
|
|
|
|
|
|
|
498
|
61
|
|
|
|
|
118
|
# this is one out as we range 0..x-1 not 1..x |
499
|
62
|
|
|
|
|
99
|
$result--; |
500
|
62
|
|
|
|
|
96
|
|
501
|
62
|
100
|
|
|
|
98
|
return $result; |
502
|
62
|
|
|
|
|
61
|
} |
503
|
62
|
|
|
|
|
102
|
|
504
|
|
|
|
|
|
|
my ($number) = @_; |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
return int2col($number); |
507
|
61
|
|
|
|
|
65
|
} |
508
|
|
|
|
|
|
|
|
509
|
61
|
|
|
|
|
82
|
# ------------------------------------------------------------------- |
510
|
|
|
|
|
|
|
# int2col (for Spreadsheet::ParseExcel::Utility) |
511
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
512
|
|
|
|
|
|
|
my $out = ""; |
513
|
33
|
|
|
33
|
|
669
|
my $val = shift; |
514
|
|
|
|
|
|
|
|
515
|
33
|
|
|
|
|
51
|
do { |
516
|
|
|
|
|
|
|
$out .= chr( ( $val % 26 ) + ord('A') ); |
517
|
|
|
|
|
|
|
$val = int( $val / 26 ) - 1; |
518
|
|
|
|
|
|
|
} while ( $val >= 0 ); |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
return scalar reverse $out; |
521
|
|
|
|
|
|
|
} |
522
|
33
|
|
|
33
|
0
|
40
|
|
523
|
33
|
|
|
|
|
63
|
my ($range) = @_; |
524
|
|
|
|
|
|
|
|
525
|
33
|
|
|
|
|
58
|
return unless defined $range; |
526
|
34
|
|
|
|
|
58
|
|
527
|
34
|
|
|
|
|
75
|
my $cells = []; |
528
|
|
|
|
|
|
|
foreach my $_range (split /\,/,$range) { |
529
|
|
|
|
|
|
|
die "ERROR: Invalid range [$_range].\n" |
530
|
33
|
|
|
|
|
98
|
unless ($_range =~ /(\w+\d+):(\w+\d+)/); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
my $from = $1; |
533
|
|
|
|
|
|
|
my $to = $2; |
534
|
28
|
|
|
28
|
|
1447
|
my ($min_col, $min_row) = Test::Excel::_column_row($from); |
535
|
|
|
|
|
|
|
my ($max_col, $max_row) = Test::Excel::_column_row($to); |
536
|
28
|
50
|
|
|
|
57
|
|
537
|
|
|
|
|
|
|
$min_col = Test::Excel::_letter_to_number($min_col); |
538
|
28
|
|
|
|
|
48
|
$max_col = Test::Excel::_letter_to_number($max_col); |
539
|
28
|
|
|
|
|
87
|
|
540
|
30
|
50
|
|
|
|
149
|
for (my $row = $min_row; $row <= $max_row; $row++) { |
541
|
|
|
|
|
|
|
for (my $col = $min_col; $col <= $max_col; $col++) { |
542
|
|
|
|
|
|
|
push @{$cells}, { col => $col, row => $row }; |
543
|
30
|
|
|
|
|
50
|
} |
544
|
30
|
|
|
|
|
77
|
} |
545
|
30
|
|
|
|
|
54
|
} |
546
|
30
|
|
|
|
|
56
|
|
547
|
|
|
|
|
|
|
return $cells; |
548
|
30
|
|
|
|
|
67
|
} |
549
|
30
|
|
|
|
|
48
|
|
550
|
|
|
|
|
|
|
my ($spec) = @_; |
551
|
30
|
|
|
|
|
78
|
|
552
|
78
|
|
|
|
|
141
|
return unless defined $spec; |
553
|
83
|
|
|
|
|
83
|
|
|
83
|
|
|
|
|
288
|
|
554
|
|
|
|
|
|
|
die "ERROR: Unable to locate spec file [$spec][$!].\n" |
555
|
|
|
|
|
|
|
unless (-f $spec); |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
my $data = undef; |
558
|
28
|
|
|
|
|
48
|
my $sheet = undef; |
559
|
|
|
|
|
|
|
my $regex = undef; |
560
|
|
|
|
|
|
|
my $handle = IO::File->new($spec) |
561
|
|
|
|
|
|
|
|| die "ERROR: Couldn't open file [$spec][$!].\n"; |
562
|
17
|
|
|
17
|
|
927
|
|
563
|
|
|
|
|
|
|
while (my $row = <$handle>) { |
564
|
17
|
50
|
|
|
|
39
|
chomp($row); |
565
|
|
|
|
|
|
|
next unless ($row =~ /\w/); |
566
|
17
|
100
|
|
|
|
566
|
next if ($row =~ /^#/); |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
if ($row =~ /^sheet\s+(.*)/i) { |
569
|
16
|
|
|
|
|
51
|
$sheet = $1; |
570
|
16
|
|
|
|
|
24
|
} |
571
|
16
|
|
|
|
|
27
|
elsif (defined $sheet && ($row =~ /^range\s+(.*)/i)) { |
572
|
16
|
|
50
|
|
|
119
|
my $cells = Test::Excel::_cells_within_range($1); |
573
|
|
|
|
|
|
|
foreach my $cell (@{$cells}) { |
574
|
|
|
|
|
|
|
$data->{uc($sheet)}->{$cell->{col}+1}->{$cell->{row}}->{$SPECIAL_CASE} = 1 |
575
|
16
|
|
|
|
|
1688
|
} |
576
|
62
|
|
|
|
|
114
|
} |
577
|
62
|
50
|
|
|
|
202
|
elsif (defined($sheet) && ($row =~ /^regex\s+(.*)/i)) { |
578
|
62
|
50
|
|
|
|
119
|
foreach my $c (keys %{$data->{uc($sheet)}}) { |
579
|
|
|
|
|
|
|
foreach my $r (keys %{$data->{uc($sheet)}->{$c}}) { |
580
|
62
|
100
|
66
|
|
|
328
|
# Needs overriding to be regex friendly |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
581
|
29
|
|
|
|
|
183
|
$data->{uc($sheet)}->{$c}->{$r}->{$REGEX_CASE} = $1; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
} |
584
|
21
|
|
|
|
|
60
|
} |
585
|
21
|
|
|
|
|
29
|
elsif (defined($sheet) && ($row =~ /^ignorerange\s+(.*)/i)) { |
|
21
|
|
|
|
|
44
|
|
586
|
55
|
|
|
|
|
257
|
my $cells = Test::Excel::_cells_within_range($1); |
587
|
|
|
|
|
|
|
foreach my $cell (@{$cells}) { |
588
|
|
|
|
|
|
|
$data->{uc($sheet)}->{$cell->{col}+1}->{$cell->{row}}->{$IGNORE} = 1; |
589
|
|
|
|
|
|
|
} |
590
|
5
|
|
|
|
|
5
|
} |
|
5
|
|
|
|
|
33
|
|
591
|
4
|
|
|
|
|
5
|
else { |
|
4
|
|
|
|
|
9
|
|
592
|
|
|
|
|
|
|
die "ERROR: Invalid format data [$row] found in spec file.\n"; |
593
|
12
|
|
|
|
|
66
|
} |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
$handle->close(); |
597
|
|
|
|
|
|
|
|
598
|
6
|
|
|
|
|
15
|
return $data; |
599
|
6
|
|
|
|
|
9
|
} |
|
6
|
|
|
|
|
13
|
|
600
|
22
|
|
|
|
|
100
|
|
601
|
|
|
|
|
|
|
my ($hash, $key) = @_; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
return unless (defined $hash && defined $key); |
604
|
1
|
|
|
|
|
50
|
die "_get_hashval(): Not a hash." unless (ref($hash) eq 'HASH'); |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
return unless (exists $hash->{$key}); |
607
|
|
|
|
|
|
|
return $hash->{$key}; |
608
|
15
|
|
|
|
|
79
|
} |
609
|
|
|
|
|
|
|
|
610
|
15
|
|
|
|
|
303
|
my ($data) = @_; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
return 0 unless defined $data; |
613
|
|
|
|
|
|
|
|
614
|
90
|
|
|
90
|
|
146
|
foreach (keys %{$data->{exp}}) { |
615
|
|
|
|
|
|
|
my $exp = $data->{exp}->{$_}; |
616
|
90
|
100
|
66
|
|
|
283
|
my $out = $data->{out}->{$_}; |
617
|
81
|
50
|
|
|
|
142
|
|
618
|
|
|
|
|
|
|
return 0 if grep(/$exp->[0]/,@{$out}); |
619
|
81
|
100
|
|
|
|
163
|
} |
620
|
26
|
|
|
|
|
50
|
|
621
|
|
|
|
|
|
|
return 1; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
13
|
|
|
13
|
|
23
|
my ($message) = @_; |
625
|
|
|
|
|
|
|
|
626
|
13
|
50
|
|
|
|
25
|
return unless defined($message); |
627
|
|
|
|
|
|
|
|
628
|
13
|
|
|
|
|
16
|
print {*STDOUT} $message if ($ENV{DEBUG}); |
|
13
|
|
|
|
|
35
|
|
629
|
24
|
|
|
|
|
33
|
} |
630
|
24
|
|
|
|
|
29
|
|
631
|
|
|
|
|
|
|
my ($rule) = @_; |
632
|
24
|
50
|
|
|
|
26
|
|
|
24
|
|
|
|
|
51
|
|
633
|
|
|
|
|
|
|
return unless defined $rule; |
634
|
|
|
|
|
|
|
|
635
|
13
|
|
|
|
|
46
|
die "ERROR: Invalid RULE definitions. It has to be reference to a HASH.\n" |
636
|
|
|
|
|
|
|
unless (ref($rule) eq 'HASH'); |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
my ($keys, $valid); |
639
|
3532
|
|
|
3532
|
|
4362
|
$keys = scalar(keys(%{$rule})); |
640
|
|
|
|
|
|
|
return if (($keys == 1) && exists $rule->{message}); |
641
|
3532
|
50
|
|
|
|
4712
|
|
642
|
|
|
|
|
|
|
die "ERROR: Rule has more than 8 keys defined.\n" |
643
|
3532
|
50
|
|
|
|
5952
|
if $keys > 8; |
|
0
|
|
|
|
|
0
|
|
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
$valid = { |
646
|
|
|
|
|
|
|
'message' => 1, |
647
|
41
|
|
|
41
|
|
121
|
'sheet' => 2, |
648
|
|
|
|
|
|
|
'spec' => 3, |
649
|
41
|
100
|
|
|
|
126
|
'tolerance' => 4, |
650
|
|
|
|
|
|
|
'sheet_tolerance' => 5, |
651
|
38
|
100
|
|
|
|
232
|
'error_limit' => 6, |
652
|
|
|
|
|
|
|
'swap_check' => 7, |
653
|
|
|
|
|
|
|
'test' => 8, |
654
|
36
|
|
|
|
|
66
|
}; |
655
|
36
|
|
|
|
|
61
|
|
|
36
|
|
|
|
|
119
|
|
656
|
36
|
50
|
66
|
|
|
151
|
foreach my $key (keys %{$rule}) { |
657
|
|
|
|
|
|
|
die "ERROR: Invalid key '$key' found in the rule definitions.\n" |
658
|
36
|
100
|
|
|
|
137
|
unless exists($valid->{$key}); |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
35
|
|
|
|
|
276
|
return if (exists $rule->{spec} && (keys %$rule == 1)); |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
if ((exists $rule->{spec} && defined $rule->{spec}) |
664
|
|
|
|
|
|
|
|| |
665
|
|
|
|
|
|
|
(exists $rule->{sheet} && defined $rule->{sheet}) |
666
|
|
|
|
|
|
|
) { |
667
|
|
|
|
|
|
|
die "ERROR: Missing key sheet_tolerance in the rule definitions.\n" |
668
|
|
|
|
|
|
|
unless ( exists $rule->{sheet_tolerance} |
669
|
|
|
|
|
|
|
&& defined $rule->{sheet_tolerance}); |
670
|
|
|
|
|
|
|
die "ERROR: Missing key tolerance in the rule definitions.\n" |
671
|
|
|
|
|
|
|
unless ( exists $rule->{tolerance} |
672
|
35
|
|
|
|
|
68
|
&& defined $rule->{tolerance}); |
|
35
|
|
|
|
|
114
|
|
673
|
|
|
|
|
|
|
} |
674
|
79
|
100
|
|
|
|
261
|
else { |
675
|
|
|
|
|
|
|
if ((exists $rule->{sheet_tolerance} && defined $rule->{sheet_tolerance}) |
676
|
|
|
|
|
|
|
|| |
677
|
33
|
100
|
100
|
|
|
185
|
(exists $rule->{tolerance} && defined $rule->{tolerance}) |
678
|
|
|
|
|
|
|
) { |
679
|
26
|
100
|
66
|
|
|
217
|
die "ERROR: Missing key sheet/spec in the rule definitions.\n" |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
680
|
|
|
|
|
|
|
unless ( |
681
|
|
|
|
|
|
|
(exists $rule->{sheet} && defined $rule->{sheet}) |
682
|
|
|
|
|
|
|
|| |
683
|
|
|
|
|
|
|
(exists $rule->{spec} && defined $rule->{spec}) |
684
|
|
|
|
|
|
|
); |
685
|
22
|
100
|
66
|
|
|
277
|
} |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
20
|
100
|
66
|
|
|
311
|
|
689
|
|
|
|
|
|
|
=head1 NOTES |
690
|
|
|
|
|
|
|
|
691
|
4
|
50
|
33
|
|
|
50
|
It should be clearly noted that this module does not claim to provide fool-proof |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
692
|
|
|
|
|
|
|
comparison of generated Excel files. In fact there are still a number of ways in |
693
|
|
|
|
|
|
|
which I want to expand the existing comparison functionality. This module is no |
694
|
|
|
|
|
|
|
longer actively being developed as I moved to another company. This work was part |
695
|
|
|
|
|
|
|
of one of my projects. Having said that, I would be more than happy to add new |
696
|
|
|
|
|
|
|
features if requested. Any suggestions / ideas most welcome. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=head1 CAVEATS |
699
|
|
|
|
|
|
|
|
700
|
0
|
0
|
0
|
|
|
|
Testing large Excel files can take a long time. This is because, well, it is doing |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
701
|
|
|
|
|
|
|
a lot of computation. In fact, the test suite for this module includes tests against |
702
|
|
|
|
|
|
|
several large Excel files; however, I am not including those in this distibution for |
703
|
|
|
|
|
|
|
obvious reasons. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=head1 BUGS |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
None that I am aware of. Of course, if you find a bug, let me know, and I would do |
708
|
|
|
|
|
|
|
my best to fix it. This is still a very early version, so it is always possible |
709
|
|
|
|
|
|
|
that I have just "gotten it wrong" in some places. |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head1 SEE ALSO |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=over 4 |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=item L<Spreadsheet::Read> - I could not have written without this module. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=back |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=over 4 |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=item H.Merijn Brand (author of L<Spreadsheet::Read>). |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=item Kawai Takanori (author of L<Spreadsheet::ParseExcel::Utility>). |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=item Stevan Little (author of L<Test::PDF>). |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=back |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head1 AUTHOR |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >> |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=over 4 |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item * Julien Fiegehenn |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=item * Ed Sabol |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=back |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head1 REPOSITORY |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
L<https://github.com/manwar/Test-Excel> |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=head1 BUGS |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-test-excel at rt.cpan.org>, |
752
|
|
|
|
|
|
|
or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Excel>. |
753
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your |
754
|
|
|
|
|
|
|
bug as I make changes. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=head1 SUPPORT |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
perldoc Test::Excel |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
You can also look for information at: |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=over 4 |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=item * BUG Report |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
L<https://github.com/manwar/Test-Excel/issues> |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Test-Excel> |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item * CPAN Ratings |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Test-Excel> |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=item * Search MetaCPAN |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
L<https://metacpan.org/dist/Test-Excel/> |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=back |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Copyright (C) 2010 - 2022 Mohammad S Anwar. |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
789
|
|
|
|
|
|
|
the terms of the the Artistic License (2.0). You may obtain a copy of the full |
790
|
|
|
|
|
|
|
license at: |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
L<http://www.perlfoundation.org/artistic_license_2_0> |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified Versions is |
795
|
|
|
|
|
|
|
governed by this Artistic License.By using, modifying or distributing the Package, |
796
|
|
|
|
|
|
|
you accept this license. Do not use, modify, or distribute the Package, if you do |
797
|
|
|
|
|
|
|
not accept this license. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made by someone |
800
|
|
|
|
|
|
|
other than you,you are nevertheless required to ensure that your Modified Version |
801
|
|
|
|
|
|
|
complies with the requirements of this license. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service mark, |
804
|
|
|
|
|
|
|
tradename, or logo of the Copyright Holder. |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge patent license |
807
|
|
|
|
|
|
|
to make, have made, use, offer to sell, sell, import and otherwise transfer the |
808
|
|
|
|
|
|
|
Package with respect to any patent claims licensable by the Copyright Holder that |
809
|
|
|
|
|
|
|
are necessarily infringed by the Package. If you institute patent litigation |
810
|
|
|
|
|
|
|
(including a cross-claim or counterclaim) against any party alleging that the |
811
|
|
|
|
|
|
|
Package constitutes direct or contributory patent infringement,then this Artistic |
812
|
|
|
|
|
|
|
License to you shall terminate on the date that such litigation is filed. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND |
815
|
|
|
|
|
|
|
CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED |
816
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR |
817
|
|
|
|
|
|
|
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS |
818
|
|
|
|
|
|
|
REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, |
819
|
|
|
|
|
|
|
INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE |
820
|
|
|
|
|
|
|
OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=cut |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
1; # End of Test::Excel |