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