File Coverage

blib/lib/Test/Excel.pm
Criterion Covered Total %
statement 244 263 92.7
branch 100 130 76.9
condition 114 175 65.1
subroutine 25 25 100.0
pod 4 6 66.6
total 487 599 81.3


line stmt bran cond sub pod time code
1              
2             $Test::Excel::VERSION = '1.51';
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.51
12              
13             =cut
14              
15             use strict; use warnings;
16 7     7   536824  
  7     7   64  
  7         170  
  7         30  
  7         8  
  7         135  
17             use 5.006;
18 7     7   125 use IO::File;
  7         19  
19 7     7   2409 use Data::Dumper;
  7         44329  
  7         551  
20 7     7   3206 use Test::Builder ();
  7         38160  
  7         341  
21 7     7   42 use Spreadsheet::Read;
  7         10  
  7         92  
22 7     7   3606 use Scalar::Util 'blessed';
  7         2678625  
  7         528  
23 7     7   51  
  7         15  
  7         257  
24             use parent 'Exporter';
25 7     7   31 our @ISA = qw(Exporter);
  7         11  
  7         31  
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 7335 my $status = compare_excel($got, $exp, $rule);
100             $TESTER->ok($status, $message);
101 14         43 }
102 7         34  
103             my ($got, $exp, $rule, $message) = @_;
104              
105             my $status = compare_excel($got, $exp, $rule);
106 1     1 1 235 $TESTER->ok($status, $message);
107             }
108 1         4  
109 1         8 my ($got, $exp, $rule, $message) = @_;
110              
111             my $status = compare_excel($got, $exp, $rule);
112             if ($status == 0) {
113 1     1 1 364 $TESTER->ok(1, $message);
114             }
115 1         4 else {
116 1 50       4 $TESTER->ok(0, $message);
117 1         38 }
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 44     44 1 6307 };
141              
142             die("ERROR: Unable to locate file [$got][$!].\n") unless (-f $got);
143 52     52   104 die("ERROR: Unable to locate file [$exp][$!].\n") unless (-f $exp);
144 52 50       316  
145 44         283 _log_message("INFO: Excel comparison [$got] [$exp]\n");
146             unless (blessed($got) && $got->isa('Spreadsheet::Read')) {
147 44 100       836 $got = Spreadsheet::Read->new($got)
148 42 100       400 || die("ERROR: Couldn't create Spreadsheet::Read instance with: [$got]\n");
149             }
150 40         227  
151 40 50 33     172 unless (blessed($exp) && $exp->isa('Spreadsheet::Read')) {
152 40   50     173 $exp = Spreadsheet::Read->new($exp)
153             || die("ERROR: Couldn't create Spreadsheet::Read instance with: [$exp]\n");
154             }
155              
156 40 50 33     941080 _validate_rule($rule);
157 40   50     125  
158             my $spec = _get_hashval($rule, 'spec');
159             my $error_limit = _get_hashval($rule, 'error_limit');
160             my $sheet = _get_hashval($rule, 'sheet');
161 40         934330 my @gotWorkSheets = $got->sheets();
162             my @expWorkSheets = $exp->sheets();
163 29         75  
164 29         51 $spec = _parse($spec) if defined $spec;
165 29         56 $error_limit = $MAX_ERRORS_PER_SHEET unless defined $error_limit;
166 29         88  
167 29         437 if (@gotWorkSheets != @expWorkSheets) {
168             my $error = 'ERROR: Sheets count mismatch. ';
169 29 100       299 $error .= 'Got: [' . @gotWorkSheets .
170 28 100       71 '] exp: [' . @expWorkSheets . "]\n";
171             _log_message($error);
172 28 100       78 return 0;
173 1         2 }
174 1         5  
175             my @sheets;
176 1         4 my $status = 1;
177 1         28 @sheets = split(/\|/, $sheet) if defined $sheet;
178              
179             for (my $i = 0; $i < @gotWorkSheets; $i++) {
180 27         61 my $error_on_sheet = 0;
181 27         39 my $gotWorkSheet = $gotWorkSheets[$i];
182 27 100       60 my $expWorkSheet = $expWorkSheets[$i];
183             my $gotSheetName = $gotWorkSheet;
184 27         80 my $expSheetName = $expWorkSheet;
185 49         60  
186 49         66 unless (exists $spec->{ALL}) {
187 49         56 if (uc($gotSheetName) ne uc($expSheetName)) {
188 49         53 my $error = "ERROR: Sheetname mismatch. Got: [$gotSheetName] exp: [$expSheetName].\n";
189 49         52 _log_message($error);
190             return 0;
191 49 100       83 }
192 23 50       57 }
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 49         125 my ($expColMin, $expColMax) = (1, $exp_sheet->maxcol);
200 49         614  
201 49         423 _log_message("INFO: [$gotSheetName]:[$gotRowMin][$gotColMin]:[$gotRowMax][$gotColMax]\n");
202 49         258 _log_message("INFO: [$expSheetName]:[$expRowMin][$expColMin]:[$expRowMax][$expColMax]\n");
203 49         198  
204 49         187 if (defined($gotRowMax) && defined($expRowMax) && ($gotRowMax != $expRowMax)) {
205             my $error = "ERROR: Max row counts mismatch in sheet [$gotSheetName]. ";
206 49         284 $error .= "Got[$gotRowMax] Expected: [$expRowMax]\n";
207 49         147 _log_message($error);
208             return 0;
209 49 50 33     232 }
      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 49 50 33     196 }
      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 49         57  
