| 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;
|
|---|
| 10 | use FileHandle;
|
|---|
| 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;
|
|---|