perl/t/pod/testcmp.pl
<<
>>
Prefs
   1package TestCompare;
   2
   3use vars qw(@ISA @EXPORT $MYPKG);
   4#use strict;
   5#use diagnostics;
   6use Carp;
   7use Exporter;
   8use File::Basename;
   9use File::Spec;
  10use FileHandle;
  11
  12@ISA = qw(Exporter);
  13@EXPORT = qw(&testcmp);
  14$MYPKG = eval { (caller)[0] };
  15
  16##--------------------------------------------------------------------------
  17
  18=head1 NAME
  19
  20testcmp -- compare two files line-by-line
  21
  22=head1 SYNOPSIS
  23
  24    $is_diff = testcmp($file1, $file2);
  25
  26or
  27
  28    $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2);
  29
  30=head2 DESCRIPTION
  31
  32Compare two text files line-by-line and return 0 if they are the
  33same, 1 if they differ. Each of $file1 and $file2 may be a filenames,
  34or a filehandles (in which case it must already be open for reading).
  35
  36If the first argument is a hashref, then the B<-cmplines> key in the
  37hash may have a subroutine reference as its corresponding value.
  38The referenced user-defined subroutine should be a line-comparator
  39function that takes two pre-chomped text-lines as its arguments
  40(the first is from $file1 and the second is from $file2). It should
  41return 0 if it considers the two lines equivalent, and non-zero
  42otherwise.
  43
  44=cut
  45
  46##--------------------------------------------------------------------------
  47
  48sub 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      # kill any extra line endings
  69      $f1text =~ s/[\r\n]+$//s;
  70      $f2text =~ s/[\r\n]+$//s;
  71      $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)
  72                               : ($f1text ne $f2text);
  73      last if $diffs;
  74   }
  75   close($fh1) unless (ref $file1);
  76   close($fh2) unless (ref $file2);
  77  
  78   $diffs = 1  if (defined($f1text) or defined($f2text));
  79   if ( defined($f1text) and defined($f2text) ) {
  80      ## these two lines must be different
  81      warn "$file1 and $file2 differ at line $line\n";
  82   }
  83   elsif (defined($f1text)  and  (! defined($f1text))) {
  84      ## file1 must be shorter
  85      warn "$file1 is shorter than $file2\n";
  86   }
  87   elsif (defined $f2text) {
  88      ## file2 must be longer
  89      warn "$file1 is shorter than $file2\n";
  90   }
  91   return $diffs;
  92}
  93
  941;
  95
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.