Commit | Line | Data |
---|---|---|
360aca43 GS |
1 | package TestCompare; |
2 | ||
3 | use vars qw(@ISA @EXPORT $MYPKG); | |
4 | #use strict; | |
5 | #use diagnostics; | |
6 | use Carp; | |
7 | use Exporter; | |
8 | use File::Basename; | |
9 | use File::Spec; | |
475d79b5 | 10 | use FileHandle; |
360aca43 GS |
11 | |
12 | @ISA = qw(Exporter); | |
13 | @EXPORT = qw(&testcmp); | |
14 | $MYPKG = eval { (caller)[0] }; | |
15 | ||
16 | ##-------------------------------------------------------------------------- | |
17 | ||
18 | =head1 NAME | |
19 | ||
20 | testcmp -- compare two files line-by-line | |
21 | ||
22 | =head1 SYNOPSIS | |
23 | ||
24 | $is_diff = testcmp($file1, $file2); | |
25 | ||
26 | or | |
27 | ||
28 | $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2); | |
29 | ||
30 | =head2 DESCRIPTION | |
31 | ||
32 | Compare two text files line-by-line and return 0 if they are the | |
33 | same, 1 if they differ. Each of $file1 and $file2 may be a filenames, | |
34 | or a filehandles (in which case it must already be open for reading). | |
35 | ||
36 | If the first argument is a hashref, then the B<-cmplines> key in the | |
37 | hash may have a subroutine reference as its corresponding value. | |
38 | The referenced user-defined subroutine should be a line-comparator | |
39 | function that takes two pre-chomped text-lines as its arguments | |
40 | (the first is from $file1 and the second is from $file2). It should | |
41 | return 0 if it considers the two lines equivalent, and non-zero | |
42 | otherwise. | |
43 | ||
44 | =cut | |
45 | ||
46 | ##-------------------------------------------------------------------------- | |
47 | ||
48 | sub testcmp( $ $ ; $) { | |
49 | my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : (); | |
50 | my ($file1, $file2) = @_; | |
51 | my ($fh1, $fh2) = ($file1, $file2); | |
52 | unless (ref $fh1) { | |
53 | $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!"; | |
54 | } | |
55 | unless (ref $fh2) { | |
56 | $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!"; | |
57 | } | |
58 | ||
59 | my $cmplines = $opts{'-cmplines'} || undef; | |
60 | my ($f1text, $f2text) = ("", ""); | |
61 | my ($line, $diffs) = (0, 0); | |
62 | ||
63 | while ( defined($f1text) and defined($f2text) ) { | |
64 | defined($f1text = <$fh1>) and chomp($f1text); | |
65 | defined($f2text = <$fh2>) and chomp($f2text); | |
66 | ++$line; | |
67 | last unless ( defined($f1text) and defined($f2text) ); | |
68 | $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text) | |
69 | : ($f1text ne $f2text); | |
70 | last if $diffs; | |
71 | } | |
72 | close($fh1) unless (ref $file1); | |
73 | close($fh2) unless (ref $file2); | |
74 | ||
75 | $diffs = 1 if (defined($f1text) or defined($f2text)); | |
76 | if ( defined($f1text) and defined($f2text) ) { | |
77 | ## these two lines must be different | |
78 | warn "$file1 and $file2 differ at line $line\n"; | |
79 | } | |
80 | elsif (defined($f1text) and (! defined($f1text))) { | |
81 | ## file1 must be shorter | |
82 | warn "$file1 is shorter than $file2\n"; | |
83 | } | |
84 | elsif (defined $f2text) { | |
85 | ## file2 must be longer | |
86 | warn "$file1 is shorter than $file2\n"; | |
87 | } | |
88 | return $diffs; | |
89 | } | |
90 | ||
91 | 1; |