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, $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     }
  46
  47     if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) {
  48         *TO = *$to;
  49     } elsif (ref(\$to) eq 'GLOB') {
  50         *TO = $to;
  51     } else {
  52         open(TO,"<$to") or goto fail_open2;
  53         binmode TO;
  54         $closeto = 1;
  55     }
  56
  57     if (@_) {
  58         $size = shift(@_) + 0;
  59         croak("Bad buffer size for compare: $size\n") unless ($size > 0);
  60     } else {
  61         $size = -s FROM;
  62         $size = 1024 if ($size < 512);
  63         $size = $Too_Big if ($size > $Too_Big);
  64     }
  65
  66     $fbuf = '';
  67     $tbuf = '';
  68     while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
  69         unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
  70             goto fail_inner;
  71         }
  72     }
  73     goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
  74
  75     close(TO) || goto fail_open2 if $closeto;
  76     close(FROM) || goto fail_open1 if $closefrom;
  77
  78     return 0;
  79
  80   # All of these contortions try to preserve error messages...
  81   fail_inner:
  82     close(TO) || goto fail_open2 if $closeto;
  83     close(FROM) || goto fail_open1 if $closefrom;
  84
  85     return 1;
  86
  87   fail_open2:
  88     if ($closefrom) {
  89         $status = $!;
  90         $! = 0;
  91         close FROM;
  92         $! = $status unless $!;
  93     }
  94   fail_open1:
  95     return -1;
  96 }
  97
  98 *cmp = \&compare;
  99
 100 1;
 101
 102 __END__
 103
 104 =head1 NAME
 105
 106 File::Compare - Compare files or filehandles
 107
 108 =head1 SYNOPSIS
 109
 110         use File::Compare;
 111
 112         if (compare("file1","file2") == 0) {
 113             print "They're equal\n";
 114         }
 115
 116 =head1 DESCRIPTION
 117
 118 The File::Compare::compare function compares the contents of two
 119 sources, each of which can be a file or a file handle.  It is exported
 120 from File::Compare by default.
 121
 122 File::Compare::cmp is a synonym for File::Compare::compare.  It is
 123 exported from File::Compare only by request.
 124
 125 =head1 RETURN
 126
 127 File::Compare::compare return 0 if the files are equal, 1 if the
 128 files are unequal, or -1 if an error was encountered.
 129
 130 =head1 AUTHOR
 131
 132 File::Compare was written by Nick Ing-Simmons.
 133 Its original documentation was written by Chip Salzenberg.
 134
 135 =cut
 136