1package File::Compare 1.1007; 2 3use v5.12; 4use warnings; 5 6use Exporter 'import'; 7 8our @EXPORT = qw(compare); 9our @EXPORT_OK = qw(cmp compare_text); 10 11our $Too_Big = 1024 * 1024 * 2; 12 13sub croak { 14 require Carp; 15 goto &Carp::croak; 16} 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 compare($from, $to, $cmp // -1); 127} 128 1291; 130 131__END__ 132 133=head1 NAME 134 135File::Compare - Compare files or filehandles 136 137=head1 SYNOPSIS 138 139 use File::Compare; 140 141 if (compare("file1","file2") == 0) { 142 print "They're equal\n"; 143 } 144 145=head1 DESCRIPTION 146 147The File::Compare::compare function compares the contents of two 148sources, each of which can be a file or a file handle. It is exported 149from File::Compare by default. 150 151File::Compare::cmp is a synonym for File::Compare::compare. It is 152exported from File::Compare only by request. 153 154File::Compare::compare_text does a line by line comparison of the two 155files. It stops as soon as a difference is detected. compare_text() 156accepts an optional third argument: This must be a CODE reference to 157a line comparison function, which returns 0 when both lines are considered 158equal. For example: 159 160 compare_text($file1, $file2) 161 162is basically equivalent to 163 164 compare_text($file1, $file2, sub {$_[0] ne $_[1]} ) 165 166=head1 RETURN 167 168File::Compare::compare and its sibling functions return 0 if the files 169are equal, 1 if the files are unequal, or -1 if an error was encountered. 170 171=head1 AUTHOR 172 173File::Compare was written by Nick Ing-Simmons. 174Its original documentation was written by Chip Salzenberg. 175