224 49         98 next if (defined $spec
225 283         395 &&
226 1871         2756 (( exists $spec->{ALL}
227 1871         11764 && 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 1871 100 100     14715 # Number like data?
      66        
241             if (
242             ($gotData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/)
243             &&
244 1851 100 66     3802 ($expData =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/)
245             ) {
246 1779 100 66     6826 if (($gotData < $ALMOST_ZERO) && ($expData < $ALMOST_ZERO)) {
247             # Can be treated as the same.
248             next;
249             }
250             else {
251 1555 50 33     2602 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     3127 && exists $spec->{uc($gotSheetName)}
257 101         104 && exists $spec->{uc($gotSheetName)}->{$col}
258 101         190 && exists $spec->{uc($gotSheetName)}->{$col}->{$row}
259             && exists $spec->{uc($gotSheetName)}->{$col}->{$row}->{$SPECIAL_CASE}
260 101 100 66     851 )
      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         323 _log_message("INFO: [NUMBER]:[$gotSheetName]:[STD][".(
271             $row)."][".($col)."]:[$gotData][$expData] ... ");
272 65         94 $compare_with = $rule->{tolerance} || 0;
273             }
274              
275 36         178 if (defined $compare_with && ($compare_with < $difference)) {
276             _log_message("[FAIL]\n");
277 36   50     69 $difference = sprintf("%02f", $difference);
278             $status = 0;
279             }
280 101 100 66     283 else {
281 8         12 $status = 1;
282 8         32 _log_message("[PASS]\n");
283 8         11 }
284             }
285             else {
286 93         110 _log_message("INFO: [NUMBER]:[$gotSheetName]:[N/A][".
287 93         108 ($row)."][".($col)."]:[$gotData][$expData] ... ");
288             if ($expData != $gotData) {
289             _log_message("[FAIL]\n");
290             return 0;
291 1454         3401 }
292             else {
293 1454 100       1748 $status = 1;
294 2         13 _log_message("[PASS]\n");
295 2         257 }
296             }
297             }
298 1452         1285 }
299 1452         1422 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 224 100 66     1770 )
      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 57         516 }
