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