fix IO::File to support binmode

From: "Jos I. Boumans" <kane@dwim.org>
Message-Id: <559E356E-3268-11D9-A2E6-000A95EF62E2@dwim.org>

p4raw-id: //depot/perl@23489

diff --git a/MANIFEST b/MANIFEST
index c68a5c7..05a30ad 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -587,6 +587,7 @@ ext/IO/README                       IO extension maintenance notice
 ext/IO/t/io_const.t    See if constants from IO work
 ext/IO/t/io_dir.t      See if directory-related methods from IO work
 ext/IO/t/io_dup.t      See if dup()-related methods from IO work
+ext/IO/t/io_file.t     See if binmode()-related methods on IO::File work
 ext/IO/t/io_linenum.t  See if I/O line numbers are tracked correctly
 ext/IO/t/io_multihomed.t       See if INET sockets work with multi-homed hosts
 ext/IO/t/io_pipe.t     See if pipe()-related methods from IO work

diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm
index 0006eb3..f354f76 100644 (file)
--- a/ext/IO/lib/IO/File.pm
+++ b/ext/IO/lib/IO/File.pm
@@ -93,6 +93,14 @@ it passes all the three arguments to the three-argument C<open> operator.
 For convenience, C<IO::File> exports the O_XXX constants from the
 Fcntl module, if this module is available.
 
+=item binmode( [LAYER] )
+
+C<binmode> sets C<binmode> on the underlying C<IO> object, as documented
+in C<perldoc -f binmode>.
+
+C<binmode> accepts one optional parameter, which is the layer to be
+passed on to the C<binmode> call.
+
 =back
 
 =head1 SEE ALSO
@@ -176,4 +184,17 @@ sub open {
     open($fh, $file);
 }
 
+################################################
+## Binmode
+##
+
+sub binmode {
+    ( @_ == 0 or @_ == 1 ) or croak 'usage $fh->binmode([LAYER])';
+
+    my($fh, $layer) = @_;
+
+    return binmode $$fh unless $layer;
+    return binmode $$fh, $layer;
+}
+
 1;

diff --git a/ext/IO/t/io_file.t b/ext/IO/t/io_file.t
new file mode 100755 (executable)
index 0000000..a2e608a
--- /dev/null
+++ b/ext/IO/t/io_file.t
@@ -0,0 +1,50 @@
+#!./perl -w
+
+BEGIN { chdir 't' if -d 't'; }
+
+use strict;
+use lib '../lib';
+use Test::More tests => 9;
+
+my $Class       = 'IO::File';
+my $All_Chars   = join '', "\r\n", map( chr, 1..255 ), "zzz\n\r";
+my $File        = 'bin.'.$$;
+my $Expect      = quotemeta $All_Chars;
+
+use_ok( $Class );
+can_ok( $Class,                 "binmode" );
+
+### file the file with binary data;
+### use standard open to make sure we can compare binmodes
+### on both.
+{   my $tmp;
+    open $tmp, ">$File" or die "Could not open '$File': $!";
+    binmode $tmp;
+    print $tmp $All_Chars; 
+    close $tmp;
+}
+
+### now read in the file, once without binmode, once with.
+### without binmode should fail at least on win32...
+if( $^O =~ /MSWin32/ ) {
+    my $fh = $Class->new;
+
+    isa_ok( $fh,                $Class );
+    ok( $fh->open($File),       "   Opened '$File'" );
+    
+    my $cont = do { local $/; <$fh> };
+    unlike( $cont, qr/$Expect/, "   Content match fails without binmode" );
+}    
+
+### now with binmode, it must pass 
+{   my $fh = $Class->new;
+
+    isa_ok( $fh,                $Class );
+    ok( $fh->open($File),       "   Opened '$File' $!" );
+    ok( $fh->binmode,           "   binmode enabled" );
+    
+    my $cont = do { local $/; <$fh> };
+    like( $cont, qr/$Expect/,   "   Content match passes with binmode" );
+}
+    
+unlink $File;