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