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