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