home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / File / Compare.pm < prev    next >
Text File  |  2000-03-22  |  4KB  |  183 lines
  1. package File::Compare;
  2.  
  3. use 5.005_64;
  4. use strict;
  5. our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big);
  6.  
  7. require Exporter;
  8. use Carp;
  9.  
  10. $VERSION = '1.1002';
  11. @ISA = qw(Exporter);
  12. @EXPORT = qw(compare);
  13. @EXPORT_OK = qw(cmp compare_text);
  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,$to,$size) = @_;
  27.     my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0);
  28.  
  29.     my ($fromsize,$closefrom,$closeto);
  30.     local (*FROM, *TO);
  31.  
  32.     croak("from undefined") unless (defined $from);
  33.     croak("to undefined") unless (defined $to);
  34.  
  35.     if (ref($from) && 
  36.         (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) {
  37.     *FROM = *$from;
  38.     } elsif (ref(\$from) eq 'GLOB') {
  39.     *FROM = $from;
  40.     } else {
  41.     open(FROM,"<$from") or goto fail_open1;
  42.     unless ($text_mode) {
  43.         binmode FROM;
  44.         $fromsize = -s FROM;
  45.     }
  46.     $closefrom = 1;
  47.     }
  48.  
  49.     if (ref($to) &&
  50.         (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) {
  51.     *TO = *$to;
  52.     } elsif (ref(\$to) eq 'GLOB') {
  53.     *TO = $to;
  54.     } else {
  55.     open(TO,"<$to") or goto fail_open2;
  56.     binmode TO unless $text_mode;
  57.     $closeto = 1;
  58.     }
  59.  
  60.     if (!$text_mode && $closefrom && $closeto) {
  61.     # If both are opened files we know they differ if their size differ
  62.     goto fail_inner if $fromsize != -s TO;
  63.     }
  64.  
  65.     if ($text_mode) {
  66.     local $/ = "\n";
  67.     my ($fline,$tline);
  68.     while (defined($fline = <FROM>)) {
  69.         goto fail_inner unless defined($tline = <TO>);
  70.         if (ref $size) {
  71.         # $size contains ref to comparison function
  72.         goto fail_inner if &$size($fline, $tline);
  73.         } else {
  74.         goto fail_inner if $fline ne $tline;
  75.         }
  76.     }
  77.     goto fail_inner if defined($tline = <TO>);
  78.     }
  79.     else {
  80.     unless (defined($size) && $size > 0) {
  81.         $size = $fromsize || -s TO || 0;
  82.         $size = 1024 if $size < 512;
  83.         $size = $Too_Big if $size > $Too_Big;
  84.     }
  85.  
  86.     my ($fr,$tr,$fbuf,$tbuf);
  87.     $fbuf = $tbuf = '';
  88.     while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
  89.         unless (defined($tr = read(TO,$tbuf,$fr)) && $tbuf eq $fbuf) {
  90.         goto fail_inner;
  91.         }
  92.     }
  93.     goto fail_inner if defined($tr = read(TO,$tbuf,$size)) && $tr > 0;
  94.     }
  95.  
  96.     close(TO) || goto fail_open2 if $closeto;
  97.     close(FROM) || goto fail_open1 if $closefrom;
  98.  
  99.     return 0;
  100.     
  101.   # All of these contortions try to preserve error messages...
  102.   fail_inner:
  103.     close(TO) || goto fail_open2 if $closeto;
  104.     close(FROM) || goto fail_open1 if $closefrom;
  105.  
  106.     return 1;
  107.  
  108.   fail_open2:
  109.     if ($closefrom) {
  110.     my $status = $!;
  111.     $! = 0;
  112.     close FROM;
  113.     $! = $status unless $!;
  114.     }
  115.   fail_open1:
  116.     return -1;
  117. }
  118.  
  119. sub cmp;
  120. *cmp = \&compare;
  121.  
  122. sub compare_text {
  123.     my ($from,$to,$cmp) = @_;
  124.     croak("Usage: compare_text( file1, file2 [, cmp-function])")
  125.     unless @_ == 2 || @_ == 3;
  126.     croak("Third arg to compare_text() function must be a code reference")
  127.     if @_ == 3 && ref($cmp) ne 'CODE';
  128.  
  129.     # Using a negative buffer size puts compare into text_mode too
  130.     $cmp = -1 unless defined $cmp;
  131.     compare($from, $to, $cmp);
  132. }
  133.  
  134. 1;
  135.  
  136. __END__
  137.  
  138. =head1 NAME
  139.  
  140. File::Compare - Compare files or filehandles
  141.  
  142. =head1 SYNOPSIS
  143.  
  144.       use File::Compare;
  145.  
  146.     if (compare("file1","file2") == 0) {
  147.         print "They're equal\n";
  148.     }
  149.  
  150. =head1 DESCRIPTION
  151.  
  152. The File::Compare::compare function compares the contents of two
  153. sources, each of which can be a file or a file handle.  It is exported
  154. from File::Compare by default.
  155.  
  156. File::Compare::cmp is a synonym for File::Compare::compare.  It is
  157. exported from File::Compare only by request.
  158.  
  159. File::Compare::compare_text does a line by line comparison of the two
  160. files. It stops as soon as a difference is detected. compare_text()
  161. accepts an optional third argument: This must be a CODE reference to
  162. a line comparison function, which returns 0 when both lines are considered
  163. equal. For example:
  164.  
  165.     compare_text($file1, $file2)
  166.  
  167. is basically equivalent to
  168.  
  169.     compare_text($file1, $file2, sub {$_[0] ne $_[1]} )
  170.  
  171. =head1 RETURN
  172.  
  173. File::Compare::compare return 0 if the files are equal, 1 if the
  174. files are unequal, or -1 if an error was encountered.
  175.  
  176. =head1 AUTHOR
  177.  
  178. File::Compare was written by Nick Ing-Simmons.
  179. Its original documentation was written by Chip Salzenberg.
  180.  
  181. =cut
  182.  
  183.