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