lib/File/Compare.pm

   1 package File::Compare;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
   5
   6 require Exporter;
   7 use Carp;
   8 use UNIVERSAL qw(isa);
   9
  10 $VERSION = '1.1';
  11 @ISA = qw(Exporter);
  12 @EXPORT = qw(compare);
  13 @EXPORT_OK = qw(cmp);
  14
  15 $Too_Big = 1024 * 1024 * 2;
  16
  17 sub VERSION {
  18     # Version of File::Compare
  19     return $File::Compare::VERSION;
  20 }
  21
  22 sub compare {
  23     croak("Usage: compare( file1, file2 [, buffersize]) ")
  24       unless(@_ == 2 || @_ == 3);
  25
  26     my $from = shift;
  27     my $to = shift;
  28     my $closefrom=0;
  29     my $closeto=0;
  30     my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
  31     local(*FROM, *TO);
  32     local($\) = '';
  33
  34     croak("from undefined") unless (defined $from);
  35     croak("to undefined") unless (defined $to);
  36
  37     if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) {
  38         *FROM = *$from;
  39     } elsif (ref(\$from) eq 'GLOB') {
  40         *FROM = $from;
  41     } else {
  42         open(FROM,"<$from") or goto fail_open1;
  43         binmode FROM;
  44         $closefrom = 1;
  45         $fromsize = -s FROM;
  46     }
  47
  48     if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) {
  49         *TO = *$to;
  50     } elsif (ref(\$to) eq 'GLOB') {
  51         *TO = $to;
  52     } else {
  53         open(TO,"<$to") or goto fail_open2;
  54         binmode TO;
  55         $closeto = 1;
  56     }
  57
  58     if ($closefrom && $closeto) {
  59         # If both are opened files we know they differ if their size differ
  60         goto fail_inner if $fromsize != -s TO;
  61     }
  62
  63     if (@_) {
  64         $size = shift(@_) + 0;
  65         croak("Bad buffer size for compare: $size\n") unless ($size > 0);
  66     } else {
  67         $size = $fromsize;
  68         $size = 1024 if ($size < 512);
  69         $size = $Too_Big if ($size > $Too_Big);
  70     }
  71
  72     $fbuf = '';
  73     $tbuf = '';
  74     while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
  75         unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
  76             goto fail_inner;
  77         }
  78     }
  79     goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
  80
  81     close(TO) || goto fail_open2 if $closeto;
  82     close(FROM) || goto fail_open1 if $closefrom;
  83
  84     return 0;
  85
  86   # All of these contortions try to preserve error messages...
  87   fail_inner:
  88     close(TO) || goto fail_open2 if $closeto;
  89     close(FROM) || goto fail_open1 if $closefrom;
  90
  91     return 1;
  92
  93   fail_open2:
  94     if ($closefrom) {
  95         $status = $!;
  96         $! = 0;
  97         close FROM;
  98         $! = $status unless $!;
  99     }
 100   fail_open1:
 101     return -1;
 102 }
 103
 104 *cmp = \&compare;
 105
 106 1;
 107
 108 __END__
 109
 110 =head1 NAME
 111
 112 File::Compare - Compare files or filehandles
 113
 114 =head1 SYNOPSIS
 115
 116         use File::Compare;
 117
 118         if (compare("file1","file2") == 0) {
 119             print "They're equal\n";
 120         }
 121
 122 =head1 DESCRIPTION
 123
 124 The File::Compare::compare function compares the contents of two
 125 sources, each of which can be a file or a file handle.  It is exported
 126 from File::Compare by default.
 127
 128 File::Compare::cmp is a synonym for File::Compare::compare.  It is
 129 exported from File::Compare only by request.
 130
 131 =head1 RETURN
 132
 133 File::Compare::compare return 0 if the files are equal, 1 if the
 134 files are unequal, or -1 if an error was encountered.
 135
 136 =head1 AUTHOR
 137
 138 File::Compare was written by Nick Ing-Simmons.
 139 Its original documentation was written by Chip Salzenberg.
 140
 141 =cut
 142