This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
updates from PodParser v1.12 on CPAN (from Brad Appleton)
[perl5.git] / t / pod / testcmp.pl
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;