Compress::Zlib

From: "Paul Marquess" <Paul.Marquess@ntlworld.com>
Message-ID: <00ab01c5d8e9$0ef31b40$02f0440a@myopwv.com>

p4raw-id: //depot/perl@25833

7 files changed, 66 insertions, 20 deletions

diff --git a/ext/Compress/Zlib/Zlib.pm b/ext/Compress/Zlib/Zlib.pm
index 5e54996f74..44c8f0d623 100644
--- a/ext/Compress/Zlib/Zlib.pm
+++ b/ext/Compress/Zlib/Zlib.pm
@@ -180,11 +180,15 @@ sub gzopen($$)
     _set_gzerr(0) ;
 
     if ($writing) {
-        $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, %defOpts) 
+        $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, 
+                                            BinModeOut => 1, %defOpts) 
             or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError;
     }
     else {
-        $gz = new IO::Uncompress::Gunzip($file, Append => 0, AutoClose => 1, Strict => 0) 
+        $gz = new IO::Uncompress::Gunzip($file, 
+                                            Transparent => 1,
+                                            BinModeIn => 1, Append => 0, 
+                                            AutoClose => 1, Strict => 0) 
             or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError;
     }
 
diff --git a/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm b/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm
index 615bd086e0..aaf8332522 100644
--- a/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm
+++ b/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm
@@ -23,20 +23,26 @@ $VERSION = '2.000_05';
               WANT_HASH
           );  
 
-sub setBinModeInput($)
+our ($wantBinmode);
+$wantBinmode = ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} ')
+                    ? 1 : 0 ;
+
+sub setBinModeInput($$)
 {
     my $handle = shift ;
+    my $want   = defined $_[0] ? shift : $wantBinmode ;
 
     binmode $handle 
-        unless $^O eq 'MSWin32' && ! ( ${^UNICODE} || ${^UTF8LOCALE} );
+        if  $want;
 }
 
-sub setBinModeOutput($)
+sub setBinModeOutput($$)
 {
     my $handle = shift ;
+    my $want   = defined $_[0] ? shift : $wantBinmode ;
 
     binmode $handle 
-        unless $^O eq 'MSWin32' && ! ( ${^UNICODE} || ${^UTF8LOCALE} );
+        if  $want;
 }
 
 sub isaFilehandle($)
