File Coverage

blib/lib/Compare/Directory.pm
Criterion Covered Total %
statement 25 27 92.5
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 36 94.4


line stmt bran cond sub pod time code
1             package Compare::Directory;
2              
3             $Compare::Directory::VERSION = '1.23';
4             $Compare::Directory::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Compare::Directory - Interface to compare directories.
9              
10             =head1 VERSION
11              
12             Version 1.23
13              
14             =cut
15              
16 1     1   15577 use strict; use warnings;
  1     1   2  
  1         25  
  1         3  
  1         1  
  1         25  
17 1     1   555 use Data::Dumper;
  1         8607  
  1         63  
18              
19 1     1   899 use CAM::PDF;
  1         28738  
  1         74  
20 1     1   838 use Test::Excel;
  1         63588  
  1         80  
21 1     1   775 use Test::Deep ();
  1         7246  
  1         31  
22 1     1   610 use File::Compare;
  1         816  
  1         76  
23 1     1   7 use File::Basename;
  1         2  
  1         85  
24 1     1   520 use XML::SemanticDiff;
  0            
  0            
25             use Scalar::Util 'blessed';
26             use File::Spec::Functions;
27             use File::Glob qw(bsd_glob);
28              
29             =head1 DESCRIPTION
30              
31             The only objective of the module is compare two directory contents. Currently it
32             compare the following file types:
33              
34             +----------------------+------------+
35             | File Type | Extension |
36             +----------------------+------------+
37             | TEXT File | .txt |
38             | COMMA Seperated File | .csv |
39             | PDF File | .pdf |
40             | XML File | .xml |
41             | EXCEL File | .xls |
42             +----------------------+------------+
43              
44             =head1 CONSTRUCTOR
45              
46             The constructor expects the two directories name with complete path.
47              
48             use strict; use warnings;
49             use Compare::Directory;
50              
51             my $directory = Compare::Directory->new("./got-1", "./exp-1");
52              
53             =cut
54              
55             sub new {
56             my ($class, $dir1, $dir2) = @_;
57              
58             die ("ERROR: Please provide two directories to compare.\n") unless (defined($dir1) && defined($dir2));
59             die ("ERROR: Invalid directory [$dir1].\n") unless (-d $dir1);
60             die ("ERROR: Invalid directory [$dir2].\n") unless (-d $dir2);
61              
62             # Borrowed from DirCompare [http://search.cpan.org/~gavinc/File-DirCompare-0.6/DirCompare.pm]
63             my $self = {};
64             $self->{name1} = $dir1;
65             $self->{name2} = $dir2;
66             $self->{dir1}->{basename $_} = 1 foreach bsd_glob(catfile($dir1, ".*"));
67             $self->{dir1}->{basename $_} = 1 foreach bsd_glob(catfile($dir1, "*"));
68             $self->{dir2}->{basename $_} = 1 foreach bsd_glob(catfile($dir2, ".*"));
69             $self->{dir2}->{basename $_} = 1 foreach bsd_glob(catfile($dir2, "*"));
70              
71             delete $self->{dir1}->{curdir()} if $self->{dir1}->{curdir()};
72             delete $self->{dir1}->{updir()} if $self->{dir1}->{updir()};
73             delete $self->{dir2}->{curdir()} if $self->{dir2}->{curdir()};
74             delete $self->{dir2}->{updir()} if $self->{dir2}->{updir()};
75              
76             $self->{_status} = 1;
77             map { $self->{entry}->{$_}++ == 0 ? $_ : () } sort(keys(%{$self->{dir1}}), keys(%{$self->{dir2}}));
78             $self->{report} = sub {
79             my ($a, $b) = @_;
80             if (!$b) {
81             printf("Only in [%s]: [%s].\n", dirname($a), basename($a));
82             $self->{_status} = 0;
83             }
84             elsif (!$a) {
85             printf("Only in [%s]: [%s].\n", dirname($b), basename($b));
86             $self->{_status} = 0;
87             }
88             else {
89             printf("Files [%s] and [%s] differ.\n", $a, $b);
90             $self->{_status} = 0;
91             }
92             };
93              
94             bless $self, $class;
95              
96             return $self;
97             }
98              
99             =head1 METHODS
100              
101             =head2 cmp_directory()
102              
103             This is the public method that initiates the actual directory comparison. You
104             simply call this method against the object. Returns 1 if directory comparison
105             succeed otherwise returns 0.
106              
107             use strict; use warnings;
108             use Compare::Directory;
109              
110             my $directory = Compare::Directory->new("./got-1", "./exp-1");
111             $directory->cmp_directory();
112              
113             =cut
114              
115             sub cmp_directory {
116             my ($self) = @_;
117              
118             foreach my $entry (keys %{$self->{entry}}) {
119             my $f1 = catfile($self->{name1}, $entry);
120             my $f2 = catfile($self->{name2}, $entry);
121             next if (-d $f1 && -d $f2);
122              
123             if (!$self->{dir1}->{$entry}) {
124             $self->{report}->($f1, undef);
125             }
126             elsif (!$self->{dir2}->{$entry}) {
127             $self->{report}->(undef, $f2);
128             }
129             else {
130             $self->{report}->($f1, $f2) unless _cmp_directory($f1, $f2);
131             # Very strict about the order of elements in XML.
132             # $self->{report}->($f1, $f2) if File::Compare::compare($f1, $f2);
133             }
134             }
135              
136             return $self->{_status};
137             }
138              
139             sub _cmp_directory($$) {
140             my ($file1, $file2) = @_;
141              
142             croak("ERROR: Invalid file [$file1].\n") unless(defined($file1) && (-f $file1));
143             croak("ERROR: Invalid file [$file2].\n") unless(defined($file2) && (-f $file2));
144              
145             my $do_FILEs_match = 0;
146             if ($file1 =~ /\.txt|\.csv/i) {
147             $do_FILEs_match = 1 unless compare($file1, $file2);
148             }
149             elsif ($file1 =~ /\.xml/i) {
150             my $diff = XML::SemanticDiff->new();
151             $do_FILEs_match = 1 unless $diff->compare($file1, $file2);
152             }
153             elsif ($file1 =~ /\.pdf/i) {
154             $do_FILEs_match = 1 if _cmp_pdf($file1, $file2);
155             }
156             elsif ($file1 =~ /\.xls/i) {
157             $do_FILEs_match = 1 if compare_excel($file1, $file2);
158             }
159              
160             return $do_FILEs_match;
161             }
162              
163             sub _cmp_pdf($$) {
164             my ($got, $exp) = @_;
165              
166             unless (blessed($got) && $got->isa('CAM::PDF')) {
167             $got = CAM::PDF->new($got)
168             || croak("ERROR: Couldn't create CAM::PDF instance with: [$got]\n");
169             }
170              
171             unless (blessed($exp) && $exp->isa('CAM::PDF')) {
172             $exp = CAM::PDF->new($exp)
173             || croak("ERROR: Couldn't create CAM::PDF instance with: [$exp]\n");
174             }
175              
176             return 0 unless ($got->numPages() == $exp->numPages());
177              
178             my $do_PDFs_match = 0;
179             foreach my $page_num (1 .. $got->numPages()) {
180             my $tree1 = $got->getPageContentTree($page_num, "verbose");
181             my $tree2 = $exp->getPageContentTree($page_num, "verbose");
182             if (Test::Deep::eq_deeply($tree1->{blocks}, $tree2->{blocks})) {
183             $do_PDFs_match = 1;
184             }
185             else {
186             $do_PDFs_match = 0;
187             last;
188             }
189             }
190              
191             return $do_PDFs_match;
192             }
193              
194             =head1 AUTHOR
195              
196             Mohammad S Anwar, Emohammad.anwar@yahoo.comE
197              
198             =head1 REPOSITORY
199              
200             L
201              
202             =head1 BUGS
203              
204             Please report any bugs or feature requests to C,
205             or through the web interface at L.
206             I will be notified, and then you'll automatically be notified of progress on your
207             bug as I make changes.
208              
209             =head1 SEE ALSO
210              
211             =over 4
212              
213             =item * L
214              
215             =item * L
216              
217             =back
218              
219             =head1 SUPPORT
220              
221             You can find documentation for this module with the perldoc command.
222              
223             perldoc Compare::Directory
224              
225             You can also look for information at:
226              
227             =over 4
228              
229             =item * RT: CPAN's request tracker
230              
231             L
232              
233             =item * AnnoCPAN: Annotated CPAN documentation
234              
235             L
236              
237             =item * CPAN Ratings
238              
239             L
240              
241             =item * Search CPAN
242              
243             L
244              
245             =back
246              
247             =head1 LICENSE AND COPYRIGHT
248              
249             Copyright (C) 2010 - 2016 Mohammad S Anwar.
250              
251             This program is free software; you can redistribute it and/or modify it under
252             the terms of the the Artistic License (2.0). You may obtain a copy of the full
253             license at:
254              
255             L
256              
257             Any use, modification, and distribution of the Standard or Modified Versions is
258             governed by this Artistic License.By using, modifying or distributing the Package,
259             you accept this license. Do not use, modify, or distribute the Package, if you do
260             not accept this license.
261              
262             If your Modified Version has been derived from a Modified Version made by someone
263             other than you,you are nevertheless required to ensure that your Modified Version
264             complies with the requirements of this license.
265              
266             This license does not grant you the right to use any trademark, service mark,
267             tradename, or logo of the Copyright Holder.
268              
269             This license includes the non-exclusive, worldwide, free-of-charge patent license
270             to make, have made, use, offer to sell, sell, import and otherwise transfer the
271             Package with respect to any patent claims licensable by the Copyright Holder that
272             are necessarily infringed by the Package. If you institute patent litigation
273             (including a cross-claim or counterclaim) against any party alleging that the
274             Package constitutes direct or contributory patent infringement,then this Artistic
275             License to you shall terminate on the date that such litigation is filed.
276              
277             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
278             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
279             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
280             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
281             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
282             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
283             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
284              
285             =cut
286              
287             1; # End of Compare::Directory