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