321 57 100 66     301 else {
322 56         68 _log_message("INFO: [REGEX]:[$gotSheetName]:[$expData][$gotData][$exp] ... [FAIL]\n");
323 56         176 $status = 0;
324             }
325             }
326             else {
327 1         6 # String like data?
328 1         1 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 167 100       279 }
334 10         39 else {
335 10 50       18 return 0;
336 10         14 }
337 10         16 }
338             else {
339             $status = 1;
340 0         0 _log_message("INFO: [STRING]:[$gotSheetName]:[STD][".
341             ($row)."][".($col)."]:[$gotData][$expData] ... [PASS]\n");
342             }
343             }
344 157         155 }
345 157         423  
346             if ( exists $rule->{swap_check}
347             && defined $rule->{swap_check}
348             && $rule->{swap_check}
349             ) {
350             if ($status == 0) {
351 1777 100 66     2913 $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       144 if (($error_on_sheet >= $error_limit)
356 16         13 && ($error_on_sheet % 2 == 0)
357 16         15 && !_is_swapping($swap)) {
  16         31  
358 16         19 _log_message("ERROR: Max error per sheet reached.[$error_on_sheet]\n");
  16         20  
359             return $status;
360 16 50 100     60 }
      66        
361             }
362             }
363 0         0 else {
364 0         0 return $status if ($status == 0);
365             }
366             }
367             } # col
368              
369 1715 100       3118 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 278 50 100     600 }
      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 44 50 66     115 _log_message("WARN: SWAP OCCURRED.\n");
      66        
383             $status = 1;
384             }
385             }
386 9 100 66     20  
387 3         8 _log_message("INFO: [$gotSheetName]: ..... [OK].\n");
388 3         4 } # sheet
389              
390             return $status;
391             }
392 44         89  
393             =head1 RULE
394              
395 22         794 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 59     59   191 return ($1, $2);
473             }
474 59 50       86  
475             my ($letter) = @_;
476 59 50       149  
477             return col2int($letter);
478 59         141 }
479              
480             # --------------------------------------------------------------------------
481             # col2int (for Spreadsheet::ParseExcel::Utility)
482 59     59   1342 # --------------------------------------------------------------------------
483             my $result = 0;
484 59         102 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 59     59 0 64 $result += $curr;
492 59         62 $incr += 26;
493 59         62 }
494              
495 59         102 # this is one out as we range 0..x-1 not 1..x
496 60         88 $result--;
497 60         99  
498 60 100       83 return $result;
499 60         62 }
500 60         100  
501             my ($number) = @_;
502              
503             return int2col($number);
504 59         55 }
505              
506 59         72 # --------------------------------------------------------------------------
507             # int2col (for Spreadsheet::ParseExcel::Utility)
508             # --------------------------------------------------------------------------
509             my $out = "";
510 33     33   623 my $val = shift;
511              
512 33         42 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 33  
520 33         43 my ($range) = @_;
521              
522 33         51 return unless defined $range;
523 34         48  
524 34         60 my $cells = [];
525             foreach my $_range (split /\,/,$range) {
526             die("ERROR: Invalid range [$_range].\n")
527 33         77 unless ($_range =~ /(\w+\d+):(\w+\d+)/);
528              
529             my $from = $1;
530             my $to = $2;
531 27     27   1540 my ($min_col, $min_row) = Test::Excel::_column_row($from);
532             my ($max_col, $max_row) = Test::Excel::_column_row($to);
533 27 50       55  
534             $min_col = Test::Excel::_letter_to_number($min_col);
535 27         41 $max_col = Test::Excel::_letter_to_number($max_col);
536 27         77  
537 29 50       166 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 29         54 }
541 29         62 }
542 29         58 }
543 29         53  
544             return $cells;
545 29         62 }
546 29         52  
547             my ($spec) = @_;
548 29         65  
549 75         125 return unless defined $spec;
550 80         80  
  80         272  
