| 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 |