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