From: Jos I. Boumans <kane@dwim.org>
Date: Tue, 9 Nov 2004 16:59:27 +0000 (+0100)
Subject: fix IO::File to support binmode
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a84e44cddbc22ba5018278af86e57a36c53e4042;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
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;