home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / pod / testcmp.pl < prev    next >
Perl Script  |  1999-10-17  |  3KB  |  92 lines
  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;
  92.