summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJan Dubois <jand@activestate.com>1999-02-26 01:20:41 +0100
committerGurusamy Sarathy <gsar@cpan.org>1999-02-28 19:23:41 +0000
commit3724d6f49c146fc4418f91f2550cb38405d01c90 (patch)
tree9e23b9d02d697024ec50eaccf5e405cec63c375f
parentf2a260d65825b8794898c1b0c7b02230f7d5398e (diff)
downloadperl-3724d6f49c146fc4418f91f2550cb38405d01c90.tar.gz
add File::Compare::compare_text()
Message-ID: <36dcd8ab.20195659@smtp1.ibm.net> Subject: Re: PodParser 1.07 (was: RE: C<stuff()> vs stuff()) p4raw-id: //depot/perl@3033
-rw-r--r--lib/File/Compare.pm69
-rw-r--r--pod/perltodo.pod4
2 files changed, 45 insertions, 28 deletions
diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm
index 2f9c45c4c6..0ee84bdba5 100644
--- a/lib/File/Compare.pm
+++ b/lib/File/Compare.pm
@@ -6,10 +6,10 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
require Exporter;
use Carp;
-$VERSION = '1.1001';
+$VERSION = '1.1002';
@ISA = qw(Exporter);
@EXPORT = qw(compare);
-@EXPORT_OK = qw(cmp);
+@EXPORT_OK = qw(cmp compare_text);
$Too_Big = 1024 * 1024 * 2;
@@ -22,13 +22,11 @@ sub compare {
croak("Usage: compare( file1, file2 [, buffersize]) ")
unless(@_ == 2 || @_ == 3);
- my $from = shift;
- my $to = shift;
- my $closefrom=0;
- my $closeto=0;
- my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
- local(*FROM, *TO);
- local($\) = '';
+ my ($from,$to,$size) = @_;
+ my $text_mode = defined($size) && $size < 0;
+
+ my ($fromsize,$closefrom,$closeto);
+ local (*FROM, *TO);
croak("from undefined") unless (defined $from);
croak("to undefined") unless (defined $to);
@@ -40,9 +38,11 @@ sub compare {
*FROM = $from;
} else {
open(FROM,"<$from") or goto fail_open1;
- binmode FROM;
+ unless ($text_mode) {
+ binmode FROM;
+ $fromsize = -s FROM;
+ }
$closefrom = 1;
- $fromsize = -s FROM;
}
if (ref($to) &&
@@ -52,32 +52,41 @@ sub compare {
*TO = $to;
} else {
open(TO,"<$to") or goto fail_open2;
- binmode TO;
+ binmode TO unless $text_mode;
$closeto = 1;
}
- if ($closefrom && $closeto) {
+ 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 (@_) {
- $size = shift(@_) + 0;
- croak("Bad buffer size for compare: $size\n") unless ($size > 0);
- } else {
- $size = $fromsize;
- $size = 1024 if ($size < 512);
- $size = $Too_Big if ($size > $Too_Big);
+ if ($text_mode) {
+ local $/ = "\n";
+ my ($fline,$tline);
+ while (defined($fline = <FROM>)) {
+ unless (defined($tline = <TO>) && $fline eq $tline) {
+ goto fail_inner;
+ }
+ }
+ goto fail_inner if defined($tline = <TO>);
}
+ else {
+ unless (defined($size) && $size > 0) {
+ $size = $fromsize;
+ $size = 1024 if $size < 512;
+ $size = $Too_Big if $size > $Too_Big;
+ }
- $fbuf = '';
- $tbuf = '';
- while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
- unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
- goto fail_inner;
+ 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;
}
- 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;
@@ -93,7 +102,7 @@ sub compare {
fail_open2:
if ($closefrom) {
- $status = $!;
+ my $status = $!;
$! = 0;
close FROM;
$! = $status unless $!;
@@ -104,6 +113,9 @@ sub compare {
*cmp = \&compare;
+# Using a negative buffer size puts compare into text_mode
+sub compare_text { compare(@_[0..1], -1) }
+
1;
__END__
@@ -129,6 +141,9 @@ 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.
+
=head1 RETURN
File::Compare::compare return 0 if the files are equal, 1 if the
diff --git a/pod/perltodo.pod b/pod/perltodo.pod
index f7ab458c9d..11956a9c5a 100644
--- a/pod/perltodo.pod
+++ b/pod/perltodo.pod
@@ -379,7 +379,9 @@ Make C<perldoc> tell users what they need to add to their .login or
=head2 Install ALL Documentation
Make the standard documentation kit include the VMS, OS/2, Win32,
-Threads, etc information.
+Threads, etc information. installperl and pod/Makefile should know
+enough to copy README.foo to perlfoo.pod before building everything,
+when appropriate.
=head2 Outstanding issues to be documented