This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
DB_File 1.11 patch
[perl5.git] / lib / File / Compare.pm
CommitLineData
5f05dabc
PP
1package File::Compare;
2
3use strict;
4use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
5
6require Exporter;
7use Carp;
8use UNIVERSAL qw(isa);
9
10$VERSION = '1.1';
11@ISA = qw(Exporter);
12@EXPORT = qw(compare);
13@EXPORT_OK = qw(cmp);
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 = shift;
27 my $to = shift;
28 my $closefrom=0;
29 my $closeto=0;
30 my ($size, $status, $fr, $tr, $fbuf, $tbuf);
31 local(*FROM, *TO);
32 local($\) = '';
33
34 croak("from undefined") unless (defined $from);
35 croak("to undefined") unless (defined $to);
36
37 if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) {
38 *FROM = *$from;
39 } elsif (ref(\$from) eq 'GLOB') {
40 *FROM = $from;
41 } else {
42 open(FROM,"<$from") or goto fail_open1;
43 binmode FROM;
44 $closefrom = 1;
45 }
46
47 if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) {
48 *TO = *$to;
49 } elsif (ref(\$to) eq 'GLOB') {
50 *TO = $to;
51 } else {
52 open(TO,"<$to") or goto fail_open2;
53 binmode TO;
54 $closeto = 1;
55 }
56
57 if (@_) {
58 $size = shift(@_) + 0;
59 croak("Bad buffer size for compare: $size\n") unless ($size > 0);
60 } else {
61 $size = -s FROM;
62 $size = 1024 if ($size < 512);
63 $size = $Too_Big if ($size > $Too_Big);
64 }
65
66 $fbuf = '';
67 $tbuf = '';
68 while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
69 unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
70 goto fail_inner;
71 }
72 }
73 goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
74
75 close(TO) || goto fail_open2 if $closeto;
76 close(FROM) || goto fail_open1 if $closefrom;
77
78 return 0;
79
80 # All of these contortions try to preserve error messages...
81 fail_inner:
82 close(TO) || goto fail_open2 if $closeto;
83 close(FROM) || goto fail_open1 if $closefrom;
84
85 return 1;
86
87 fail_open2:
88 if ($closefrom) {
89 $status = $!;
90 $! = 0;
91 close FROM;
92 $! = $status unless $!;
93 }
94 fail_open1:
95 return -1;
96}
97
98*cmp = \&compare;
99
1001;
101
102__END__
103
104=head1 NAME
105
106File::Compare - Compare files or filehandles
107
108=head1 SYNOPSIS
109
110 use File::Compare;
111
112 if (compare("file1","file2") == 0) {
113 print "They're equal\n";
114 }
115
116=head1 DESCRIPTION
117
118The File::Compare::compare function compares the contents of two
119sources, each of which can be a file or a file handle. It is exported
120from File::Compare by default.
121
122File::Compare::cmp is a synonym for File::Compare::compare. It is
123exported from File::Compare only by request.
124
125=head1 RETURN
126
127File::Compare::compare return 0 if the files are equal, 1 if the
128files are unequal, or -1 if an error was encountered.
129
130=head1 AUTHOR
131
132File::Compare was written by Nick Ing-Simmons.
133Its original documentation was written by Chip Salzenberg.
134
135=cut
136