This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Exporter errors give wrong location
[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
387d8d95 10$VERSION = '1.1001';
5f05dabc
PP
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;
387d8d95 30 my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
5f05dabc
PP
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;
387d8d95 45 $fromsize = -s FROM;
5f05dabc
PP
46 }
47
48 if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) {
49 *TO = *$to;
50 } elsif (ref(\$to) eq 'GLOB') {
51 *TO = $to;
52 } else {
53 open(TO,"<$to") or goto fail_open2;
54 binmode TO;
55 $closeto = 1;
56 }
57
387d8d95
CS
58 if ($closefrom && $closeto) {
59 # If both are opened files we know they differ if their size differ
60 goto fail_inner if $fromsize != -s TO;
61 }
62
5f05dabc
PP
63 if (@_) {
64 $size = shift(@_) + 0;
65 croak("Bad buffer size for compare: $size\n") unless ($size > 0);
66 } else {
387d8d95 67 $size = $fromsize;
5f05dabc
PP
68 $size = 1024 if ($size < 512);
69 $size = $Too_Big if ($size > $Too_Big);
70 }
71
72 $fbuf = '';
73 $tbuf = '';
74 while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
75 unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
76 goto fail_inner;
77 }
78 }
79 goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
80
81 close(TO) || goto fail_open2 if $closeto;
82 close(FROM) || goto fail_open1 if $closefrom;
83
84 return 0;
85
86 # All of these contortions try to preserve error messages...
87 fail_inner:
88 close(TO) || goto fail_open2 if $closeto;
89 close(FROM) || goto fail_open1 if $closefrom;
90
91 return 1;
92
93 fail_open2:
94 if ($closefrom) {
95 $status = $!;
96 $! = 0;
97 close FROM;
98 $! = $status unless $!;
99 }
100 fail_open1:
101 return -1;
102}
103
104*cmp = \&compare;
105
1061;
107
108__END__
109
110=head1 NAME
111
112File::Compare - Compare files or filehandles
113
114=head1 SYNOPSIS
115
116 use File::Compare;
117
118 if (compare("file1","file2") == 0) {
119 print "They're equal\n";
120 }
121
122=head1 DESCRIPTION
123
124The File::Compare::compare function compares the contents of two
125sources, each of which can be a file or a file handle. It is exported
126from File::Compare by default.
127
128File::Compare::cmp is a synonym for File::Compare::compare. It is
129exported from File::Compare only by request.
130
131=head1 RETURN
132
133File::Compare::compare return 0 if the files are equal, 1 if the
134files are unequal, or -1 if an error was encountered.
135
136=head1 AUTHOR
137
138File::Compare was written by Nick Ing-Simmons.
139Its original documentation was written by Chip Salzenberg.
140
141=cut
142