1package File::Compare; 2 3use 5.005_64; 4use strict; 5our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big); 6 7require Exporter; 8use 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 17sub VERSION { 18 # Version of File::Compare 19 return $File::Compare::VERSION; 20} 21 22sub 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 119sub cmp; 120*cmp = \&compare; 121 122sub 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 1341; 135 136__END__ 137 138=head1 NAME 139 140File::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 152The File::Compare::compare function compares the contents of two 153sources, each of which can be a file or a file handle. It is exported 154from File::Compare by default. 155 156File::Compare::cmp is a synonym for File::Compare::compare. It is 157exported from File::Compare only by request. 158 159File::Compare::compare_text does a line by line comparison of the two 160files. It stops as soon as a difference is detected. compare_text() 161accepts an optional third argument: This must be a CODE reference to 162a line comparison function, which returns 0 when both lines are considered 163equal. For example: 164 165 compare_text($file1, $file2) 166 167is basically equivalent to 168 169 compare_text($file1, $file2, sub {$_[0] ne $_[1]} ) 170 171=head1 RETURN 172 173File::Compare::compare return 0 if the files are equal, 1 if the 174files are unequal, or -1 if an error was encountered. 175 176=head1 AUTHOR 177 178File::Compare was written by Nick Ing-Simmons. 179Its original documentation was written by Chip Salzenberg. 180 181=cut 182 183