home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / File / Compare.pm < prev    next >
Text File  |  1997-11-25  |  3KB  |  144 lines
  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.  
  144.