@@ -76,7 +82,7 @@ use constant WANT_HASH  => 8 ;
 sub whatIsInput($;$)
 {
     my $got = whatIs(@_);
-    #return $got;
+    
     if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
     {
         use IO::File;
@@ -91,7 +97,7 @@ sub whatIsInput($;$)
 sub whatIsOutput($;$)
 {
     my $got = whatIs(@_);
-    #return $got;
+    
     if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
     {
         $got = 'handle';
diff --git a/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm b/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm
index ce4255ffac..ee1e72d923 100644
--- a/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm
+++ b/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm
@@ -458,6 +458,8 @@ sub checkParams
             'Strict'   => [Parse_boolean,   1],
             'Append'   => [Parse_boolean,   0],
             'Merge'    => [Parse_boolean,   0],
+            'BinModeIn' => [Parse_boolean,   undef],
+            'BinModeOut'=> [Parse_boolean,   undef],
 
             # zlib behaviour
             #'Method'   => [Parse_unsigned,  Z_DEFLATED],
@@ -484,6 +486,8 @@ sub checkParams
             'Strict'    => [Parse_boolean,   1],
             'Append'    => [Parse_boolean,   0],
             'Merge'     => [Parse_boolean,   0],
+            'BinModeIn' => [Parse_boolean,   undef],
+            'BinModeOut'=> [Parse_boolean,   undef],
 
             # zlib behaviour
             #'Method'   => [Parse_unsigned,  Z_DEFLATED],
@@ -674,6 +678,7 @@ sub new
             if ($outType eq 'handle') {
                 $outValue->flush() ;
                 *$obj->{FH} = $outValue ;
+                setBinModeOutput(*$obj->{FH}, $got->valueOrDefault('BinModeOut')) ;
                 *$obj->{Handle} = 1 ;
                 if ($appendOutput)
                 {
@@ -689,10 +694,9 @@ sub new
                 *$obj->{FH} = new IO::File "$mode $outValue" 
                     or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ;
                 *$obj->{StdIO} = ($outValue eq '-'); 
+                setBinModeOutput(*$obj->{FH}, $got->valueOrDefault('BinModeOut')) ;
             }
 
-            setBinModeOutput(*$obj->{FH}) ;
-
             if (!$rfc1951) {
                 defined *$obj->{FH}->write(*$obj->{Header}, length(*$obj->{Header}))
                     or return $obj->saveErrorString(undef, $!, $!) ;
@@ -749,6 +753,7 @@ sub new
     *$obj->{OutputRawDeflate} = $rfc1951;
     *$obj->{Output} = $outValue;
     *$obj->{ClassName} = $class;
+    *$obj->{Got} = $got;
 
     return $obj ;
 }
@@ -917,7 +922,7 @@ sub _wr2
             $fh = new IO::File "<$input"
                 or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ;
         }
-        setBinModeInput($fh) ;
+        setBinModeInput($fh, *$self->{Got}->valueOrDefault('BinModeIn')) ;
 
         my $status ;
         my $buff ;
diff --git a/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm b/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm
index 0d66282022..d4c52d6873 100644
--- a/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm
+++ b/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm
@@ -701,7 +701,8 @@ sub checkParams
                     'Transparent'   => [Parse_any,      1],
                     'Scan'          => [Parse_boolean,  0],
                     'InputLength'   => [Parse_unsigned, undef],
-
+                    'BinModeIn'     => [Parse_boolean,  undef],
+                    'BinModeOut'    => [Parse_boolean,  undef],                    
                     #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0,
                     # ContinueAfterEof
                 } ;
@@ -770,8 +771,8 @@ sub new
                 or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
             *$obj->{LineNo} = 0;
         }
-        # Setting STDIN to binmode causes grief
-        setBinModeInput(*$obj->{FH}) ;
+        
+        setBinModeInput(*$obj->{FH}, $got->valueOrDefault('BinModeIn')) ;
 
         my $buff = "" ;
         *$obj->{Buffer} = \$buff ;
@@ -1047,13 +1048,13 @@ sub _singleTarget
             if $x->{Got}->value('Append') ;
         $x->{fh} = new IO::File "$mode $output" 
             or return retErr($x, "cannot open file '$output': $!") ;
-        setBinModeOutput($x->{fh});
+        setBinModeOutput($x->{fh}, $x->{Got}->valueOrDefault('BinModeOut'));
 
     }
 
     elsif ($x->{outType} eq 'handle') {
         $x->{fh} = $output;
-        setBinModeOutput($x->{fh});
+        setBinModeOutput($x->{fh}, $x->{Got}->valueOrDefault('BinModeOut'));
         if ($x->{Got}->value('Append')) {
                 seek($x->{fh}, 0, SEEK_END)
                     or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
diff --git a/ext/Compress/Zlib/t/03zlib-v1.t b/ext/Compress/Zlib/t/03zlib-v1.t
index 8dea7df28f..92a7f1619a 100644
--- a/ext/Compress/Zlib/t/03zlib-v1.t
+++ b/ext/Compress/Zlib/t/03zlib-v1.t
@@ -23,10 +23,10 @@ BEGIN
 
     my $count = 0 ;
     if ($] < 5.005) {
-        $count = 340 ;
+        $count = 353 ;
     }
     else {
-        $count = 351 ;
+        $count = 364 ;
     }
 
 
@@ -491,6 +491,33 @@ EOM
     ok ! defined $ungzip ;
 }
 
+{
+    title "Check all bytes can be handled";
+
+    my $lex = "\r\n" . new LexFile my $name ;
+    my $data = join '', map { chr } 0x00 .. 0xFF;
+    $data .= "\r\nabd\r\n";
+
+    my $fil;
+    ok $fil = gzopen($name, "wb") ;
+    is $fil->gzwrite($data), length $data ;
+    ok ! $fil->gzclose();
+
+    my $input;
+    ok $fil = gzopen($name, "rb") ;
+    is $fil->gzread($input), length $data ;
+    ok ! $fil->gzclose();
+    ok $input eq $data;
+
+    title "Check all bytes can be handled - transparent mode";
+    writeFile($name, $data);
+    ok $fil = gzopen($name, "rb") ;
+    is $fil->gzread($input), length $data ;
+    ok ! $fil->gzclose();
+    ok $input eq $data;
+
+}
+
 title 'memGunzip with a gzopen created file';
 {
     my $name = "test.gz" ;
diff --git a/ext/Compress/Zlib/t/16oneshot.t b/ext/Compress/Zlib/t/16oneshot.t
index 7c24fba690..d5ad4622cc 100644
--- a/ext/Compress/Zlib/t/16oneshot.t
+++ b/ext/Compress/Zlib/t/16oneshot.t
@@ -204,7 +204,8 @@ foreach my $bit ('IO::Compress::Gzip',
     ok $Func->(\$data, \$out), "  $TopType ok";
 
     # corrupt the compressed data
-    substr($out, -10, 10) = "x" x 10 ;
+    #substr($out, -10, 10) = "x" x 10 ;
+    substr($out, int(length($out)/3), 10) = 'abcdeabcde';
 
     my $result;
     ok ! $FuncInverse->(\$out => \$result, Transparent => 0), "  $TopTypeInverse ok";
diff --git a/ext/Compress/Zlib/t/22merge.t b/ext/Compress/Zlib/t/22merge.t
index 45e18e910c..ddb1659b1d 100644
--- a/ext/Compress/Zlib/t/22merge.t
+++ b/ext/Compress/Zlib/t/22merge.t
@@ -293,7 +293,8 @@ foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Defla
             }
 
             my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
-                or die "## $GzipError\n";
+                or die "## Error is  $$Error\n";
+
             #print "YYY\n";
             #hexDump($buffer);
             #print "XXX\n";
@@ -311,6 +312,7 @@ foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Defla
 }
 
 
+
 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 {
     my $Error = getErrorRef($CompressClass);