Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
testpods	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
contains_bad_pod.xr	31 B	-r--r--r--	2014-12-27 11:48
contains_pod.t	306 B	-r--r--r--	2014-12-27 11:48
contains_pod.xr	32 B	-r--r--r--	2014-12-27 11:48
empty.xr	0 B	-r--r--r--	2014-12-27 11:48
emptycmd.t	422 B	-r--r--r--	2014-12-27 11:48
emptycmd.xr	58 B	-r--r--r--	2014-12-27 11:48
find.t	2.82 KB	-r--r--r--	2014-12-27 11:48
for.t	945 B	-r--r--r--	2014-12-27 11:48
for.xr	390 B	-r--r--r--	2014-12-27 11:48
headings.t	4.23 KB	-r--r--r--	2014-12-27 11:48
headings.xr	1.03 KB	-r--r--r--	2014-12-27 11:48
include.t	884 B	-r--r--r--	2014-12-27 11:48
include.xr	743 B	-r--r--r--	2014-12-27 11:48
included.t	1.02 KB	-r--r--r--	2014-12-27 11:48
included.xr	126 B	-r--r--r--	2014-12-27 11:48
lref.t	1.21 KB	-r--r--r--	2014-12-27 11:48
lref.xr	941 B	-r--r--r--	2014-12-27 11:48
multiline_items.t	537 B	-r--r--r--	2014-12-27 11:48
multiline_items.xr	147 B	-r--r--r--	2014-12-27 11:48
nested_items.t	760 B	-r--r--r--	2014-12-27 11:48
nested_items.xr	310 B	-r--r--r--	2014-12-27 11:48
nested_seqs.t	480 B	-r--r--r--	2014-12-27 11:48
nested_seqs.xr	114 B	-r--r--r--	2014-12-27 11:48
oneline_cmds.t	1.41 KB	-r--r--r--	2014-12-27 11:48
oneline_cmds.xr	1.03 KB	-r--r--r--	2014-12-27 11:48
podselect.t	381 B	-r--r--r--	2014-12-27 11:48
podselect.xr	1.52 KB	-r--r--r--	2014-12-27 11:48
selfcheck.t	1.25 KB	-r--r--r--	2014-12-27 11:48
special_seqs.t	1.46 KB	-r--r--r--	2014-12-27 11:48
special_seqs.xr	1.08 KB	-r--r--r--	2014-12-27 11:48
testcmp.pl	2.76 KB	-r--r--r--	2014-12-27 11:48
testp2pt.pl	5.63 KB	-r--r--r--	2014-12-27 11:48
testpchk.pl	3.58 KB	-r--r--r--	2014-12-27 11:48
twice.t	643 B	-r--r--r--	2014-12-27 11:48

Rename

package TestCompare;

use vars qw(@ISA @EXPORT $MYPKG);
#use strict;
#use diagnostics;
use Carp;
use Exporter;
use File::Basename;
use File::Spec;
use FileHandle;

@ISA = qw(Exporter);
@EXPORT = qw(&testcmp);
$MYPKG = eval { (caller)[0] };

##--------------------------------------------------------------------------

=head1 NAME

testcmp -- compare two files line-by-line

=head1 SYNOPSIS

$is_diff = testcmp($file1, $file2);

$is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2);

=head2 DESCRIPTION

Compare two text files line-by-line and return 0 if they are the
same, 1 if they differ. Each of $file1 and $file2 may be a filenames,
or a filehandles (in which case it must already be open for reading).

If the first argument is a hashref, then the B<-cmplines> key in the
hash may have a subroutine reference as its corresponding value.
The referenced user-defined subroutine should be a line-comparator
function that takes two pre-chomped text-lines as its arguments
(the first is from $file1 and the second is from $file2). It should
return 0 if it considers the two lines equivalent, and non-zero
otherwise.

=cut

##--------------------------------------------------------------------------

sub testcmp( $ $ ; $) {
   my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : ();
   my ($file1, $file2) = @_;
   my ($fh1, $fh2) = ($file1, $file2);
   unless (ref $fh1) {
      $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!";
   }
   unless (ref $fh2) {
      $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!";
   }
  
   my $cmplines = $opts{'-cmplines'} || undef;
   my ($f1text, $f2text) = ("", "");
   my ($line, $diffs)    = (0, 0);
  
   while ( defined($f1text) and defined($f2text) ) {
      defined($f1text = <$fh1>)  and  chomp($f1text);
      defined($f2text = <$fh2>)  and  chomp($f2text);
      ++$line;
      last unless ( defined($f1text) and defined($f2text) );
      # kill any extra line endings
      $f1text =~ s/[\r\n]+$//s;
      $f2text =~ s/[\r\n]+$//s;
      $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)
                               : ($f1text ne $f2text);
      last if $diffs;
   }
   close($fh1) unless (ref $file1);
   close($fh2) unless (ref $file2);
  
   $diffs = 1  if (defined($f1text) or defined($f2text));
   if ( defined($f1text) and defined($f2text) ) {
      ## these two lines must be different
      warn "$file1 and $file2 differ at line $line\n";
   }
   elsif (defined($f1text)  and  (! defined($f1text))) {
      ## file1 must be shorter
      warn "$file1 is shorter than $file2\n";
   }
   elsif (defined $f2text) {
      ## file2 must be longer
      warn "$file1 is shorter than $file2\n";
   }
   return $diffs;
}