551             die("ERROR: Unable to locate spec file [$spec][$!].\n") unless (-f $spec);
552              
553             my $data = undef;
554             my $sheet = undef;
555 27         46 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 16     16   916 chomp($row);
560             next unless ($row =~ /\w/);
561 16 50       37 next if ($row =~ /^#/);
562              
563 16 100       282 if ($row =~ /^sheet\s+(.*)/i) {
564             $sheet = $1;
565 15         41 }
566 15         19 elsif (defined $sheet && ($row =~ /^range\s+(.*)/i)) {
567 15         28 my $cells = Test::Excel::_cells_within_range($1);
568 15   50     78 foreach my $cell (@{$cells}) {
569             $data->{uc($sheet)}->{$cell->{col}+1}->{$cell->{row}}->{$SPECIAL_CASE} = 1
570 15         1199 }
571 59         94 }
572 59 50       157 elsif (defined($sheet) && ($row =~ /^regex\s+(.*)/i)) {
573 59 50       99 foreach my $c (keys %{$data->{uc($sheet)}}) {
574             foreach my $r (keys %{$data->{uc($sheet)}->{$c}}) {
575 59 100 66     284 # Needs overriding to be regex friendly
    100 66        
    100 66        
    100          
576 28         157 $data->{uc($sheet)}->{$c}->{$r}->{$REGEX_CASE} = $1;
577             }
578             }
579 20         48 }
580 20         30 elsif (defined($sheet) && ($row =~ /^ignorerange\s+(.*)/i)) {
  20         30  
581 52         223 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 4         24 }
  4         27  
586 3         3 else {
  3         9  
587             die("ERROR: Invalid format data [$row] found in spec file.\n");
588 9         43 }
589             }
590              
591             $handle->close();
592              
593 6         18 return $data;
594 6         12 }
  6         12  
595 22         103  
596             my ($hash, $key) = @_;
597              
598             return unless (defined $hash && defined $key);
599 1         50 die "_get_hashval(): Not a hash." unless (ref($hash) eq 'HASH');
600              
601             return unless (exists $hash->{$key});
602             return $hash->{$key};
603 14         74 }
604              
605 14         229 my ($data) = @_;
606              
607             return 0 unless defined $data;
608              
609 87     87   143 foreach (keys %{$data->{exp}}) {
610             my $exp = $data->{exp}->{$_};
611 87 100 66     233 my $out = $data->{out}->{$_};
612 78 50       128  
613             return 0 if grep(/$exp->[0]/,@{$out});
614 78 100       138 }
615 25         49  
616             return 1;
617             }
618              
619 13     13   18 my ($message) = @_;
620              
621 13 50       17 return unless defined($message);
622              
623 13         14 print {*STDOUT} $message if ($ENV{DEBUG});
  13         26  
624 24         25 }
625 24         25  
626             my ($rule) = @_;
627 24 50       22  
  24         44  
628             return unless defined $rule;
629              
630 13         37 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 3520     3520   3677 $keys = scalar(keys(%{$rule}));
635             return if (($keys == 1) && exists $rule->{message});
636 3520 50       4216  
637             die("ERROR: Rule has more than 8 keys defined.\n")
638 3520 50       5202 if $keys > 8;
  0         0  
639              
640             $valid = {'message' => 1,
641             'sheet' => 2,
642 40     40   87 'spec' => 3,
643             'tolerance' => 4,
644 40 100       91 'sheet_tolerance' => 5,
645             'error_limit' => 6,
646 37 100       179 'swap_check' => 7,
647             'test' => 8,};
648              
649 35         63 foreach my $key (keys %{$rule}) {
650 35         41 die "ERROR: Invalid key '$key' found in the rule definitions.\n"
  35         88  
651 35 50 66     112 unless exists($valid->{$key});
652             }
653 35 100       106  
654             return if (exists $rule->{spec} && (keys %$rule == 1));
655              
656 34         220 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 34         50 && defined $rule->{tolerance});
  34         84  
666             }
667 78 100       213 else {
668             if ((exists $rule->{sheet_tolerance} && defined $rule->{sheet_tolerance})
669             ||
670 32 100 100     144 (exists $rule->{tolerance} && defined $rule->{tolerance})
671             ) {
672 26 100 66     181 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     161 }
679             }
680             }
681 20 100 66     222  
682             =head1 NOTES
683              
684 4 50 33     23 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