From: Rafael Garcia-Suarez Date: Mon, 6 Mar 2006 10:06:53 +0000 (+0000) Subject: Add and remove files forgotten in change #27384 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a02d0f6f11aa60e54078c276b04022366e5785b0;p=p5sagit%2Fp5-mst-13.2.git Add and remove files forgotten in change #27384 p4raw-link: @27384 on //depot/perl: 25f0751fb55a0f87a7e18ae8960f9acf2407ae32 p4raw-id: //depot/perl@27387 --- diff --git a/MANIFEST b/MANIFEST index 5cbda5e..18f2308 100644 --- a/MANIFEST +++ b/MANIFEST @@ -148,12 +148,12 @@ ext/Compress/Raw/Zlib/t/01version.t Compress::Raw::Zlib ext/Compress/Raw/Zlib/t/02zlib.t Compress::Raw::Zlib ext/Compress/Raw/Zlib/t/07bufsize.t Compress::Raw::Zlib ext/Compress/Raw/Zlib/t/18lvalue.t Compress::Raw::Zlib -ext/Compress/Raw/Zlib/t/99pod.t Compress::Raw::Zlib -ext/Compress/Raw/Zlib/Zlib.xs Compress::Raw::Zlib -ext/Compress/Raw/Zlib/typemap Compress::Raw::Zlib +ext/Compress/Raw/Zlib/t/99pod.t Compress::Raw::Zlib +ext/Compress/Raw/Zlib/Zlib.xs Compress::Raw::Zlib +ext/Compress/Raw/Zlib/typemap Compress::Raw::Zlib ext/Compress/Raw/Zlib/Makefile.PL Compress::Raw::Zlib -ext/Compress/Raw/Zlib/ppport.h Compress::Raw::Zlib -ext/Compress/Raw/Zlib/config.in Compress::Raw::Zlib +ext/Compress/Raw/Zlib/ppport.h Compress::Raw::Zlib +ext/Compress/Raw/Zlib/config.in Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/adler32.c Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/compress.c Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/crc32.c Compress::Raw::Zlib @@ -181,24 +181,24 @@ ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm Compress::Raw::Zlib ext/Compress/Raw/Zlib/examples/filtdef Compress::Raw::Zlib ext/Compress/Raw/Zlib/examples/filtinf Compress::Raw::Zlib ext/Compress/Raw/Zlib/private/MakeUtil.pm Compress::Raw::Zlib -ext/Compress/Raw/Zlib/README Compress::Raw::Zlib +ext/Compress/Raw/Zlib/README Compress::Raw::Zlib ext/Compress/Zlib/lib/Compress/Zlib.pm Compress::Zlib -ext/Compress/Zlib/t/01version.t Compress::Zlib -ext/Compress/Zlib/t/03zlib-v1.t Compress::Zlib +ext/Compress/Zlib/t/01version.t Compress::Zlib +ext/Compress/Zlib/t/03zlib-v1.t Compress::Zlib ext/Compress/Zlib/t/05examples.t Compress::Zlib -ext/Compress/Zlib/t/06gzsetp.t Compress::Zlib +ext/Compress/Zlib/t/06gzsetp.t Compress::Zlib ext/Compress/Zlib/t/08encoding.t Compress::Zlib -ext/Compress/Zlib/t/14gzopen.t Compress::Zlib -ext/Compress/Zlib/t/99pod.t Compress::Zlib +ext/Compress/Zlib/t/14gzopen.t Compress::Zlib +ext/Compress/Zlib/t/99pod.t Compress::Zlib ext/Compress/Zlib/examples/filtdef Compress::Zlib ext/Compress/Zlib/examples/filtinf Compress::Zlib ext/Compress/Zlib/examples/gzcat Compress::Zlib ext/Compress/Zlib/examples/gzgrep Compress::Zlib ext/Compress/Zlib/examples/gzstream Compress::Zlib -ext/Compress/Zlib/Makefile.PL Compress::Zlib -ext/Compress/Zlib/README Compress::Zlib +ext/Compress/Zlib/Makefile.PL Compress::Zlib +ext/Compress/Zlib/README Compress::Zlib ext/Compress/Zlib/private/MakeUtil.pm Compress::Zlib -ext/Compress/Zlib/Changes Compress::Zlib +ext/Compress/Zlib/Changes Compress::Zlib ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm IO::Compress::Base ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm IO::Compress::Base ext/Compress/IO/Base/lib/IO/Compress/Base.pm IO::Compress::Base diff --git a/ext/Compress/Zlib/lib/UncompressPlugin/Identity.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm similarity index 64% rename from ext/Compress/Zlib/lib/UncompressPlugin/Identity.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm index 3041a9f..30ab72f 100644 --- a/ext/Compress/Zlib/lib/UncompressPlugin/Identity.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm @@ -1,15 +1,16 @@ -package UncompressPlugin::Identity; +package IO::Uncompress::Adapter::Identity; use warnings; use strict; +use bytes; -use Compress::Zlib::Common qw(:Status); +use IO::Compress::Base::Common qw(:Status); our ($VERSION); $VERSION = '2.000_05'; -use Compress::Zlib (); +use Compress::Raw::Zlib (); sub mkUncompObject { @@ -19,9 +20,9 @@ sub mkUncompObject bless { 'CompSize' => 0, 'UnCompSize' => 0, 'wantCRC32' => $crc32, - 'CRC32' => Compress::Zlib::crc32(''), + 'CRC32' => Compress::Raw::Zlib::crc32(''), 'wantADLER32'=> $adler32, - 'ADLER32' => Compress::Zlib::adler32(''), + 'ADLER32' => Compress::Raw::Zlib::adler32(''), } ; } @@ -34,13 +35,14 @@ sub uncompr $self->{CompSize} += length ${ $_[0] } ; $self->{UnCompSize} = $self->{CompSize} ; - $self->{CRC32} = Compress::Zlib::crc32($_[0], $self->{CRC32}) + $self->{CRC32} = Compress::Raw::Zlib::crc32($_[0], $self->{CRC32}) if $self->{wantCRC32}; $self->{ADLER32} = Compress::Zlib::adler32($_[0], $self->{ADLER32}) if $self->{wantADLER32}; ${ $_[1] } .= ${ $_[0] }; + ${ $_[0] } = ""; } return STATUS_ENDSTREAM if $eof; @@ -49,15 +51,22 @@ sub uncompr sub reset { + my $self = shift; + + $self->{CompSize} = 0; + $self->{UnCompSize} = 0; + $self->{CRC32} = Compress::Zlib::crc32(''); + $self->{ADLER32} = Compress::Zlib::adler32(''); + return STATUS_OK ; } -sub count -{ - my $self = shift ; - return $self->{UnCompSize} ; -} +#sub count +#{ +# my $self = shift ; +# return $self->{UnCompSize} ; +#} sub compressedBytes { diff --git a/ext/Compress/Zlib/lib/UncompressPlugin/Inflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm similarity index 86% rename from ext/Compress/Zlib/lib/UncompressPlugin/Inflate.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm index ec3a148..4d63442 100644 --- a/ext/Compress/Zlib/lib/UncompressPlugin/Inflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm @@ -1,10 +1,11 @@ -package UncompressPlugin::Inflate; +package IO::Uncompress::Adapter::Inflate; use strict; use warnings; +use bytes; -use Compress::Zlib::Common qw(:Status); -use Compress::Zlib qw(Z_OK Z_DATA_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common qw(:Status); +use Compress::Raw::Zlib qw(Z_OK Z_DATA_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); $VERSION = '2.000_05'; @@ -22,14 +23,14 @@ sub mkUncompObject if ($scan) { - ($inflate, $status) = new Compress::Zlib::InflateScan + ($inflate, $status) = new Compress::Raw::Zlib::InflateScan CRC32 => $crc32, ADLER32 => $adler32, WindowBits => - MAX_WBITS ; } else { - ($inflate, $status) = new Compress::Zlib::Inflate + ($inflate, $status) = new Compress::Raw::Zlib::Inflate AppendOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, @@ -85,11 +86,11 @@ sub reset return STATUS_OK ; } -sub count -{ - my $self = shift ; - $self->{Inf}->inflateCount(); -} +#sub count +#{ +# my $self = shift ; +# $self->{Inf}->inflateCount(); +#} sub crc32 { @@ -150,7 +151,7 @@ sub createDeflateStream 'CompSize' => 0, 'UnCompSize' => 0, 'Error' => '', - }, 'CompressPlugin::Deflate'; + }, 'IO::Compress::Adapter::Deflate'; } 1; diff --git a/ext/Compress/Zlib/lib/IO/Uncompress/AnyInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm similarity index 90% rename from ext/Compress/Zlib/lib/IO/Uncompress/AnyInflate.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm index 12f592b..0f30931 100644 --- a/ext/Compress/Zlib/lib/IO/Uncompress/AnyInflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm @@ -4,26 +4,24 @@ package IO::Uncompress::AnyInflate ; use strict; use warnings; +use bytes; -use Compress::Zlib::Common qw(createSelfTiedObject); +use IO::Compress::Base::Common qw(createSelfTiedObject); -use UncompressPlugin::Inflate (); -#use UncompressPlugin::Bunzip2 (); +use IO::Uncompress::Adapter::Inflate (); -#use IO::Uncompress::Base ; +use IO::Uncompress::Base ; use IO::Uncompress::Gunzip ; use IO::Uncompress::Inflate ; use IO::Uncompress::RawInflate ; use IO::Uncompress::Unzip ; -#use IO::Uncompress::Bunzip2 ; -#use IO::Uncompress::UnLzop ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.000_07'; +$VERSION = '2.000_08'; $AnyInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -71,7 +69,7 @@ sub mkUncomp my $class = shift ; my $got = shift ; - my ($obj, $errstr, $errno) = UncompressPlugin::Inflate::mkUncompObject(); + my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject(); return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; @@ -124,8 +122,10 @@ __END__ =head1 NAME + IO::Uncompress::AnyInflate - Perl interface to read RFC 1950, 1951 & 1952 files/buffers + =head1 SYNOPSIS use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ; @@ -142,7 +142,10 @@ IO::Uncompress::AnyInflate - Perl interface to read RFC 1950, 1951 & 1952 files/ $line = $z->getline() $char = $z->getc() $char = $z->ungetc() + $char = $z->opened() + $status = $z->inflateSync() + $z->trailingData() $data = $z->getHeaderInfo() $z->tell() @@ -579,7 +582,7 @@ carried out, when Strict is off they are not. The default for this option is off. -If the input is an RFC1950 data stream, the following will be checked: +If the input is an RFC 1950 data stream, the following will be checked: @@ -599,7 +602,7 @@ uncompressed data actually contained in the file. -If the input is a gzip (RFC1952) data stream, the following will be checked: +If the input is a gzip (RFC 1952) data stream, the following will be checked: @@ -624,7 +627,7 @@ of ISO 8859-1 characters plus line-feed. =item 4 If the gzip FEXTRA header field is present it must conform to the sub-field -structure as defined in RFC1952. +structure as defined in RFC 1952. =item 5 @@ -651,7 +654,7 @@ uncompressed data actually read from the file. If the gzip FEXTRA header field is present and this option is set, it will force the module to check that it conforms to the sub-field structure as -defined in RFC1952. +defined in RFC 1952. If the C is on it will automatically enable this option. @@ -659,6 +662,8 @@ Defaults to 0. + + =back =head2 Examples @@ -733,6 +738,7 @@ Usage is $char = $z->ungetc($string) + =head2 inflateSync Usage is @@ -741,6 +747,7 @@ Usage is TODO + =head2 getHeaderInfo Usage is @@ -805,13 +812,51 @@ Usage is This is a noop provided for completeness. +=head2 opened + + $z->opened() + +Returns true if the object currently refers to a opened file/buffer. + +=head2 autoflush + + my $prev = $z->autoflush() + my $prev = $z->autoflush(EXPR) + +If the C<$z> object is associated with a file or a filehandle, this method +returns the current autoflush setting for the underlying filehandle. If +C is present, and is non-zero, it will enable flushing after every +write/print operation. + +If C<$z> is associated with a buffer, this method has no effect and always +returns C. + +B that the special variable C<$|> B be used to set or +retrieve the autoflush setting. + +=head2 input_line_number + + $z->input_line_number() + $z->input_line_number(EXPR) + + + +Returns the current uncompressed line number. If C is present it has +the effect of setting the line number. Note that setting the line number +does not change the current position within the file/buffer being read. + +The contents of C<$/> are used to to determine what constitutes a line +terminator. + + + =head2 fileno $z->fileno() fileno($z) -If the C<$z> object is associated with a file, this method will return -the underlying filehandle. +If the C<$z> object is associated with a file or a filehandle, this method +will return the underlying file descriptor. If the C<$z> object is is associated with a buffer, this method will return undef. @@ -870,31 +915,40 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L L -L, L, +L, L, +L, L + For RFC 1950, 1951 and 1952 see F, F and F -The primary site for the gzip program is F. +The I compression library was written by Jean-loup Gailly +F and Mark Adler F. + +The primary site for the I compression library is +F. + +The primary site for gzip is F. + + + + + + =head1 AUTHOR The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. +F. -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. -The primary site for the I compression library is -F. =head1 MODIFICATION HISTORY @@ -904,8 +958,7 @@ See the Changes file. Copyright (c) 2005-2006 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - diff --git a/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm similarity index 93% rename from ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm index d6d3846..aefc3c2 100644 --- a/ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm @@ -7,12 +7,13 @@ require 5.004 ; use strict ; use warnings; +use bytes; use IO::Uncompress::RawInflate ; -use Compress::Zlib qw( crc32 ) ; -use Compress::Zlib::Common qw(createSelfTiedObject); -use Compress::Gzip::Constants; +use Compress::Raw::Zlib qw( crc32 ) ; +use IO::Compress::Base::Common qw(:Status createSelfTiedObject); +use IO::Compress::Gzip::Constants; require Exporter ; @@ -26,7 +27,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.000_07'; +$VERSION = '2.000_08'; sub new { @@ -45,7 +46,7 @@ sub gunzip sub getExtraParams { - use Compress::Zlib::ParseParameters ; + use IO::Compress::Base::Common qw(:Parse); return ( 'ParseExtra' => [1, 1, Parse_boolean, 0] ) ; } @@ -109,7 +110,7 @@ sub chkTrailer if $ISIZE != $exp_isize ; } - return 1; + return STATUS_OK; } sub isGzipMagic @@ -294,8 +295,10 @@ __END__ =head1 NAME + IO::Uncompress::Gunzip - Perl interface to read RFC 1952 files/buffers + =head1 SYNOPSIS use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; @@ -312,7 +315,10 @@ IO::Uncompress::Gunzip - Perl interface to read RFC 1952 files/buffers $line = $z->getline() $char = $z->getc() $char = $z->ungetc() + $char = $z->opened() + $status = $z->inflateSync() + $z->trailingData() $data = $z->getHeaderInfo() $z->tell() @@ -775,7 +781,7 @@ of ISO 8859-1 characters plus line-feed. =item 4 If the gzip FEXTRA header field is present it must conform to the sub-field -structure as defined in RFC1952. +structure as defined in RFC 1952. =item 5 @@ -802,7 +808,7 @@ uncompressed data actually read from the file. If the gzip FEXTRA header field is present and this option is set, it will force the module to check that it conforms to the sub-field structure as -defined in RFC1952. +defined in RFC 1952. If the C is on it will automatically enable this option. @@ -810,6 +816,8 @@ Defaults to 0. + + =back =head2 Examples @@ -884,6 +892,7 @@ Usage is $char = $z->ungetc($string) + =head2 inflateSync Usage is @@ -892,6 +901,7 @@ Usage is TODO + =head2 getHeaderInfo Usage is @@ -974,13 +984,51 @@ Usage is This is a noop provided for completeness. +=head2 opened + + $z->opened() + +Returns true if the object currently refers to a opened file/buffer. + +=head2 autoflush + + my $prev = $z->autoflush() + my $prev = $z->autoflush(EXPR) + +If the C<$z> object is associated with a file or a filehandle, this method +returns the current autoflush setting for the underlying filehandle. If +C is present, and is non-zero, it will enable flushing after every +write/print operation. + +If C<$z> is associated with a buffer, this method has no effect and always +returns C. + +B that the special variable C<$|> B be used to set or +retrieve the autoflush setting. + +=head2 input_line_number + + $z->input_line_number() + $z->input_line_number(EXPR) + + + +Returns the current uncompressed line number. If C is present it has +the effect of setting the line number. Note that setting the line number +does not change the current position within the file/buffer being read. + +The contents of C<$/> are used to to determine what constitutes a line +terminator. + + + =head2 fileno $z->fileno() fileno($z) -If the C<$z> object is associated with a file, this method will return -the underlying filehandle. +If the C<$z> object is associated with a file or a filehandle, this method +will return the underlying file descriptor. If the C<$z> object is is associated with a buffer, this method will return undef. @@ -1039,31 +1087,40 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L L -L, L, +L, L, +L, L + For RFC 1950, 1951 and 1952 see F, F and F -The primary site for the gzip program is F. +The I compression library was written by Jean-loup Gailly +F and Mark Adler F. + +The primary site for the I compression library is +F. + +The primary site for gzip is F. + + + + + + =head1 AUTHOR The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. +F. -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. -The primary site for the I compression library is -F. =head1 MODIFICATION HISTORY @@ -1073,8 +1130,7 @@ See the Changes file. Copyright (c) 2005-2006 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - diff --git a/ext/Compress/Zlib/lib/IO/Uncompress/Inflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm similarity index 92% rename from ext/Compress/Zlib/lib/IO/Uncompress/Inflate.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm index 4193917..62c177c 100644 --- a/ext/Compress/Zlib/lib/IO/Uncompress/Inflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm @@ -3,16 +3,17 @@ package IO::Uncompress::Inflate ; use strict ; use warnings; +use bytes; -use Compress::Zlib::Common qw(createSelfTiedObject); -use Compress::Zlib::FileConstants; +use IO::Compress::Base::Common qw(:Status createSelfTiedObject); +use IO::Compress::Zlib::Constants; use IO::Uncompress::RawInflate ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.000_07'; +$VERSION = '2.000_08'; $InflateError = ''; @ISA = qw( Exporter IO::Uncompress::RawInflate ); @@ -90,7 +91,7 @@ sub chkTrailer return $self->TrailerError("CRC mismatch") if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ; - return 1; + return STATUS_OK; } @@ -176,8 +177,10 @@ __END__ =head1 NAME + IO::Uncompress::Inflate - Perl interface to read RFC 1950 files/buffers + =head1 SYNOPSIS use IO::Uncompress::Inflate qw(inflate $InflateError) ; @@ -194,7 +197,10 @@ IO::Uncompress::Inflate - Perl interface to read RFC 1950 files/buffers $line = $z->getline() $char = $z->getc() $char = $z->ungetc() + $char = $z->opened() + $status = $z->inflateSync() + $z->trailingData() $data = $z->getHeaderInfo() $z->tell() @@ -654,6 +660,8 @@ uncompressed data actually contained in the file. + + =back =head2 Examples @@ -728,6 +736,7 @@ Usage is $char = $z->ungetc($string) + =head2 inflateSync Usage is @@ -736,6 +745,7 @@ Usage is TODO + =head2 getHeaderInfo Usage is @@ -800,13 +810,51 @@ Usage is This is a noop provided for completeness. +=head2 opened + + $z->opened() + +Returns true if the object currently refers to a opened file/buffer. + +=head2 autoflush + + my $prev = $z->autoflush() + my $prev = $z->autoflush(EXPR) + +If the C<$z> object is associated with a file or a filehandle, this method +returns the current autoflush setting for the underlying filehandle. If +C is present, and is non-zero, it will enable flushing after every +write/print operation. + +If C<$z> is associated with a buffer, this method has no effect and always +returns C. + +B that the special variable C<$|> B be used to set or +retrieve the autoflush setting. + +=head2 input_line_number + + $z->input_line_number() + $z->input_line_number(EXPR) + + + +Returns the current uncompressed line number. If C is present it has +the effect of setting the line number. Note that setting the line number +does not change the current position within the file/buffer being read. + +The contents of C<$/> are used to to determine what constitutes a line +terminator. + + + =head2 fileno $z->fileno() fileno($z) -If the C<$z> object is associated with a file, this method will return -the underlying filehandle. +If the C<$z> object is associated with a file or a filehandle, this method +will return the underlying file descriptor. If the C<$z> object is is associated with a buffer, this method will return undef. @@ -865,31 +913,40 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L L -L, L, +L, L, +L, L + For RFC 1950, 1951 and 1952 see F, F and F -The primary site for the gzip program is F. +The I compression library was written by Jean-loup Gailly +F and Mark Adler F. + +The primary site for the I compression library is +F. + +The primary site for gzip is F. + + + + + + =head1 AUTHOR The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. +F. -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. -The primary site for the I compression library is -F. =head1 MODIFICATION HISTORY @@ -899,8 +956,7 @@ See the Changes file. Copyright (c) 2005-2006 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - diff --git a/ext/Compress/Zlib/lib/IO/Uncompress/RawInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm similarity index 92% rename from ext/Compress/Zlib/lib/IO/Uncompress/RawInflate.pm rename to ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm index 756a10c..72b1dbb 100644 --- a/ext/Compress/Zlib/lib/IO/Uncompress/RawInflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm @@ -3,13 +3,13 @@ package IO::Uncompress::RawInflate ; use strict ; use warnings; +use bytes; -use Compress::Zlib 2 ; -use Compress::Zlib::Common qw(:Status createSelfTiedObject); -use Compress::Zlib::ParseParameters ; +use Compress::Raw::Zlib ; +use IO::Compress::Base::Common qw(:Status createSelfTiedObject); use IO::Uncompress::Base ; -use UncompressPlugin::Inflate ; +use IO::Uncompress::Adapter::Inflate ; @@ -17,7 +17,7 @@ use UncompressPlugin::Inflate ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.000_07'; +$VERSION = '2.000_08'; $RawInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -61,7 +61,7 @@ sub mkUncomp my $class = shift ; my $got = shift ; - my ($obj, $errstr, $errno) = UncompressPlugin::Inflate::mkUncompObject( + my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject( $got->value('CRC32'), $got->value('ADLER32'), $got->value('Scan'), @@ -106,7 +106,7 @@ sub readHeader sub chkTrailer { - return 1 ; + return STATUS_OK ; } sub _isRaw @@ -146,7 +146,7 @@ sub _isRawx return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR) if $status == STATUS_ERROR; - my $buf_len = *$self->{Uncomp}->count(); + my $buf_len = *$self->{Uncomp}->uncompressedBytes(); if ($status == STATUS_ENDSTREAM) { if (*$self->{MultiStream} @@ -330,8 +330,10 @@ __END__ =head1 NAME + IO::Uncompress::RawInflate - Perl interface to read RFC 1951 files/buffers + =head1 SYNOPSIS use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ; @@ -348,7 +350,10 @@ IO::Uncompress::RawInflate - Perl interface to read RFC 1951 files/buffers $line = $z->getline() $char = $z->getc() $char = $z->ungetc() + $char = $z->opened() + $status = $z->inflateSync() + $z->trailingData() $data = $z->getHeaderInfo() $z->tell() @@ -777,6 +782,7 @@ This option is a no-op. + =back =head2 Examples @@ -851,6 +857,7 @@ Usage is $char = $z->ungetc($string) + =head2 inflateSync Usage is @@ -859,6 +866,7 @@ Usage is TODO + =head2 getHeaderInfo Usage is @@ -923,13 +931,51 @@ Usage is This is a noop provided for completeness. +=head2 opened + + $z->opened() + +Returns true if the object currently refers to a opened file/buffer. + +=head2 autoflush + + my $prev = $z->autoflush() + my $prev = $z->autoflush(EXPR) + +If the C<$z> object is associated with a file or a filehandle, this method +returns the current autoflush setting for the underlying filehandle. If +C is present, and is non-zero, it will enable flushing after every +write/print operation. + +If C<$z> is associated with a buffer, this method has no effect and always +returns C. + +B that the special variable C<$|> B be used to set or +retrieve the autoflush setting. + +=head2 input_line_number + + $z->input_line_number() + $z->input_line_number(EXPR) + + + +Returns the current uncompressed line number. If C is present it has +the effect of setting the line number. Note that setting the line number +does not change the current position within the file/buffer being read. + +The contents of C<$/> are used to to determine what constitutes a line +terminator. + + + =head2 fileno $z->fileno() fileno($z) -If the C<$z> object is associated with a file, this method will return -the underlying filehandle. +If the C<$z> object is associated with a file or a filehandle, this method +will return the underlying file descriptor. If the C<$z> object is is associated with a buffer, this method will return undef. @@ -988,31 +1034,40 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L L -L, L, +L, L, +L, L + For RFC 1950, 1951 and 1952 see F, F and F -The primary site for the gzip program is F. +The I compression library was written by Jean-loup Gailly +F and Mark Adler F. + +The primary site for the I compression library is +F. + +The primary site for gzip is F. + + + + + + =head1 AUTHOR The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. +F. -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. -The primary site for the I compression library is -F. =head1 MODIFICATION HISTORY @@ -1022,8 +1077,7 @@ See the Changes file. Copyright (c) 2005-2006 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm new file mode 100644 index 0000000..5e021df --- /dev/null +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm @@ -0,0 +1,1297 @@ +package IO::Uncompress::Unzip; + +require 5.004 ; + +# for RFC1952 + +use strict ; +use warnings; +use bytes; + +use IO::Uncompress::RawInflate ; +use IO::Compress::Base::Common qw(:Status createSelfTiedObject); +use IO::Uncompress::Adapter::Identity; + +require Exporter ; + +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError); + +$VERSION = '2.000_08'; +$UnzipError = ''; + +@ISA = qw(Exporter IO::Uncompress::RawInflate); +@EXPORT_OK = qw( $UnzipError unzip ); +%EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ; +push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; +Exporter::export_ok_tags('all'); + + +sub new +{ + my $class = shift ; + my $obj = createSelfTiedObject($class, \$UnzipError); + $obj->_create(undef, 0, @_); +} + +sub unzip +{ + my $obj = createSelfTiedObject(undef, \$UnzipError); + return $obj->_inf(@_) ; +} + +sub getExtraParams +{ + use IO::Compress::Base::Common qw(:Parse); + + + return ( +# # Zip header fields + 'Name' => [1, 1, Parse_any, undef], + +# 'Streaming' => [1, 1, Parse_boolean, 1], + ); +} + +sub ckParams +{ + my $self = shift ; + my $got = shift ; + + # unzip always needs crc32 + $got->value('CRC32' => 1); + + *$self->{UnzipData}{Name} = $got->value('Name'); + + return 1; +} + + +sub ckMagic +{ + my $self = shift; + + my $magic ; + $self->smartReadExact(\$magic, 4); + + *$self->{HeaderPending} = $magic ; + + return $self->HeaderError("Minimum header size is " . + 4 . " bytes") + if length $magic != 4 ; + + return $self->HeaderError("Bad Magic") + if ! _isZipMagic($magic) ; + + *$self->{Type} = 'zip'; + + return $magic ; +} + + + +sub readHeader +{ + my $self = shift; + my $magic = shift ; + + my $name = *$self->{UnzipData}{Name} ; + my $hdr = $self->_readZipHeader($magic) ; + + while (defined $hdr) + { + if (! defined $name || $hdr->{Name} eq $name) + { + return $hdr ; + } + + # skip the data + my $buffer; + if (*$self->{ZipData}{Streaming}) { + + while (1) { + + my $b; + my $status = $self->smartRead(\$b, 1024 * 16); + return undef + if $status <= 0 ; + + my $temp_buf; + my $out; + $status = *$self->{Uncomp}->uncompr(\$b, \$temp_buf, 0, $out); + + return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, + *$self->{Uncomp}{ErrorNo}) + if $self->saveStatus($status) == STATUS_ERROR; + + if ($status == STATUS_ENDSTREAM) { + *$self->{Uncomp}->reset(); + $self->pushBack($b) ; + last; + } + } + + # skip the trailer + $self->smartReadExact(\$buffer, $hdr->{TrailerLength}) + or return $self->saveErrorString(undef, "Truncated file"); + } + else { + my $c = $hdr->{CompressedLength}; + $self->smartReadExact(\$buffer, $c) + or return $self->saveErrorString(undef, "Truncated file"); + $buffer = ''; + } + + $self->chkTrailer($buffer) == STATUS_OK + or return $self->saveErrorString(undef, "Truncated file"); + + $hdr = $self->_readFullZipHeader(); + + return $self->saveErrorString(undef, "Cannot find '$name'") + if $self->smartEof(); + } + + return undef; +} + +sub chkTrailer +{ + my $self = shift; + my $trailer = shift; + + my ($sig, $CRC32, $cSize, $uSize) ; + if (*$self->{ZipData}{Streaming}) { + ($sig, $CRC32, $cSize, $uSize) = unpack("V V V V", $trailer) ; + return $self->TrailerError("Data Descriptor signature, got $sig") + if $sig != 0x08074b50; + } + else { + ($CRC32, $cSize, $uSize) = + (*$self->{ZipData}{Crc32}, + *$self->{ZipData}{CompressedLen}, + *$self->{ZipData}{UnCompressedLen}); + } + + if (*$self->{Strict}) { + #return $self->TrailerError("CRC mismatch") + # if $CRC32 != *$self->{Uncomp}->crc32() ; + + my $exp_isize = *$self->{Uncomp}->compressedBytes(); + return $self->TrailerError("CSIZE mismatch. Got $cSize" + . ", expected $exp_isize") + if $cSize != $exp_isize ; + + $exp_isize = *$self->{Uncomp}->uncompressedBytes(); + return $self->TrailerError("USIZE mismatch. Got $uSize" + . ", expected $exp_isize") + if $uSize != $exp_isize ; + } + + my $reachedEnd = STATUS_ERROR ; + # check for central directory or end of central directory + while (1) + { + my $magic ; + my $got = $self->smartRead(\$magic, 4); + + return $self->saveErrorString(STATUS_ERROR, "Truncated file") + if $got != 4 && *$self->{Strict}; + + if ($got == 0) { + return STATUS_EOF ; + } + elsif ($got < 0) { + return STATUS_ERROR ; + } + elsif ($got < 4) { + $self->pushBack($magic) ; + return STATUS_OK ; + } + + my $sig = unpack("V", $magic) ; + + if ($sig == 0x02014b50) + { + if ($self->skipCentralDirectory($magic) != STATUS_OK ) { + if (*$self->{Strict}) { + return STATUS_ERROR ; + } + else { + $self->clearError(); + return STATUS_OK ; + } + } + } + elsif ($sig == 0x06054b50) + { + if ($self->skipEndCentralDirectory($magic) != STATUS_OK) { + if (*$self->{Strict}) { + return STATUS_ERROR ; + } + else { + $self->clearError(); + return STATUS_OK ; + } + } + # $reachedEnd = STATUS_OK ; + return STATUS_OK ; + last; + } + elsif ($sig == 0x04034b50) + { + $self->pushBack($magic) ; + return STATUS_OK ; + } + else + { + # put the data back + $self->pushBack($magic) ; + last; + } + } + + return $reachedEnd ; +} + +sub skipCentralDirectory +{ + my $self = shift; + my $magic = shift ; + + my $buffer; + $self->smartReadExact(\$buffer, 46 - 4) + or return $self->TrailerError("Minimum header size is " . + 46 . " bytes") ; + + my $keep = $magic . $buffer ; + *$self->{HeaderPending} = $keep ; + + #my $versionMadeBy = unpack ("v", substr($buffer, 4-4, 2)); + #my $extractVersion = unpack ("v", substr($buffer, 6-4, 2)); + #my $gpFlag = unpack ("v", substr($buffer, 8-4, 2)); + #my $compressedMethod = unpack ("v", substr($buffer, 10-4, 2)); + #my $lastModTime = unpack ("V", substr($buffer, 12-4, 4)); + #my $crc32 = unpack ("V", substr($buffer, 16-4, 4)); + #my $compressedLength = unpack ("V", substr($buffer, 20-4, 4)); + #my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4)); + my $filename_length = unpack ("v", substr($buffer, 28-4, 2)); + my $extra_length = unpack ("v", substr($buffer, 30-4, 2)); + my $comment_length = unpack ("v", substr($buffer, 32-4, 2)); + #my $disk_start = unpack ("v", substr($buffer, 34-4, 2)); + #my $int_file_attrib = unpack ("v", substr($buffer, 36-4, 2)); + #my $ext_file_attrib = unpack ("V", substr($buffer, 38-4, 2)); + #my $lcl_hdr_offset = unpack ("V", substr($buffer, 42-4, 2)); + + + my $filename; + my $extraField; + my $comment ; + if ($filename_length) + { + $self->smartReadExact(\$filename, $filename_length) + or return $self->TrailerError("xxx"); + $keep .= $filename ; + } + + if ($extra_length) + { + $self->smartReadExact(\$extraField, $extra_length) + or return $self->TrailerError("xxx"); + $keep .= $extraField ; + } + + if ($comment_length) + { + $self->smartReadExact(\$comment, $comment_length) + or return $self->TrailerError("xxx"); + $keep .= $comment ; + } + + return STATUS_OK ; +} + +sub skipEndCentralDirectory +{ + my $self = shift; + my $magic = shift ; + + my $buffer; + $self->smartReadExact(\$buffer, 22 - 4) + or return $self->TrailerError("Minimum header size is " . + 22 . " bytes") ; + + my $keep = $magic . $buffer ; + *$self->{HeaderPending} = $keep ; + + #my $diskNumber = unpack ("v", substr($buffer, 4-4, 2)); + #my $cntrlDirDiskNo = unpack ("v", substr($buffer, 6-4, 2)); + #my $entriesInThisCD = unpack ("v", substr($buffer, 8-4, 2)); + #my $entriesInCD = unpack ("v", substr($buffer, 10-4, 2)); + #my $sizeOfCD = unpack ("V", substr($buffer, 12-4, 2)); + #my $offsetToCD = unpack ("V", substr($buffer, 16-4, 2)); + my $comment_length = unpack ("v", substr($buffer, 20-4, 2)); + + + my $comment ; + if ($comment_length) + { + $self->smartReadExact(\$comment, $comment_length) + or return $self->TrailerError("xxx"); + $keep .= $comment ; + } + + return STATUS_OK ; +} + + + + +sub _isZipMagic +{ + my $buffer = shift ; + return 0 if length $buffer < 4 ; + my $sig = unpack("V", $buffer) ; + return $sig == 0x04034b50 ; +} + + +sub _readFullZipHeader($) +{ + my ($self) = @_ ; + my $magic = '' ; + + $self->smartReadExact(\$magic, 4); + + *$self->{HeaderPending} = $magic ; + + return $self->HeaderError("Minimum header size is " . + 30 . " bytes") + if length $magic != 4 ; + + + return $self->HeaderError("Bad Magic") + if ! _isZipMagic($magic) ; + + my $status = $self->_readZipHeader($magic); + delete *$self->{Transparent} if ! defined $status ; + return $status ; +} + +sub _readZipHeader($) +{ + my ($self, $magic) = @_ ; + my ($HeaderCRC) ; + my ($buffer) = '' ; + + $self->smartReadExact(\$buffer, 30 - 4) + or return $self->HeaderError("Minimum header size is " . + 30 . " bytes") ; + + my $keep = $magic . $buffer ; + *$self->{HeaderPending} = $keep ; + + my $extractVersion = unpack ("v", substr($buffer, 4-4, 2)); + my $gpFlag = unpack ("v", substr($buffer, 6-4, 2)); + my $compressedMethod = unpack ("v", substr($buffer, 8-4, 2)); + my $lastModTime = unpack ("V", substr($buffer, 10-4, 4)); + my $crc32 = unpack ("V", substr($buffer, 14-4, 4)); + my $compressedLength = unpack ("V", substr($buffer, 18-4, 4)); + my $uncompressedLength = unpack ("V", substr($buffer, 22-4, 4)); + my $filename_length = unpack ("v", substr($buffer, 26-4, 2)); + my $extra_length = unpack ("v", substr($buffer, 28-4, 2)); + + my $filename; + my $extraField; + my $streamingMode = ($gpFlag & 0x08) ? 1 : 0 ; + + return $self->HeaderError("Streamed Stored content not supported") + if $streamingMode && $compressedMethod == 0 ; + + *$self->{ZipData}{Streaming} = $streamingMode; + + if (! $streamingMode) { + *$self->{ZipData}{Streaming} = 0; + *$self->{ZipData}{Crc32} = $crc32; + *$self->{ZipData}{CompressedLen} = $compressedLength; + *$self->{ZipData}{UnCompressedLen} = $uncompressedLength; + *$self->{CompressedInputLengthRemaining} = + *$self->{CompressedInputLength} = $compressedLength; + } + + + if ($filename_length) + { + $self->smartReadExact(\$filename, $filename_length) + or return $self->HeaderError("xxx"); + $keep .= $filename ; + } + + if ($extra_length) + { + $self->smartReadExact(\$extraField, $extra_length) + or return $self->HeaderError("xxx"); + $keep .= $extraField ; + } + + if ($compressedMethod == 8) + { + *$self->{Type} = 'zip'; + } + elsif ($compressedMethod == 0) + { + # TODO -- add support for reading uncompressed + + *$self->{Type} = 'zipStored'; + + my $obj = IO::Uncompress::Adapter::Identity::mkUncompObject(# $got->value('CRC32'), + # $got->value('ADLER32'), + ); + + *$self->{Uncomp} = $obj; + + } + else + { + return $self->HeaderError("Unsupported Compression format $compressedMethod"); + } + + return { + 'Type' => 'zip', + 'FingerprintLength' => 4, + #'HeaderLength' => $compressedMethod == 8 ? length $keep : 0, + 'HeaderLength' => length $keep, + 'TrailerLength' => $streamingMode ? 16 : 0, + 'Header' => $keep, + 'CompressedLength' => $compressedLength , + 'UncompressedLength' => $uncompressedLength , + 'CRC32' => $crc32 , + 'Name' => $filename, + 'Time' => _dosToUnixTime($lastModTime), + 'Stream' => $streamingMode, + + 'MethodID' => $compressedMethod, + 'MethodName' => $compressedMethod == 8 + ? "Deflated" + : $compressedMethod == 0 + ? "Stored" + : "Unknown" , + +# 'TextFlag' => $flag & GZIP_FLG_FTEXT ? 1 : 0, +# 'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0, +# 'NameFlag' => $flag & GZIP_FLG_FNAME ? 1 : 0, +# 'CommentFlag' => $flag & GZIP_FLG_FCOMMENT ? 1 : 0, +# 'ExtraFlag' => $flag & GZIP_FLG_FEXTRA ? 1 : 0, +# 'Comment' => $comment, +# 'OsID' => $os, +# 'OsName' => defined $GZIP_OS_Names{$os} +# ? $GZIP_OS_Names{$os} : "Unknown", +# 'HeaderCRC' => $HeaderCRC, +# 'Flags' => $flag, +# 'ExtraFlags' => $xfl, +# 'ExtraFieldRaw' => $EXTRA, +# 'ExtraField' => [ @EXTRA ], + + + } +} + +# from Archive::Zip +sub _dosToUnixTime +{ + #use Time::Local 'timelocal_nocheck'; + use Time::Local 'timelocal'; + + my $dt = shift; + + my $year = ( ( $dt >> 25 ) & 0x7f ) + 80; + my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1; + my $mday = ( ( $dt >> 16 ) & 0x1f ); + + my $hour = ( ( $dt >> 11 ) & 0x1f ); + my $min = ( ( $dt >> 5 ) & 0x3f ); + my $sec = ( ( $dt << 1 ) & 0x3e ); + + # catch errors + my $time_t = + eval { timelocal( $sec, $min, $hour, $mday, $mon, $year ); }; + return 0 + if $@; + return $time_t; +} + + +1; + +__END__ + + +=head1 NAME + + +IO::Uncompress::Unzip - Perl interface to read zip files/buffers + + +=head1 SYNOPSIS + + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + + my $status = unzip $input => $output [,OPTS] + or die "unzip failed: $UnzipError\n"; + + my $z = new IO::Uncompress::Unzip $input [OPTS] + or die "unzip failed: $UnzipError\n"; + + $status = $z->read($buffer) + $status = $z->read($buffer, $length) + $status = $z->read($buffer, $length, $offset) + $line = $z->getline() + $char = $z->getc() + $char = $z->ungetc() + $char = $z->opened() + + $status = $z->inflateSync() + + $z->trailingData() + $data = $z->getHeaderInfo() + $z->tell() + $z->seek($position, $whence) + $z->binmode() + $z->fileno() + $z->eof() + $z->close() + + $UnzipError ; + + # IO::File mode + + <$z> + read($z, $buffer); + read($z, $buffer, $length); + read($z, $buffer, $length, $offset); + tell($z) + seek($z, $position, $whence) + binmode($z) + fileno($z) + eof($z) + close($z) + + +=head1 DESCRIPTION + + + +B. + +=over 5 + +=item * DO NOT use in production code. + +=item * The documentation is incomplete in places. + +=item * Parts of the interface defined here are tentative. + +=item * Please report any problems you find. + +=back + + + + + +This module provides a Perl interface that allows the reading of +zlib files/buffers. + +For writing zip files/buffers, see the companion module IO::Compress::Zip. + + + +=head1 Functional Interface + +A top-level function, C, is provided to carry out +"one-shot" uncompression between buffers and/or files. For finer +control over the uncompression process, see the L +section. + + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + + unzip $input => $output [,OPTS] + or die "unzip failed: $UnzipError\n"; + + + +The functional interface needs Perl5.005 or better. + + +=head2 unzip $input => $output [, OPTS] + + +C expects at least two parameters, C<$input> and C<$output>. + +=head3 The C<$input> parameter + +The parameter, C<$input>, is used to define the source of +the compressed data. + +It can take one of the following forms: + +=over 5 + +=item A filename + +If the C<$input> parameter is a simple scalar, it is assumed to be a +filename. This file will be opened for reading and the input data +will be read from it. + +=item A filehandle + +If the C<$input> parameter is a filehandle, the input data will be +read from it. +The string '-' can be used as an alias for standard input. + +=item A scalar reference + +If C<$input> is a scalar reference, the input data will be read +from C<$$input>. + +=item An array reference + +If C<$input> is an array reference, each element in the array must be a +filename. + +The input data will be read from each file in turn. + +The complete array will be walked to ensure that it only +contains valid filenames before any data is uncompressed. + + + +=item An Input FileGlob string + +If C<$input> is a string that is delimited by the characters "<" and ">" +C will assume that it is an I. The +input is the list of files that match the fileglob. + +If the fileglob does not match any files ... + +See L for more details. + + +=back + +If the C<$input> parameter is any other type, C will be returned. + + + +=head3 The C<$output> parameter + +The parameter C<$output> is used to control the destination of the +uncompressed data. This parameter can take one of these forms. + +=over 5 + +=item A filename + +If the C<$output> parameter is a simple scalar, it is assumed to be a +filename. This file will be opened for writing and the uncompressed +data will be written to it. + +=item A filehandle + +If the C<$output> parameter is a filehandle, the uncompressed data +will be written to it. +The string '-' can be used as an alias for standard output. + + +=item A scalar reference + +If C<$output> is a scalar reference, the uncompressed data will be +stored in C<$$output>. + + + +=item An Array Reference + +If C<$output> is an array reference, the uncompressed data will be +pushed onto the array. + +=item An Output FileGlob + +If C<$output> is a string that is delimited by the characters "<" and ">" +C will assume that it is an I. The +output is the list of files that match the fileglob. + +When C<$output> is an fileglob string, C<$input> must also be a fileglob +string. Anything else is an error. + +=back + +If the C<$output> parameter is any other type, C will be returned. + + + +=head2 Notes + +When C<$input> maps to multiple files/buffers and C<$output> is a single +file/buffer the uncompressed input files/buffers will all be stored +in C<$output> as a single uncompressed stream. + + + +=head2 Optional Parameters + +Unless specified below, the optional parameters for C, +C, are the same as those used with the OO interface defined in the +L section below. + +=over 5 + +=item AutoClose =E 0|1 + +This option applies to any input or output data streams to +C that are filehandles. + +If C is specified, and the value is true, it will result in all +input and/or output filehandles being closed once C has +completed. + +This parameter defaults to 0. + + + +=item BinModeOut =E 0|1 + +When writing to a file or filehandle, set C before writing to the +file. + +Defaults to 0. + + + + + +=item -Append =E 0|1 + +TODO + +=item -MultiStream =E 0|1 + +Creates a new stream after each file. + +Defaults to 1. + + + +=back + + + + +=head2 Examples + +To read the contents of the file C and write the +compressed data to the file C. + + use strict ; + use warnings ; + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + + my $input = "file1.txt.zip"; + my $output = "file1.txt"; + unzip $input => $output + or die "unzip failed: $UnzipError\n"; + + +To read from an existing Perl filehandle, C<$input>, and write the +uncompressed data to a buffer, C<$buffer>. + + use strict ; + use warnings ; + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + use IO::File ; + + my $input = new IO::File " \$buffer + or die "unzip failed: $UnzipError\n"; + +To uncompress all files in the directory "/my/home" that match "*.txt.zip" and store the compressed data in the same directory + + use strict ; + use warnings ; + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + + unzip '' => '' + or die "unzip failed: $UnzipError\n"; + +and if you want to compress each file one at a time, this will do the trick + + use strict ; + use warnings ; + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + + for my $input ( glob "/my/home/*.txt.zip" ) + { + my $output = $input; + $output =~ s/.zip// ; + unzip $input => $output + or die "Error compressing '$input': $UnzipError\n"; + } + +=head1 OO Interface + +=head2 Constructor + +The format of the constructor for IO::Uncompress::Unzip is shown below + + + my $z = new IO::Uncompress::Unzip $input [OPTS] + or die "IO::Uncompress::Unzip failed: $UnzipError\n"; + +Returns an C object on success and undef on failure. +The variable C<$UnzipError> will contain an error message on failure. + +If you are running Perl 5.005 or better the object, C<$z>, returned from +IO::Uncompress::Unzip can be used exactly like an L filehandle. +This means that all normal input file operations can be carried out with +C<$z>. For example, to read a line from a compressed file/buffer you can +use either of these forms + + $line = $z->getline(); + $line = <$z>; + +The mandatory parameter C<$input> is used to determine the source of the +compressed data. This parameter can take one of three forms. + +=over 5 + +=item A filename + +If the C<$input> parameter is a scalar, it is assumed to be a filename. This +file will be opened for reading and the compressed data will be read from it. + +=item A filehandle + +If the C<$input> parameter is a filehandle, the compressed data will be +read from it. +The string '-' can be used as an alias for standard input. + + +=item A scalar reference + +If C<$input> is a scalar reference, the compressed data will be read from +C<$$output>. + +=back + +=head2 Constructor Options + + +The option names defined below are case insensitive and can be optionally +prefixed by a '-'. So all of the following are valid + + -AutoClose + -autoclose + AUTOCLOSE + autoclose + +OPTS is a combination of the following options: + +=over 5 + +=item -AutoClose =E 0|1 + +This option is only valid when the C<$input> parameter is a filehandle. If +specified, and the value is true, it will result in the file being closed once +either the C method is called or the IO::Uncompress::Unzip object is +destroyed. + +This parameter defaults to 0. + +=item -MultiStream =E 0|1 + + + +Allows multiple concatenated compressed streams to be treated as a single +compressed stream. Decompression will stop once either the end of the +file/buffer is reached, an error is encountered (premature eof, corrupt +compressed data) or the end of a stream is not immediately followed by the +start of another stream. + +This parameter defaults to 0. + + + +=item -Prime =E $string + +This option will uncompress the contents of C<$string> before processing the +input file/buffer. + +This option can be useful when the compressed data is embedded in another +file/data structure and it is not possible to work out where the compressed +data begins without having to read the first few bytes. If this is the +case, the uncompression can be I with these bytes using this +option. + +=item -Transparent =E 0|1 + +If this option is set and the input file or buffer is not compressed data, +the module will allow reading of it anyway. + +This option defaults to 1. + +=item -BlockSize =E $num + +When reading the compressed input data, IO::Uncompress::Unzip will read it in +blocks of C<$num> bytes. + +This option defaults to 4096. + +=item -InputLength =E $size + +When present this option will limit the number of compressed bytes read +from the input file/buffer to C<$size>. This option can be used in the +situation where there is useful data directly after the compressed data +stream and you know beforehand the exact length of the compressed data +stream. + +This option is mostly used when reading from a filehandle, in which case +the file pointer will be left pointing to the first byte directly after the +compressed data stream. + + + +This option defaults to off. + +=item -Append =E 0|1 + +This option controls what the C method does with uncompressed data. + +If set to 1, all uncompressed data will be appended to the output parameter +of the C method. + +If set to 0, the contents of the output parameter of the C method +will be overwritten by the uncompressed data. + +Defaults to 0. + +=item -Strict =E 0|1 + + + +This option controls whether the extra checks defined below are used when +carrying out the decompression. When Strict is on, the extra tests are +carried out, when Strict is off they are not. + +The default for this option is off. + + + + + + + + + + + + + + +=back + +=head2 Examples + +TODO + +=head1 Methods + +=head2 read + +Usage is + + $status = $z->read($buffer) + +Reads a block of compressed data (the size the the compressed block is +determined by the C option in the constructor), uncompresses it and +writes any uncompressed data into C<$buffer>. If the C parameter is +set in the constructor, the uncompressed data will be appended to the +C<$buffer> parameter. Otherwise C<$buffer> will be overwritten. + +Returns the number of uncompressed bytes written to C<$buffer>, zero if eof +or a negative number on error. + +=head2 read + +Usage is + + $status = $z->read($buffer, $length) + $status = $z->read($buffer, $length, $offset) + + $status = read($z, $buffer, $length) + $status = read($z, $buffer, $length, $offset) + +Attempt to read C<$length> bytes of uncompressed data into C<$buffer>. + +The main difference between this form of the C method and the +previous one, is that this one will attempt to return I C<$length> +bytes. The only circumstances that this function will not is if end-of-file +or an IO error is encountered. + +Returns the number of uncompressed bytes written to C<$buffer>, zero if eof +or a negative number on error. + + +=head2 getline + +Usage is + + $line = $z->getline() + $line = <$z> + +Reads a single line. + +This method fully supports the use of of the variable C<$/> +(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Both paragraph mode and file +slurp mode are supported. + + +=head2 getc + +Usage is + + $char = $z->getc() + +Read a single character. + +=head2 ungetc + +Usage is + + $char = $z->ungetc($string) + + + +=head2 inflateSync + +Usage is + + $status = $z->inflateSync() + +TODO + + +=head2 getHeaderInfo + +Usage is + + $hdr = $z->getHeaderInfo(); + @hdrs = $z->getHeaderInfo(); + +This method returns either a hash reference (in scalar context) or a list +or hash references (in array context) that contains information about each +of the header fields in the compressed data stream(s). + + + + +=head2 tell + +Usage is + + $z->tell() + tell $z + +Returns the uncompressed file offset. + +=head2 eof + +Usage is + + $z->eof(); + eof($z); + + + +Returns true if the end of the compressed input stream has been reached. + + + +=head2 seek + + $z->seek($position, $whence); + seek($z, $position, $whence); + + + + +Provides a sub-set of the C functionality, with the restriction +that it is only legal to seek forward in the input file/buffer. +It is a fatal error to attempt to seek backward. + + + +The C<$whence> parameter takes one the usual values, namely SEEK_SET, +SEEK_CUR or SEEK_END. + +Returns 1 on success, 0 on failure. + +=head2 binmode + +Usage is + + $z->binmode + binmode $z ; + +This is a noop provided for completeness. + +=head2 opened + + $z->opened() + +Returns true if the object currently refers to a opened file/buffer. + +=head2 autoflush + + my $prev = $z->autoflush() + my $prev = $z->autoflush(EXPR) + +If the C<$z> object is associated with a file or a filehandle, this method +returns the current autoflush setting for the underlying filehandle. If +C is present, and is non-zero, it will enable flushing after every +write/print operation. + +If C<$z> is associated with a buffer, this method has no effect and always +returns C. + +B that the special variable C<$|> B be used to set or +retrieve the autoflush setting. + +=head2 input_line_number + + $z->input_line_number() + $z->input_line_number(EXPR) + + + +Returns the current uncompressed line number. If C is present it has +the effect of setting the line number. Note that setting the line number +does not change the current position within the file/buffer being read. + +The contents of C<$/> are used to to determine what constitutes a line +terminator. + + + +=head2 fileno + + $z->fileno() + fileno($z) + +If the C<$z> object is associated with a file or a filehandle, this method +will return the underlying file descriptor. + +If the C<$z> object is is associated with a buffer, this method will +return undef. + +=head2 close + + $z->close() ; + close $z ; + + + +Closes the output file/buffer. + + + +For most versions of Perl this method will be automatically invoked if +the IO::Uncompress::Unzip object is destroyed (either explicitly or by the +variable with the reference to the object going out of scope). The +exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In +these cases, the C method will be called automatically, but +not until global destruction of all live objects when the program is +terminating. + +Therefore, if you want your scripts to be able to run on all versions +of Perl, you should call C explicitly and not rely on automatic +closing. + +Returns true on success, otherwise 0. + +If the C option has been enabled when the IO::Uncompress::Unzip +object was created, and the object is associated with a file, the +underlying file will also be closed. + + + + +=head1 Importing + +No symbolic constants are required by this IO::Uncompress::Unzip at present. + +=over 5 + +=item :all + +Imports C and C<$UnzipError>. +Same as doing this + + use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + +=back + +=head1 EXAMPLES + + + + +=head1 SEE ALSO + +L, L, L, L, L, L, L, L, L, L, L, L, L + +L + +L, L, +L, +L + + +For RFC 1950, 1951 and 1952 see +F, +F and +F + +The I compression library was written by Jean-loup Gailly +F and Mark Adler F. + +The primary site for the I compression library is +F. + +The primary site for gzip is F. + + + + + + + +=head1 AUTHOR + +The I module was written by Paul Marquess, +F. + + + +=head1 MODIFICATION HISTORY + +See the Changes file. + +=head1 COPYRIGHT AND LICENSE + + +Copyright (c) 2005-2006 Paul Marquess. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + diff --git a/ext/Compress/Zlib/Zlib.pm b/ext/Compress/Zlib/Zlib.pm deleted file mode 100644 index 34e57e7..0000000 --- a/ext/Compress/Zlib/Zlib.pm +++ /dev/null @@ -1,2245 +0,0 @@ - -package Compress::Zlib; - -require 5.004 ; -require Exporter; -use AutoLoader; -use Carp ; -use IO::Handle ; -use Scalar::Util qw(dualvar); - -use Compress::Zlib::Common ; -use Compress::Zlib::ParseParameters; - -use strict ; -use warnings ; -use bytes ; -our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); - -$VERSION = '2.000_07'; -$XS_VERSION = $VERSION; -$VERSION = eval $VERSION; - -@ISA = qw(Exporter); -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. -@EXPORT = qw( - deflateInit inflateInit - - compress uncompress - - gzopen $gzerrno - - adler32 crc32 - - ZLIB_VERSION - ZLIB_VERNUM - - DEF_WBITS - OS_CODE - - MAX_MEM_LEVEL - MAX_WBITS - - Z_ASCII - Z_BEST_COMPRESSION - Z_BEST_SPEED - Z_BINARY - Z_BLOCK - Z_BUF_ERROR - Z_DATA_ERROR - Z_DEFAULT_COMPRESSION - Z_DEFAULT_STRATEGY - Z_DEFLATED - Z_ERRNO - Z_FILTERED - Z_FIXED - Z_FINISH - Z_FULL_FLUSH - Z_HUFFMAN_ONLY - Z_MEM_ERROR - Z_NEED_DICT - Z_NO_COMPRESSION - Z_NO_FLUSH - Z_NULL - Z_OK - Z_PARTIAL_FLUSH - Z_RLE - Z_STREAM_END - Z_STREAM_ERROR - Z_SYNC_FLUSH - Z_UNKNOWN - Z_VERSION_ERROR -); - - -sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - my ($error, $val) = constant($constname); - Carp::croak $error if $error; - no strict 'refs'; - *{$AUTOLOAD} = sub { $val }; - goto &{$AUTOLOAD}; -} - -use constant FLAG_APPEND => 1 ; -use constant FLAG_CRC => 2 ; -use constant FLAG_ADLER => 4 ; -use constant FLAG_CONSUME_INPUT => 8 ; - -eval { - require XSLoader; - XSLoader::load('Compress::Zlib', $XS_VERSION); - 1; -} -or do { - require DynaLoader; - local @ISA = qw(DynaLoader); - bootstrap Compress::Zlib $XS_VERSION ; -}; - -# Preloaded methods go here. - -require IO::Compress::Gzip; -require IO::Uncompress::Gunzip; - -our (@my_z_errmsg); - -@my_z_errmsg = ( - "need dictionary", # Z_NEED_DICT 2 - "stream end", # Z_STREAM_END 1 - "", # Z_OK 0 - "file error", # Z_ERRNO (-1) - "stream error", # Z_STREAM_ERROR (-2) - "data error", # Z_DATA_ERROR (-3) - "insufficient memory", # Z_MEM_ERROR (-4) - "buffer error", # Z_BUF_ERROR (-5) - "incompatible version",# Z_VERSION_ERROR(-6) - ); - - -sub _set_gzerr -{ - my $value = shift ; - - if ($value == 0) { - $Compress::Zlib::gzerrno = 0 ; - } - elsif ($value == Z_ERRNO() || $value > 2) { - $Compress::Zlib::gzerrno = $! ; - } - else { - $Compress::Zlib::gzerrno = dualvar($value+0, $my_z_errmsg[2 - $value]); - } - - return $value ; -} - -sub _save_gzerr -{ - my $gz = shift ; - my $test_eof = shift ; - - my $value = $gz->errorNo() || 0 ; - - if ($test_eof) { - #my $gz = $self->[0] ; - # gzread uses Z_STREAM_END to denote a successful end - $value = Z_STREAM_END() if $gz->eof() && $value == 0 ; - } - - _set_gzerr($value) ; -} - -sub gzopen($$) -{ - my ($file, $mode) = @_ ; - - my $gz ; - my %defOpts = (Level => Z_DEFAULT_COMPRESSION(), - Strategy => Z_DEFAULT_STRATEGY(), - ); - - my $writing ; - $writing = ! ($mode =~ /r/i) ; - $writing = ($mode =~ /[wa]/i) ; - - $defOpts{Level} = $1 if $mode =~ /(\d)/; - $defOpts{Strategy} = Z_FILTERED() if $mode =~ /f/i; - $defOpts{Strategy} = Z_HUFFMAN_ONLY() if $mode =~ /h/i; - - my $infDef = $writing ? 'deflate' : 'inflate'; - my @params = () ; - - croak "gzopen: file parameter is not a filehandle or filename" - unless isaFilehandle $file || isaFilename $file ; - - return undef unless $mode =~ /[rwa]/i ; - - _set_gzerr(0) ; - - if ($writing) { - $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, - %defOpts) - or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; - } - else { - $gz = new IO::Uncompress::Gunzip($file, - Transparent => 1, - Append => 0, - AutoClose => 1, - Strict => 0) - or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; - } - - return undef - if ! defined $gz ; - - bless [$gz, $infDef], 'Compress::Zlib::gzFile'; -} - -sub Compress::Zlib::gzFile::gzread -{ - my $self = shift ; - - return _set_gzerr(Z_STREAM_ERROR()) - if $self->[1] ne 'inflate'; - - return 0 if $self->gzeof(); - - my $gz = $self->[0] ; - my $status = $gz->read($_[0], defined $_[1] ? $_[1] : 4096) ; - $_[0] = "" if ! defined $_[0] ; - _save_gzerr($gz, 1); - return $status ; -} - -sub Compress::Zlib::gzFile::gzreadline -{ - my $self = shift ; - - my $gz = $self->[0] ; - $_[0] = $gz->getline() ; - _save_gzerr($gz, 1); - return defined $_[0] ? length $_[0] : 0 ; -} - -sub Compress::Zlib::gzFile::gzwrite -{ - my $self = shift ; - my $gz = $self->[0] ; - - return _set_gzerr(Z_STREAM_ERROR()) - if $self->[1] ne 'deflate'; - - my $status = $gz->write($_[0]) ; - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gztell -{ - my $self = shift ; - my $gz = $self->[0] ; - my $status = $gz->tell() ; - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gzseek -{ - my $self = shift ; - my $offset = shift ; - my $whence = shift ; - - my $gz = $self->[0] ; - my $status ; - eval { $status = $gz->seek($offset, $whence) ; }; - if ($@) - { - my $error = $@; - $error =~ s/^.*: /gzseek: /; - $error =~ s/ at .* line \d+\s*$//; - croak $error; - } - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gzflush -{ - my $self = shift ; - my $f = shift ; - - my $gz = $self->[0] ; - my $status = $gz->flush($f) ; - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gzclose -{ - my $self = shift ; - my $gz = $self->[0] ; - - my $status = $gz->close() ; - _save_gzerr($gz); - return ! $status ; -} - -sub Compress::Zlib::gzFile::gzeof -{ - my $self = shift ; - my $gz = $self->[0] ; - - return 0 - if $self->[1] ne 'inflate'; - - my $status = $gz->eof() ; - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gzsetparams -{ - my $self = shift ; - croak "Usage: Compress::Zlib::gzFile::gzsetparams(file, level, strategy)" - unless @_ eq 2 ; - - my $gz = $self->[0] ; - my $level = shift ; - my $strategy = shift; - - return _set_gzerr(Z_STREAM_ERROR()) - if $self->[1] ne 'deflate'; - - my $status = *$gz->{Compress}->deflateParams(-Level => $level, - -Strategy => $strategy); - _save_gzerr($gz); - return $status ; -} - -sub Compress::Zlib::gzFile::gzerror -{ - my $self = shift ; - my $gz = $self->[0] ; - - return $Compress::Zlib::gzerrno ; -} - -sub Compress::Zlib::Deflate::new -{ - my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'AppendOutput' => [1, 1, Parse_boolean, 0], - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - - - croak "Compress::Zlib::Deflate::new: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $flags = 0 ; - $flags |= FLAG_APPEND if $got->value('AppendOutput') ; - $flags |= FLAG_CRC if $got->value('CRC32') ; - $flags |= FLAG_ADLER if $got->value('ADLER32') ; - - _deflateInit($flags, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; - -} - -sub Compress::Zlib::Inflate::new -{ - my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'AppendOutput' => [1, 1, Parse_boolean, 0], - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'ConsumeInput' => [1, 1, Parse_boolean, 1], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - - - croak "Compress::Zlib::Inflate::new: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $flags = 0 ; - $flags |= FLAG_APPEND if $got->value('AppendOutput') ; - $flags |= FLAG_CRC if $got->value('CRC32') ; - $flags |= FLAG_ADLER if $got->value('ADLER32') ; - $flags |= FLAG_CONSUME_INPUT if $got->value('ConsumeInput') ; - - _inflateInit($flags, $got->value('WindowBits'), $got->value('Bufsize'), - $got->value('Dictionary')) ; -} - -sub Compress::Zlib::InflateScan::new -{ - my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'WindowBits' => [1, 1, Parse_signed, -MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - - - croak "Compress::Zlib::InflateScan::new: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $flags = 0 ; - #$flags |= FLAG_APPEND if $got->value('AppendOutput') ; - $flags |= FLAG_CRC if $got->value('CRC32') ; - $flags |= FLAG_ADLER if $got->value('ADLER32') ; - #$flags |= FLAG_CONSUME_INPUT if $got->value('ConsumeInput') ; - - _inflateScanInit($flags, $got->value('WindowBits'), $got->value('Bufsize'), - '') ; -} - -sub Compress::Zlib::inflateScanStream::createDeflateStream -{ - my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'AppendOutput' => [1, 1, Parse_boolean, 0], - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, - MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - }, @_) ; - - croak "Compress::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $flags = 0 ; - $flags |= FLAG_APPEND if $got->value('AppendOutput') ; - $flags |= FLAG_CRC if $got->value('CRC32') ; - $flags |= FLAG_ADLER if $got->value('ADLER32') ; - - $pkg->_createDeflateStream($flags, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), - $got->value('Bufsize'), - ) ; - -} - -sub Compress::Zlib::inflateScanStream::inflate -{ - my $self = shift ; - my $buffer = $_[1]; - my $eof = $_[2]; - - my $status = $self->scan(@_); - - if ($status == Z_OK() && $_[2]) { - my $byte = ' '; - - $status = $self->scan(\$byte, $_[1]) ; - } - - return $status ; -} - -sub Compress::Zlib::deflateStream::deflateParams -{ - my $self = shift ; - my ($got) = ParseParameters(0, { - 'Level' => [1, 1, Parse_signed, undef], - 'Strategy' => [1, 1, Parse_unsigned, undef], - 'Bufsize' => [1, 1, Parse_unsigned, undef], - }, - @_) ; - - croak "Compress::Zlib::deflateParams needs Level and/or Strategy" - unless $got->parsed('Level') + $got->parsed('Strategy') + - $got->parsed('Bufsize'); - - croak "Compress::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - if $got->parsed('Bufsize') && $got->value('Bufsize') <= 1; - - my $flags = 0; - $flags |= 1 if $got->parsed('Level') ; - $flags |= 2 if $got->parsed('Strategy') ; - $flags |= 4 if $got->parsed('Bufsize') ; - - $self->_deflateParams($flags, $got->value('Level'), - $got->value('Strategy'), $got->value('Bufsize')); - -} - -sub compress($;$) -{ - my ($x, $output, $err, $in) =('', '', '', '') ; - - if (ref $_[0] ) { - $in = $_[0] ; - croak "not a scalar reference" unless ref $in eq 'SCALAR' ; - } - else { - $in = \$_[0] ; - } - - my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); - - $x = new Compress::Zlib::Deflate -AppendOutput => 1, -Level => $level - or return undef ; - - $err = $x->deflate($in, $output) ; - return undef unless $err == Z_OK() ; - - $err = $x->flush($output) ; - return undef unless $err == Z_OK() ; - - return $output ; - -} - -sub uncompress($) -{ - my ($x, $output, $err, $in) =('', '', '', '') ; - - if (ref $_[0] ) { - $in = $_[0] ; - croak "not a scalar reference" unless ref $in eq 'SCALAR' ; - } - else { - $in = \$_[0] ; - } - - $x = new Compress::Zlib::Inflate -ConsumeInput => 0 or return undef ; - - $err = $x->inflate($in, $output) ; - return undef unless $err == Z_STREAM_END() ; - - return $output ; -} - - -### This stuff is for backward compat. with Compress::Zlib 1.x - - -sub deflateInit(@) -{ - my ($got) = ParseParameters(0, - { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_ ) ; - - croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $obj ; - - my $status = 0 ; - ($obj, $status) = - _deflateInit(0, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; - - my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; - return wantarray ? ($x, $status) : $x ; -} - -sub inflateInit(@) -{ - my ($got) = ParseParameters(0, - { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - - - croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; - - my $status = 0 ; - my $obj ; - ($obj, $status) = _inflateInit(FLAG_CONSUME_INPUT, - $got->value('WindowBits'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; - - my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; - - wantarray ? ($x, $status) : $x ; -} - -package Zlib::OldDeflate ; - -our (@ISA); -@ISA = qw(Compress::Zlib::deflateStream); - - -sub deflate -{ - my $self = shift ; - my $output ; - - my $status = $self->SUPER::deflate($_[0], $output) ; - wantarray ? ($output, $status) : $output ; -} - -sub flush -{ - my $self = shift ; - my $output ; - my $flag = shift || Compress::Zlib::Z_FINISH(); - my $status = $self->SUPER::flush($output, $flag) ; - - wantarray ? ($output, $status) : $output ; -} - -package Zlib::OldInflate ; - -our (@ISA); -@ISA = qw(Compress::Zlib::inflateStream); - -sub inflate -{ - my $self = shift ; - my $output ; - my $status = $self->SUPER::inflate($_[0], $output) ; - wantarray ? ($output, $status) : $output ; -} - -package Compress::Zlib ; - -use Compress::Gzip::Constants; - -sub memGzip($) -{ - my $x = new Compress::Zlib::Deflate( - -AppendOutput => 1, - -CRC32 => 1, - -ADLER32 => 0, - -Level => Z_BEST_COMPRESSION(), - -WindowBits => - MAX_WBITS(), - ) - or return undef ; - - # write a minimal gzip header - my $output = GZIP_MINIMUM_HEADER ; - - # if the deflation buffer isn't a reference, make it one - my $string = (ref $_[0] ? $_[0] : \$_[0]) ; - - my $status = $x->deflate($string, \$output) ; - $status == Z_OK() - or return undef ; - - $status = $x->flush(\$output) ; - $status == Z_OK() - or return undef ; - - return $output . pack("V V", $x->crc32(), $x->total_in()) ; - -} - - -sub _removeGzipHeader($) -{ - my $string = shift ; - - return Z_DATA_ERROR() - if length($$string) < GZIP_MIN_HEADER_SIZE ; - - my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = - unpack ('CCCCVCC', $$string); - - return Z_DATA_ERROR() - unless $magic1 == GZIP_ID1 and $magic2 == GZIP_ID2 and - $method == Z_DEFLATED() and !($flags & GZIP_FLG_RESERVED) ; - substr($$string, 0, GZIP_MIN_HEADER_SIZE) = '' ; - - # skip extra field - if ($flags & GZIP_FLG_FEXTRA) - { - return Z_DATA_ERROR() - if length($$string) < GZIP_FEXTRA_HEADER_SIZE ; - - my ($extra_len) = unpack ('v', $$string); - $extra_len += GZIP_FEXTRA_HEADER_SIZE; - return Z_DATA_ERROR() - if length($$string) < $extra_len ; - - substr($$string, 0, $extra_len) = ''; - } - - # skip orig name - if ($flags & GZIP_FLG_FNAME) - { - my $name_end = index ($$string, GZIP_NULL_BYTE); - return Z_DATA_ERROR() - if $name_end == -1 ; - substr($$string, 0, $name_end + 1) = ''; - } - - # skip comment - if ($flags & GZIP_FLG_FCOMMENT) - { - my $comment_end = index ($$string, GZIP_NULL_BYTE); - return Z_DATA_ERROR() - if $comment_end == -1 ; - substr($$string, 0, $comment_end + 1) = ''; - } - - # skip header crc - if ($flags & GZIP_FLG_FHCRC) - { - return Z_DATA_ERROR() - if length ($$string) < GZIP_FHCRC_SIZE ; - substr($$string, 0, GZIP_FHCRC_SIZE) = ''; - } - - return Z_OK(); -} - - -sub memGunzip($) -{ - # if the buffer isn't a reference, make it one - my $string = (ref $_[0] ? $_[0] : \$_[0]); - - _removeGzipHeader($string) == Z_OK() - or return undef; - - my $bufsize = length $$string > 4096 ? length $$string : 4096 ; - my $x = new Compress::Zlib::Inflate({-WindowBits => - MAX_WBITS(), - -Bufsize => $bufsize}) - - or return undef; - - my $output = "" ; - my $status = $x->inflate($string, $output); - return undef - unless $status == Z_STREAM_END(); - - if (length $$string >= 8) - { - my ($crc, $len) = unpack ("VV", substr($$string, 0, 8)); - substr($$string, 0, 8) = ''; - return undef - unless $len == length($output) and - $crc == crc32($output); - } - else - { - $$string = ''; - } - return $output; -} - -# Autoload methods go after __END__, and are processed by the autosplit program. - -1; -__END__ - - -=head1 NAME - -Compress::Zlib - Interface to zlib compression library - -=head1 SYNOPSIS - - use Compress::Zlib 2 ; - - ($d, $status) = new Compress::Zlib::Deflate( [OPT] ) ; - $status = $d->deflate($input, $output) ; - $status = $d->flush($output [, $flush_type]) ; - $d->deflateParams(OPTS) ; - $d->deflateTune(OPTS) ; - $d->dict_adler() ; - $d->crc32() ; - $d->adler32() ; - $d->total_in() ; - $d->total_out() ; - $d->msg() ; - $d->get_Strategy(); - $d->get_Level(); - $d->get_BufSize(); - - ($i, $status) = new Compress::Zlib::Inflate( [OPT] ) ; - $status = $i->inflate($input, $output [, $eof]) ; - $status = $i->inflateSync($input) ; - $i->dict_adler() ; - $d->crc32() ; - $d->adler32() ; - $i->total_in() ; - $i->total_out() ; - $i->msg() ; - $d->get_BufSize(); - - $dest = compress($source) ; - $dest = uncompress($source) ; - - $gz = gzopen($filename or filehandle, $mode) ; - $bytesread = $gz->gzread($buffer [,$size]) ; - $bytesread = $gz->gzreadline($line) ; - $byteswritten = $gz->gzwrite($buffer) ; - $status = $gz->gzflush($flush) ; - $offset = $gz->gztell() ; - $status = $gz->gzseek($offset, $whence) ; - $status = $gz->gzclose() ; - $status = $gz->gzeof() ; - $status = $gz->gzsetparams($level, $strategy) ; - $errstring = $gz->gzerror() ; - $gzerrno - - $dest = Compress::Zlib::memGzip($buffer) ; - $dest = Compress::Zlib::memGunzip($buffer) ; - - $crc = adler32($buffer [,$crc]) ; - $crc = crc32($buffer [,$crc]) ; - - $crc = adler32_combine($crc1, $crc2, $len2)l - $crc = crc32_combine($adler1, $adler2, $len2) - - ZLIB_VERSION - ZLIB_VERNUM - - # Compress::Zlib 1.x legacy interface - - ($d, $status) = deflateInit( [OPT] ) ; - ($out, $status) = $d->deflate($buffer) ; - $status = $d->deflateParams([OPT]) ; - ($out, $status) = $d->flush() ; - $d->dict_adler() ; - $d->total_in() ; - $d->total_out() ; - $d->msg() ; - - ($i, $status) = inflateInit( [OPT] ) ; - ($out, $status) = $i->inflate($buffer) ; - $status = $i->inflateSync($buffer) ; - $i->dict_adler() ; - $i->total_in() ; - $i->total_out() ; - $i->msg() ; - - -=head1 DESCRIPTION - -The I module provides a Perl interface to the I -compression library (see L for details about where to get -I). -The I library allows reading and writing of -compressed data streams that conform to RFC1950, RFC1951 and RFC1952 -(aka gzip). -Most of the I functionality is available in I. - -Unless you are working with legacy code, or you need to work directly -with the low-level zlib interface, it is recommended that applications -use one of the newer C interfaces provided with this module. - -The C module can be split into two general areas of -functionality, namely a low-level in-memory compression/decompression -interface and a simple read/write interface to I files. - -Each of these areas will be discussed separately below. - - -=head1 GZIP INTERFACE - -A number of functions are supplied in I for reading and writing -I files that conform to RFC1952. This module provides an interface -to most of them. - -If you are upgrading from C 1.x, the following enhancements -have been made to the C interface: - -=over 5 - -=item 1 - -If you want to to open either STDIN or STDOUT with C, you can now -optionally use the special filename "C<->" as a synonym for C<\*STDIN> and -C<\*STDOUT>. - -=item 2 - -In C version 1.x, C used the zlib library to open the -underlying file. This made things especially tricky when a Perl filehandle was -passed to C. Behind the scenes the numeric C file descriptor had to be -extracted from the Perl filehandle and this passed to the zlib library. - -Apart from being non-portable to some operating systems, this made it difficult -to use C in situations where you wanted to extract/create a gzip data -stream that is embedded in a larger file, without having to resort to opening -and closing the file multiple times. - -In C version 2.x, the C interface has been completely -rewritten to use the L for writing gzip files and -L for reading gzip files. - -=item 3 - -Addition of C to provide a restricted C interface. - -=item 4. - -Added C. - -=back - -A more complete and flexible interface for reading/writing gzip -files/buffers is included with this module. See L and -L for more details. - -=over 5 - -=item B<$gz = gzopen($filename, $mode)> - -=item B<$gz = gzopen($filehandle, $mode)> - -This function opens either the I file C<$filename> for reading or -writing or attaches to the opened filehandle, C<$filehandle>. -It returns an object on success and C on failure. - -When writing a gzip file this interface will always create the smallest -possible gzip header (exactly 10 bytes). If you want greater control over -the information stored in the gzip header (like the original filename or a -comment) use L instead. - -The second parameter, C<$mode>, is used to specify whether the file is -opened for reading or writing and to optionally specify a compression -level and compression strategy when writing. The format of the C<$mode> -parameter is similar to the mode parameter to the 'C' function C, -so "rb" is used to open for reading and "wb" for writing. - -To specify a compression level when writing, append a digit between 0 -and 9 to the mode string -- 0 means no compression and 9 means maximum -compression. -If no compression level is specified Z_DEFAULT_COMPRESSION is used. - -To specify the compression strategy when writing, append 'f' for filtered -data, 'h' for Huffman only compression, or 'R' for run-length encoding. -If no strategy is specified Z_DEFAULT_STRATEGY is used. - -So, for example, "wb9" means open for writing with the maximum compression -using the default strategy and "wb4R" means open for writing with compression -level 4 and run-length encoding. - -Refer to the I documentation for the exact format of the C<$mode> -parameter. - - -=item B<$bytesread = $gz-Egzread($buffer [, $size]) ;> - -Reads C<$size> bytes from the compressed file into C<$buffer>. If -C<$size> is not specified, it will default to 4096. If the scalar -C<$buffer> is not large enough, it will be extended automatically. - -Returns the number of bytes actually read. On EOF it returns 0 and in -the case of an error, -1. - -=item B<$bytesread = $gz-Egzreadline($line) ;> - -Reads the next line from the compressed file into C<$line>. - -Returns the number of bytes actually read. On EOF it returns 0 and in -the case of an error, -1. - -It is legal to intermix calls to C and C. - -In addition, C fully supports the use of of the variable C<$/> -(C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. - - -=item B<$byteswritten = $gz-Egzwrite($buffer) ;> - -Writes the contents of C<$buffer> to the compressed file. Returns the -number of bytes actually written, or 0 on error. - -=item B<$status = $gz-Egzflush($flush_type) ;> - -Flushes all pending output into the compressed file. - -This method takes an optional parameter, C<$flush_type>, that controls -how the flushing will be carried out. By default the C<$flush_type> -used is C. Other valid values for C<$flush_type> are -C, C, C and C. It is -strongly recommended that you only set the C parameter if -you fully understand the implications of what it does - overuse of C -can seriously degrade the level of compression achieved. See the C -documentation for details. - -Returns 1 on success, 0 on failure. - - -=item B<$offset = $gz-Egztell() ;> - -Returns the uncompressed file offset. - -=item B<$status = $gz-Egzseek($offset, $whence) ;> - -Provides a sub-set of the C functionality, with the restriction -that it is only legal to seek forward in the compressed file. -It is a fatal error to attempt to seek backward. - -When opened for writing, empty parts of the file will have NULL (0x00) -bytes written to them. - -The C<$whence> parameter should be one of SEEK_SET, SEEK_CUR or SEEK_END. - -Returns 1 on success, 0 on failure. - -=item B<$gz-Egzclose> - -Closes the compressed file. Any pending data is flushed to the file -before it is closed. - -Returns 1 on success, 0 on failure. - -=item B<$gz-Egzsetparams($level, $strategy> - -Change settings for the deflate stream C<$gz>. - -The list of the valid options is shown below. Options not specified -will remain unchanged. - -Note: This method is only available if you are running zlib 1.0.6 or better. - -=over 5 - -=item B<$level> - -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. - -=item B<$strategy> - -Defines the strategy used to tune the compression. The valid values are -C, C and C. - -=back - -=item B<$gz-Egzerror> - -Returns the I error message or number for the last operation -associated with C<$gz>. The return value will be the I error -number when used in a numeric context and the I error message -when used in a string context. The I error number constants, -shown below, are available for use. - - Z_OK - Z_STREAM_END - Z_ERRNO - Z_STREAM_ERROR - Z_DATA_ERROR - Z_MEM_ERROR - Z_BUF_ERROR - -=item B<$gzerrno> - -The C<$gzerrno> scalar holds the error code associated with the most -recent I routine. Note that unlike C, the error is -I associated with a particular file. - -As with C it returns an error number in numeric context and -an error message in string context. Unlike C though, the -error message will correspond to the I message when the error is -associated with I itself, or the UNIX error message when it is -not (i.e. I returned C). - -As there is an overlap between the error numbers used by I and -UNIX, C<$gzerrno> should only be used to check for the presence of -I error in numeric context. Use C to check for specific -I errors. The I example below shows how the variable can -be used safely. - -=back - - -=head2 Examples - -Here is an example script which uses the interface. It implements a -I function. - - use strict ; - use warnings ; - - use Compress::Zlib ; - - # use stdin if no files supplied - @ARGV = '-' unless @ARGV ; - - foreach my $file (@ARGV) { - my $buffer ; - - my $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; - - print $buffer while $gz->gzread($buffer) > 0 ; - - die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n" - if $gzerrno != Z_STREAM_END ; - - $gz->gzclose() ; - } - -Below is a script which makes use of C. It implements a -very simple I like script. - - use strict ; - use warnings ; - - use Compress::Zlib ; - - die "Usage: gzgrep pattern [file...]\n" - unless @ARGV >= 1; - - my $pattern = shift ; - - # use stdin if no files supplied - @ARGV = '-' unless @ARGV ; - - foreach my $file (@ARGV) { - my $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; - - while ($gz->gzreadline($_) > 0) { - print if /$pattern/ ; - } - - die "Error reading from $file: $gzerrno\n" - if $gzerrno != Z_STREAM_END ; - - $gz->gzclose() ; - } - -This script, I, does the opposite of the I script -above. It reads from standard input and writes a gzip data stream to -standard output. - - use strict ; - use warnings ; - - use Compress::Zlib ; - - binmode STDOUT; # gzopen only sets it on the fd - - my $gz = gzopen(\*STDOUT, "wb") - or die "Cannot open stdout: $gzerrno\n" ; - - while (<>) { - $gz->gzwrite($_) - or die "error writing: $gzerrno\n" ; - } - - $gz->gzclose ; - -=head2 Compress::Zlib::memGzip - -This function is used to create an in-memory gzip file with the minimum -possible gzip header (exactly 10 bytes). - - $dest = Compress::Zlib::memGzip($buffer) ; - -If successful, it returns the in-memory gzip file, otherwise it returns -undef. - -The C<$buffer> parameter can either be a scalar or a scalar reference. - -See L for an alternative way to carry out in-memory gzip -compression. - -=head2 Compress::Zlib::memGunzip - -This function is used to uncompress an in-memory gzip file. - - $dest = Compress::Zlib::memGunzip($buffer) ; - -If successful, it returns the uncompressed gzip file, otherwise it -returns undef. - -The C<$buffer> parameter can either be a scalar or a scalar reference. The -contents of the C<$buffer> parameter are destroyed after calling this function. - -See L for an alternative way to carry out in-memory gzip -uncompression. - -=head1 COMPRESS/UNCOMPRESS - -Two functions are provided to perform in-memory compression/uncompression of -RFC 1950 data streams. They are called C and C. - -=over 5 - -=item B<$dest = compress($source [, $level] ) ;> - -Compresses C<$source>. If successful it returns the compressed -data. Otherwise it returns I. - -The source buffer, C<$source>, can either be a scalar or a scalar -reference. - -The C<$level> parameter defines the compression level. Valid values are -0 through 9, C, C, -C, and C. -If C<$level> is not specified C will be used. - - -=item B<$dest = uncompress($source) ;> - -Uncompresses C<$source>. If successful it returns the uncompressed -data. Otherwise it returns I. - -The source buffer can either be a scalar or a scalar reference. - -=back - -Please note: the two functions defined above are I compatible with -the Unix commands of the same name. - -See L and L included with -this distribution for an alternative interface for reading/writing RFC 1950 -files/buffers. - -=head1 CHECKSUM FUNCTIONS - -Two functions are provided by I to calculate checksums. For the -Perl interface, the order of the two parameters in both functions has -been reversed. This allows both running checksums and one off -calculations to be done. - - $crc = adler32($buffer [,$crc]) ; - $crc = crc32($buffer [,$crc]) ; - -The buffer parameters can either be a scalar or a scalar reference. - -If the $crc parameters is C, the crc value will be reset. - -If you have built this module with zlib 1.2.3 or better, two more -CRC-related functions are available. - - $crc = adler32_combine($crc1, $crc2, $len2)l - $crc = crc32_combine($adler1, $adler2, $len2) - -These functions allow checksums to be merged. - -=head1 Compress::Zlib::Deflate - -This section defines an interface that allows in-memory compression using -the I interface provided by zlib. - -Note: The interface defined in this section is different from version -1.x of this module. The original deflate interface is still available -for backward compatibility and is documented in the section -L. - -Here is a definition of the interface available: - - -=head2 B<($d, $status) = new Compress::Zlib::Deflate( [OPT] ) > - -Initialises a deflation object. - -If you are familiar with the I library, it combines the -features of the I functions C, C -and C. - -If successful, it will return the initialised deflation object, C<$d> -and a C<$status> of C in a list context. In scalar context it -returns the deflation object, C<$d>, only. - -If not successful, the returned deflation object, C<$d>, will be -I and C<$status> will hold the a I error code. - -The function optionally takes a number of named options specified as -C<-Name =E value> pairs. This allows individual options to be -tailored without having to specify them all in the parameter list. - -For backward compatibility, it is also possible to pass the parameters -as a reference to a hash containing the name=>value pairs. - -Below is a list of the valid options: - -=over 5 - -=item B<-Level> - -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. - -The default is C<-Level =E Z_DEFAULT_COMPRESSION>. - -=item B<-Method> - -Defines the compression method. The only valid value at present (and -the default) is C<-Method =E Z_DEFLATED>. - -=item B<-WindowBits> - -For a definition of the meaning and valid values for C -refer to the I documentation for I. - -Defaults to C<-WindowBits =E MAX_WBITS>. - -=item B<-MemLevel> - -For a definition of the meaning and valid values for C -refer to the I documentation for I. - -Defaults to C<-MemLevel =E MAX_MEM_LEVEL>. - -=item B<-Strategy> - -Defines the strategy used to tune the compression. The valid values are -C, C, C, C and -C. - -The default is C<-Strategy =EZ_DEFAULT_STRATEGY>. - -=item B<-Dictionary> - -When a dictionary is specified I will automatically -call C directly after calling C. The -Adler32 value for the dictionary can be obtained by calling the method -C<$d-Edict_adler()>. - -The default is no dictionary. - -=item B<-Bufsize> - -Sets the initial size for the output buffer used by the C<$d-Edeflate> -and C<$d-Eflush> methods. If the buffer has to be -reallocated to increase the size, it will grow in increments of -C. - -The default buffer size is 4096. - -=item B<-AppendOutput> - -This option controls how data is written to the output buffer by the -C<$d-Edeflate> and C<$d-Eflush> methods. - -If the C option is set to false, the output buffers in the -C<$d-Edeflate> and C<$d-Eflush> methods will be truncated before -uncompressed data is written to them. - -If the option is set to true, uncompressed data will be appended to the -output buffer in the C<$d-Edeflate> and C<$d-Eflush> methods. - -This option defaults to false. - -=item B<-CRC32> - -If set to true, a crc32 checksum of the uncompressed data will be -calculated. Use the C<$d-Ecrc32> method to retrieve this value. - -This option defaults to false. - - -=item B<-ADLER32> - -If set to true, an adler32 checksum of the uncompressed data will be -calculated. Use the C<$d-Eadler32> method to retrieve this value. - -This option defaults to false. - - -=back - -Here is an example of using the C optional -parameter list to override the default buffer size and compression -level. All other options will take their default values. - - my $d = new Compress::Zlib::Deflate ( -Bufsize => 300, - -Level => Z_BEST_SPEED ) ; - - -=head2 B<$status = $d-Edeflate($input, $output)> - -Deflates the contents of C<$input> and writes the compressed data to -C<$output>. - -The C<$input> and C<$output> parameters can be either scalars or scalar -references. - -When finished, C<$input> will be completely processed (assuming there -were no errors). If the deflation was successful it writes the deflated -data to C<$output> and returns a status value of C. - -On error, it returns a I error code. - -If the C option is set to true in the constructor for -the C<$d> object, the compressed data will be appended to C<$output>. If -it is false, C<$output> will be truncated before any compressed data is -written to it. - -B: This method will not necessarily write compressed data to -C<$output> every time it is called. So do not assume that there has been -an error if the contents of C<$output> is empty on returning from -this method. As long as the return code from the method is C, -the deflate has succeeded. - -=head2 B<$status = $d-Eflush($output [, $flush_type]) > - -Typically used to finish the deflation. Any pending output will be -written to C<$output>. - -Returns C if successful. - -Note that flushing can seriously degrade the compression ratio, so it -should only be used to terminate a decompression (using C) or -when you want to create a I (using C). - -By default the C used is C. Other valid values -for C are C, C, C -and C. It is strongly recommended that you only set the -C parameter if you fully understand the implications of -what it does. See the C documentation for details. - -If the C option is set to true in the constructor for -the C<$d> object, the compressed data will be appended to C<$output>. If -it is false, C<$output> will be truncated before any compressed data is -written to it. - -=head2 B<$status = $d-EdeflateParams([OPT])> - -Change settings for the deflate object C<$d>. - -The list of the valid options is shown below. Options not specified -will remain unchanged. - - -=over 5 - -=item B<-Level> - -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. - -=item B<-Strategy> - -Defines the strategy used to tune the compression. The valid values are -C, C and C. - -=item B<-BufSize> - -Sets the initial size for the output buffer used by the C<$d-Edeflate> -and C<$d-Eflush> methods. If the buffer has to be -reallocated to increase the size, it will grow in increments of -C. - - -=back - -=head2 B<$status = $d-EdeflateTune($good_length, $max_lazy, $nice_length, $max_chain)> - -Tune the internal settings for the deflate object C<$d>. This option is -only available if you are running zlib 1.2.2.3 or better. - -Refer to the documentation in zlib.h for instructions on how to fly -C. - -=head2 B<$d-Edict_adler()> - -Returns the adler32 value for the dictionary. - -=head2 B<$d-Ecrc32()> - -Returns the crc32 value for the uncompressed data to date. - -If the C option is not enabled in the constructor for this object, -this method will always return 0; - -=head2 B<$d-Eadler32()> - -Returns the adler32 value for the uncompressed data to date. - -=head2 B<$d-Emsg()> - -Returns the last error message generated by zlib. - -=head2 B<$d-Etotal_in()> - -Returns the total number of bytes uncompressed bytes input to deflate. - -=head2 B<$d-Etotal_out()> - -Returns the total number of compressed bytes output from deflate. - -=head2 B<$d-Eget_Strategy()> - -Returns the deflation strategy currently used. Valid values are -C, C and C. - - -=head2 B<$d-Eget_Level()> - -Returns the compression level being used. - -=head2 B<$d-Eget_BufSize()> - -Returns the buffer size used to carry out the compression. - -=head2 Example - - -Here is a trivial example of using C. It simply reads standard -input, deflates it and writes it to standard output. - - use strict ; - use warnings ; - - use Compress::Zlib 2 ; - - binmode STDIN; - binmode STDOUT; - my $x = new Compress::Zlib::Deflate - or die "Cannot create a deflation stream\n" ; - - my ($output, $status) ; - while (<>) - { - $status = $x->deflate($_, $output) ; - - $status == Z_OK - or die "deflation failed\n" ; - - print $output ; - } - - $status = $x->flush($output) ; - - $status == Z_OK - or die "deflation failed\n" ; - - print $output ; - -=head1 Compress::Zlib::Inflate - -This section defines an interface that allows in-memory uncompression using -the I interface provided by zlib. - -Note: The interface defined in this section is different from version -1.x of this module. The original inflate interface is still available -for backward compatibility and is documented in the section -L. - -Here is a definition of the interface: - - -=head2 B< ($i, $status) = new Compress::Zlib::Inflate( [OPT] ) > - -Initialises an inflation object. - -In a list context it returns the inflation object, C<$i>, and the -I status code (C<$status>). In a scalar context it returns the -inflation object only. - -If successful, C<$i> will hold the inflation object and C<$status> will -be C. - -If not successful, C<$i> will be I and C<$status> will hold the -I error code. - -The function optionally takes a number of named options specified as -C<-Name =E value> pairs. This allows individual options to be -tailored without having to specify them all in the parameter list. - -For backward compatibility, it is also possible to pass the parameters -as a reference to a hash containing the name=Evalue pairs. - -Here is a list of the valid options: - -=over 5 - -=item B<-WindowBits> - -To uncompress an RFC1950 data stream, set C to a positive number. - -To uncompress an RFC1951 data stream, set C to C<-MAX_WBITS>. - -For a full definition of the meaning and valid values for C refer -to the I documentation for I. - -Defaults to C<-WindowBits =EMAX_WBITS>. - -=item B<-Bufsize> - -Sets the initial size for the output buffer used by the C<$i-Einflate> -method. If the output buffer in this method has to be reallocated to -increase the size, it will grow in increments of C. - -Default is 4096. - -=item B<-Dictionary> - -The default is no dictionary. - -=item B<-AppendOutput> - -This option controls how data is written to the output buffer by the -C<$i-Einflate> method. - -If the option is set to false, the output buffer in the C<$i-Einflate> -method will be truncated before uncompressed data is written to it. - -If the option is set to true, uncompressed data will be appended to the -output buffer by the C<$i-Einflate> method. - -This option defaults to false. - - -=item B<-CRC32> - -If set to true, a crc32 checksum of the uncompressed data will be -calculated. Use the C<$i-Ecrc32> method to retrieve this value. - -This option defaults to false. - -=item B<-ADLER32> - -If set to true, an adler32 checksum of the uncompressed data will be -calculated. Use the C<$i-Eadler32> method to retrieve this value. - -This option defaults to false. - -=item B<-ConsumeInput> - -If set to true, this option will remove compressed data from the input -buffer of the the C< $i-Einflate > method as the inflate progresses. - -This option can be useful when you are processing compressed data that is -embedded in another file/buffer. In this case the data that immediately -follows the compressed stream will be left in the input buffer. - -This option defaults to true. - -=back - -Here is an example of using an optional parameter to override the default -buffer size. - - my ($i, $status) = new Compress::Zlib::Inflate( -Bufsize => 300 ) ; - -=head2 B< $status = $i-Einflate($input, $output [,$eof]) > - -Inflates the complete contents of C<$input> and writes the uncompressed -data to C<$output>. The C<$input> and C<$output> parameters can either be -scalars or scalar references. - -Returns C if successful and C if the end of the -compressed data has been successfully reached. - -If not successful C<$status> will hold the I error code. - -If the C option has been set to true when the -C object is created, the C<$input> parameter -is modified by C. On completion it will contain what remains -of the input buffer after inflation. In practice, this means that when -the return status is C the C<$input> parameter will contain an -empty string, and when the return status is C the C<$input> -parameter will contains what (if anything) was stored in the input buffer -after the deflated data stream. - -This feature is useful when processing a file format that encapsulates -a compressed data stream (e.g. gzip, zip) and there is useful data -immediately after the deflation stream. - -If the C option is set to true in the constructor for -this object, the uncompressed data will be appended to C<$output>. If -it is false, C<$output> will be truncated before any uncompressed data -is written to it. - -The C<$eof> parameter needs a bit of explanation. - -Prior to version 1.2.0, zlib assumed that there was at least one trailing -byte immediately after the compressed data stream when it was carrying out -decompression. This normally isn't a problem because the majority of zlib -applications guarantee that there will be data directly after the -compressed data stream. For example, both gzip (RFC1950) and zip both -define trailing data that follows the compressed data stream. - -The C<$eof> parameter only needs to be used if B of the following -conditions apply - -=over 5 - -=item 1 - -You are either using a copy of zlib that is older than version 1.2.0 or you -want your application code to be able to run with as many different -versions of zlib as possible. - -=item 2 - -You have set the C parameter to C<-MAX_WBITS> in the constructor -for this object, i.e. you are uncompressing a raw deflated data stream -(RFC1951). - -=item 3 - -There is no data immediately after the compressed data stream. - -=back - -If B of these are the case, then you need to set the C<$eof> parameter to -true on the final call (and only the final call) to C<$i-Einflate>. - -If you have built this module with zlib >= 1.2.0, the C<$eof> parameter is -ignored. You can still set it if you want, but it won't be used behind the -scenes. - -=head2 B<$status = $i-EinflateSync($input)> - -This method can be used to attempt to recover good data from a compressed -data stream that is partially corrupt. -It scans C<$input> until it reaches either a I or the -end of the buffer. - -If a I is found, C is returned and C<$input> -will be have all data up to the flush point removed. This data can then be -passed to the C<$i-Einflate> method to be uncompressed. - -Any other return code means that a flush point was not found. If more -data is available, C can be called repeatedly with more -compressed data until the flush point is found. - -Note I are not present by default in compressed -data streams. They must have been added explicitly when the data stream -was created by calling C with C. - - -=head2 B<$i-Edict_adler()> - -Returns the adler32 value for the dictionary. - -=head2 B<$i-Ecrc32()> - -Returns the crc32 value for the uncompressed data to date. - -If the C option is not enabled in the constructor for this object, -this method will always return 0; - -=head2 B<$i-Eadler32()> - -Returns the adler32 value for the uncompressed data to date. - -If the C option is not enabled in the constructor for this object, -this method will always return 0; - -=head2 B<$i-Emsg()> - -Returns the last error message generated by zlib. - -=head2 B<$i-Etotal_in()> - -Returns the total number of bytes compressed bytes input to inflate. - -=head2 B<$i-Etotal_out()> - -Returns the total number of uncompressed bytes output from inflate. - -=head2 B<$d-Eget_BufSize()> - -Returns the buffer size used to carry out the decompression. - -=head2 Example - -Here is an example of using C. - - use strict ; - use warnings ; - - use Compress::Zlib 2 ; - - my $x = new Compress::Zlib::Inflate() - or die "Cannot create a inflation stream\n" ; - - my $input = '' ; - binmode STDIN; - binmode STDOUT; - - my ($output, $status) ; - while (read(STDIN, $input, 4096)) - { - $status = $x->inflate(\$input, $output) ; - - print $output - if $status == Z_OK or $status == Z_STREAM_END ; - - last if $status != Z_OK ; - } - - die "inflation failed\n" - unless $status == Z_STREAM_END ; - -=head1 Compress::Zlib 1.x Deflate Interface - -This section defines the interface available in C version -1.x that allows in-memory compression using the I interface -provided by zlib. - -Here is a definition of the interface available: - - -=head2 B<($d, $status) = deflateInit( [OPT] )> - -Initialises a deflation stream. - -It combines the features of the I functions C, -C and C. - -If successful, it will return the initialised deflation stream, C<$d> -and C<$status> of C in a list context. In scalar context it -returns the deflation stream, C<$d>, only. - -If not successful, the returned deflation stream (C<$d>) will be -I and C<$status> will hold the exact I error code. - -The function optionally takes a number of named options specified as -C<-Name=Evalue> pairs. This allows individual options to be -tailored without having to specify them all in the parameter list. - -For backward compatibility, it is also possible to pass the parameters -as a reference to a hash containing the name=>value pairs. - -The function takes one optional parameter, a reference to a hash. The -contents of the hash allow the deflation interface to be tailored. - -Here is a list of the valid options: - -=over 5 - -=item B<-Level> - -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. - -The default is C<-Level =EZ_DEFAULT_COMPRESSION>. - -=item B<-Method> - -Defines the compression method. The only valid value at present (and -the default) is C<-Method =EZ_DEFLATED>. - -=item B<-WindowBits> - -To create an RFC1950 data stream, set C to a positive number. - -To create an RFC1951 data stream, set C to C<-MAX_WBITS>. - -For a full definition of the meaning and valid values for C refer -to the I documentation for I. - -Defaults to C<-WindowBits =EMAX_WBITS>. - -=item B<-MemLevel> - -For a definition of the meaning and valid values for C -refer to the I documentation for I. - -Defaults to C<-MemLevel =EMAX_MEM_LEVEL>. - -=item B<-Strategy> - -Defines the strategy used to tune the compression. The valid values are -C, C and C. - -The default is C<-Strategy =EZ_DEFAULT_STRATEGY>. - -=item B<-Dictionary> - -When a dictionary is specified I will automatically -call C directly after calling C. The -Adler32 value for the dictionary can be obtained by calling the method -C<$d->dict_adler()>. - -The default is no dictionary. - -=item B<-Bufsize> - -Sets the initial size for the deflation buffer. If the buffer has to be -reallocated to increase the size, it will grow in increments of -C. - -The default is 4096. - -=back - -Here is an example of using the C optional parameter list -to override the default buffer size and compression level. All other -options will take their default values. - - deflateInit( -Bufsize => 300, - -Level => Z_BEST_SPEED ) ; - - -=head2 B<($out, $status) = $d-Edeflate($buffer)> - - -Deflates the contents of C<$buffer>. The buffer can either be a scalar -or a scalar reference. When finished, C<$buffer> will be -completely processed (assuming there were no errors). If the deflation -was successful it returns the deflated output, C<$out>, and a status -value, C<$status>, of C. - -On error, C<$out> will be I and C<$status> will contain the -I error code. - -In a scalar context C will return C<$out> only. - -As with the I function in I, it is not necessarily the -case that any output will be produced by this method. So don't rely on -the fact that C<$out> is empty for an error test. - - -=head2 B<($out, $status) = $d-Eflush([flush_type])> - -Typically used to finish the deflation. Any pending output will be -returned via C<$out>. -C<$status> will have a value C if successful. - -In a scalar context C will return C<$out> only. - -Note that flushing can seriously degrade the compression ratio, so it -should only be used to terminate a decompression (using C) or -when you want to create a I (using C). - -By default the C used is C. Other valid values -for C are C, C, C -and C. It is strongly recommended that you only set the -C parameter if you fully understand the implications of -what it does. See the C documentation for details. - -=head2 B<$status = $d-EdeflateParams([OPT])> - -Change settings for the deflate stream C<$d>. - -The list of the valid options is shown below. Options not specified -will remain unchanged. - -=over 5 - -=item B<-Level> - -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. - -=item B<-Strategy> - -Defines the strategy used to tune the compression. The valid values are -C, C and C. - -=back - -=head2 B<$d-Edict_adler()> - -Returns the adler32 value for the dictionary. - -=head2 B<$d-Emsg()> - -Returns the last error message generated by zlib. - -=head2 B<$d-Etotal_in()> - -Returns the total number of bytes uncompressed bytes input to deflate. - -=head2 B<$d-Etotal_out()> - -Returns the total number of compressed bytes output from deflate. - -=head2 Example - - -Here is a trivial example of using C. It simply reads standard -input, deflates it and writes it to standard output. - - use strict ; - use warnings ; - - use Compress::Zlib ; - - binmode STDIN; - binmode STDOUT; - my $x = deflateInit() - or die "Cannot create a deflation stream\n" ; - - my ($output, $status) ; - while (<>) - { - ($output, $status) = $x->deflate($_) ; - - $status == Z_OK - or die "deflation failed\n" ; - - print $output ; - } - - ($output, $status) = $x->flush() ; - - $status == Z_OK - or die "deflation failed\n" ; - - print $output ; - -=head1 Compress::Zlib 1.x Inflate Interface - -This section defines the interface available in C version -1.x that allows in-memory uncompression using the I interface -provided by zlib. - -Here is a definition of the interface: - - -=head2 B<($i, $status) = inflateInit()> - -Initializes an inflation stream. - -In a list context it returns the inflation stream, C<$i>, and the -I status code (C<$status>). In a scalar context it returns the -inflation stream only. - -If successful, C<$i> will hold the inflation stream and C<$status> will -be C. - -If not successful, C<$i> will be I and C<$status> will hold the -I error code. - -The function optionally takes a number of named options specified as -C<-Name=Evalue> pairs. This allows individual options to be -tailored without having to specify them all in the parameter list. - -For backward compatibility, it is also possible to pass the parameters -as a reference to a hash containing the name=>value pairs. - -The function takes one optional parameter, a reference to a hash. The -contents of the hash allow the deflation interface to be tailored. - -Here is a list of the valid options: - -=over 5 - -=item B<-WindowBits> - -To uncompress an RFC1950 data stream, set C to a positive number. - -To uncompress an RFC1951 data stream, set C to C<-MAX_WBITS>. - -For a full definition of the meaning and valid values for C refer -to the I documentation for I. - -Defaults to C<-WindowBits =EMAX_WBITS>. - -=item B<-Bufsize> - -Sets the initial size for the inflation buffer. If the buffer has to be -reallocated to increase the size, it will grow in increments of -C. - -Default is 4096. - -=item B<-Dictionary> - -The default is no dictionary. - -=back - -Here is an example of using the C optional parameter to -override the default buffer size. - - inflateInit( -Bufsize => 300 ) ; - -=head2 B<($out, $status) = $i-Einflate($buffer)> - -Inflates the complete contents of C<$buffer>. The buffer can either be -a scalar or a scalar reference. - -Returns C if successful and C if the end of the -compressed data has been successfully reached. -If not successful, C<$out> will be I and C<$status> will hold -the I error code. - -The C<$buffer> parameter is modified by C. On completion it -will contain what remains of the input buffer after inflation. This -means that C<$buffer> will be an empty string when the return status is -C. When the return status is C the C<$buffer> -parameter will contains what (if anything) was stored in the input -buffer after the deflated data stream. - -This feature is useful when processing a file format that encapsulates -a compressed data stream (e.g. gzip, zip). - -=head2 B<$status = $i-EinflateSync($buffer)> - -Scans C<$buffer> until it reaches either a I or the -end of the buffer. - -If a I is found, C is returned and C<$buffer> -will be have all data up to the flush point removed. This can then be -passed to the C method. - -Any other return code means that a flush point was not found. If more -data is available, C can be called repeatedly with more -compressed data until the flush point is found. - - -=head2 B<$i-Edict_adler()> - -Returns the adler32 value for the dictionary. - -=head2 B<$i-Emsg()> - -Returns the last error message generated by zlib. - -=head2 B<$i-Etotal_in()> - -Returns the total number of bytes compressed bytes input to inflate. - -=head2 B<$i-Etotal_out()> - -Returns the total number of uncompressed bytes output from inflate. - -=head2 Example - -Here is an example of using C. - - use strict ; - use warnings ; - - use Compress::Zlib ; - - my $x = inflateInit() - or die "Cannot create a inflation stream\n" ; - - my $input = '' ; - binmode STDIN; - binmode STDOUT; - - my ($output, $status) ; - while (read(STDIN, $input, 4096)) - { - ($output, $status) = $x->inflate(\$input) ; - - print $output - if $status == Z_OK or $status == Z_STREAM_END ; - - last if $status != Z_OK ; - } - - die "inflation failed\n" - unless $status == Z_STREAM_END ; - -=head1 ACCESSING ZIP FILES - -Although it is possible (with some effort on your part) to use this -module to access .zip files, there is a module on CPAN that will do all -the hard work for you. Check out the C module on CPAN at - - http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz - - -=head1 CONSTANTS - -All the I constants are automatically imported when you make use -of I. - - -=head1 SEE ALSO - -L, L, L, L, L, L, L - -L - -L, L, -L - -For RFC 1950, 1951 and 1952 see -F, -F and -F - -The primary site for the gzip program is F. - -=head1 AUTHOR - -The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. - -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. - -The primary site for the I compression library is -F. - -=head1 MODIFICATION HISTORY - -See the Changes file. - -=head1 COPYRIGHT AND LICENSE - - -Copyright (c) 1995-2006 Paul Marquess. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - - - - - diff --git a/ext/Compress/Zlib/Zlib.xs b/ext/Compress/Zlib/Zlib.xs deleted file mode 100644 index b7cd48a..0000000 --- a/ext/Compress/Zlib/Zlib.xs +++ /dev/null @@ -1,1974 +0,0 @@ -/* Filename: Zlib.xs - * Author : Paul Marquess, - * Created : 22nd January 1996 - * Version : 2.000 - * - * Copyright (c) 1995-2005 Paul Marquess. All rights reserved. - * This program is free software; you can redistribute it and/or - * modify it under the same terms as Perl itself. - * - */ - -/* Parts of this code are based on the files gzio.c and gzappend.c from - * the standard zlib source distribution. Below are the copyright statements - * from each. - */ - -/* gzio.c -- IO on .gz files - * Copyright (C) 1995 Jean-loup Gailly. - * For conditions of distribution and use, see copyright notice in zlib.h - */ - -/* gzappend -- command to append to a gzip file - - Copyright (C) 2003 Mark Adler, all rights reserved - version 1.1, 4 Nov 2003 -*/ - - - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include - -/* zlib prior to 1.06 doesn't know about z_off_t */ -#ifndef z_off_t -# define z_off_t long -#endif - -#if ! defined(ZLIB_VERNUM) || ZLIB_VERNUM < 0x1200 -# define NEED_DUMMY_BYTE_AT_END -#endif - -#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1210 -# define MAGIC_APPEND -#endif - -#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1221 -# define AT_LEAST_ZLIB_1_2_2_1 -#endif - -#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1223 -# define AT_LEAST_ZLIB_1_2_2_3 -#endif - -#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1230 -# define AT_LEAST_ZLIB_1_2_3 -#endif - -#if 0 - -# include "ppport.h" - -#else - -# ifndef PERL_VERSION -# include "patchlevel.h" -# define PERL_REVISION 5 -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION -# endif - -# if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 )) - -# define PL_sv_undef sv_undef -# define PL_na na -# define PL_curcop curcop -# define PL_compiling compiling - -# endif - -# ifndef newSVuv -# define newSVuv newSViv -# endif - - - -# if PERL_REVISION == 5 && (PERL_VERSION < 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 4 )) - -# ifdef SvPVbyte_force -# undef SvPVbyte_force -# endif - -# define SvPVbyte_force(sv,lp) SvPV_force(sv,lp) - -# endif - -# ifndef SvPVbyte_nolen -# define SvPVbyte_nolen SvPV_nolen -# endif - -# ifndef SvPVbyte -# define SvPVbyte SvPV -# endif - -# ifndef dTHX -# define dTHX -# endif - -# ifndef SvPV_nolen - -# define sv_2pv_nolen(a) my_sv_2pv_nolen(a) - -static char * -my_sv_2pv_nolen(register SV *sv) -{ - dTHX; - STRLEN n_a; - return sv_2pv(sv, &n_a); -} - - -/* SvPV_nolen depends on sv_2pv_nolen */ -# define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX(sv) : sv_2pv_nolen(sv)) - - -# endif - -# ifndef SvGETMAGIC -# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END -# endif - -#endif - -# ifndef SvPVbyte_nolen -# define SvPVbyte_nolen SvPV_nolen -# endif - -# ifndef SvPVbyte_force -# define SvPVbyte_force(sv,lp) SvPV_force(sv,lp) -# endif - -#if PERL_REVISION == 5 && (PERL_VERSION >= 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 4 )) -# define UTF8_AVAILABLE -#endif - -typedef int DualType ; -typedef int int_undef ; - -typedef struct di_stream { - int flags ; -#define FLAG_APPEND 1 -#define FLAG_CRC32 2 -#define FLAG_ADLER32 4 -#define FLAG_CONSUME_INPUT 8 - uLong crc32 ; - uLong adler32 ; - z_stream stream; - uLong bufsize; - uLong bufinc; - SV * dictionary ; - uLong dict_adler ; - int last_error ; - bool zip_mode ; -#define SETP_BYTE -#ifdef SETP_BYTE - bool deflateParams_out_valid ; - Bytef deflateParams_out_byte; -#else -#define deflateParams_BUFFER_SIZE 0x4000 - uLong deflateParams_out_length; - Bytef* deflateParams_out_buffer; -#endif - int Level; - int Method; - int WindowBits; - int MemLevel; - int Strategy; - uLong bytesInflated ; - uLong compressedBytes ; - uLong uncompressedBytes ; -#ifdef MAGIC_APPEND - -#define WINDOW_SIZE 32768U - - bool matchedEndBlock; - Bytef* window ; - int window_lastbit, window_left, window_full; - unsigned window_have; - off_t window_lastoff, window_end; - off_t window_endOffset; - - uLong lastBlockOffset ; - unsigned char window_lastByte ; - - -#endif -} di_stream; - -typedef di_stream * deflateStream ; -typedef di_stream * Compress__Zlib__deflateStream ; -typedef di_stream * inflateStream ; -typedef di_stream * Compress__Zlib__inflateStream ; -typedef di_stream * Compress__Zlib__inflateScanStream ; - -#define GZERRNO "Compress::Zlib::gzerrno" - -#define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \ - Zero(to,1,typ)) - -/* Figure out the Operating System */ -#ifdef MSDOS -# define OS_CODE 0x00 -#endif - -#if defined(AMIGA) || defined(AMIGAOS) -# define OS_CODE 0x01 -#endif - -#if defined(VAXC) || defined(VMS) -# define OS_CODE 0x02 -#endif - -#if 0 /* VM/CMS */ -# define OS_CODE 0x04 -#endif - -#if defined(ATARI) || defined(atarist) -# define OS_CODE 0x05 -#endif - -#ifdef OS2 -# define OS_CODE 0x06 -#endif - -#if defined(MACOS) || defined(TARGET_OS_MAC) -# define OS_CODE 0x07 -#endif - -#if 0 /* Z-System */ -# define OS_CODE 0x08 -#endif - -#if 0 /* CP/M */ -# define OS_CODE 0x09 -#endif - -#ifdef TOPS20 -# define OS_CODE 0x0a -#endif - -#ifdef WIN32 /* Window 95 & Windows NT */ -# define OS_CODE 0x0b -#endif - -#if 0 /* QDOS */ -# define OS_CODE 0x0c -#endif - -#if 0 /* Acorn RISCOS */ -# define OS_CODE 0x0d -#endif - -#if 0 /* ??? */ -# define OS_CODE 0x0e -#endif - -#ifdef __50SERIES /* Prime/PRIMOS */ -# define OS_CODE 0x0F -#endif - -/* Default to UNIX */ -#ifndef OS_CODE -# define OS_CODE 0x03 /* assume Unix */ -#endif - -#ifndef GZIP_OS_CODE -# define GZIP_OS_CODE OS_CODE -#endif - -#define adlerInitial adler32(0L, Z_NULL, 0) -#define crcInitial crc32(0L, Z_NULL, 0) - - -static const char * const my_z_errmsg[] = { - "need dictionary", /* Z_NEED_DICT 2 */ - "stream end", /* Z_STREAM_END 1 */ - "", /* Z_OK 0 */ - "file error", /* Z_ERRNO (-1) */ - "stream error", /* Z_STREAM_ERROR (-2) */ - "data error", /* Z_DATA_ERROR (-3) */ - "insufficient memory", /* Z_MEM_ERROR (-4) */ - "buffer error", /* Z_BUF_ERROR (-5) */ - "incompatible version",/* Z_VERSION_ERROR(-6) */ - ""}; - -#define setDUALstatus(var, err) \ - sv_setnv(var, (double)err) ; \ - sv_setpv(var, ((err) ? GetErrorString(err) : "")) ; \ - SvNOK_on(var); - - -#if defined(__SYMBIAN32__) -# define NO_WRITEABLE_DATA -#endif - -#define TRACE_DEFAULT 0 - -#ifdef NO_WRITEABLE_DATA -# define trace TRACE_DEFAULT -#else - static int trace = TRACE_DEFAULT ; -#endif - -/* Dodge PerlIO hiding of these functions. */ -#undef printf - -static char * -#ifdef CAN_PROTOTYPE -GetErrorString(int error_no) -#else -GetErrorString(error_no) -int error_no ; -#endif -{ - dTHX; - char * errstr ; - - if (error_no == Z_ERRNO) { - errstr = Strerror(errno) ; - } - else - /* errstr = gzerror(fil, &error_no) ; */ - errstr = (char*) my_z_errmsg[2 - error_no]; - - return errstr ; -} - -#if 0 -static void -#ifdef CAN_PROTOTYPE -SetGzErrorNo(int error_no) -#else -SetGzErrorNo(error_no) -int error_no ; -#endif -{ - dTHX; - char * errstr ; - SV * gzerror_sv = perl_get_sv(GZERRNO, FALSE) ; - - if (error_no == Z_ERRNO) { - error_no = errno ; - errstr = Strerror(errno) ; - } - else - /* errstr = gzerror(fil, &error_no) ; */ - errstr = (char*) my_z_errmsg[2 - error_no]; - - if (SvIV(gzerror_sv) != error_no) { - sv_setiv(gzerror_sv, error_no) ; - sv_setpv(gzerror_sv, errstr) ; - SvIOK_on(gzerror_sv) ; - } - -} - - -static void -#ifdef CAN_PROTOTYPE -SetGzError(gzFile file) -#else -SetGzError(file) -gzFile file ; -#endif -{ - int error_no ; - - (void)gzerror(file, &error_no) ; - SetGzErrorNo(error_no) ; -} - -#endif - -#ifdef MAGIC_APPEND - -/* - The following two functions are taken almost directly from - examples/gzappend.c. Only cosmetic changes have been made to conform to - the coding style of the rest of the code in this file. -*/ - - -/* return the greatest common divisor of a and b using Euclid's algorithm, - modified to be fast when one argument much greater than the other, and - coded to avoid unnecessary swapping */ -static unsigned -#ifdef CAN_PROTOTYPE -gcd(unsigned a, unsigned b) -#else -gcd(a, b) - unsigned a; - unsigned b; -#endif -{ - unsigned c; - - while (a && b) - if (a > b) { - c = b; - while (a - c >= c) - c <<= 1; - a -= c; - } - else { - c = a; - while (b - c >= c) - c <<= 1; - b -= c; - } - return a + b; -} - -/* rotate list[0..len-1] left by rot positions, in place */ -static void -#ifdef CAN_PROTOTYPE -rotate(unsigned char *list, unsigned len, unsigned rot) -#else -rotate(list, len, rot) - unsigned char *list; - unsigned len ; - unsigned rot; -#endif -{ - unsigned char tmp; - unsigned cycles; - unsigned char *start, *last, *to, *from; - - /* normalize rot and handle degenerate cases */ - if (len < 2) return; - if (rot >= len) rot %= len; - if (rot == 0) return; - - /* pointer to last entry in list */ - last = list + (len - 1); - - /* do simple left shift by one */ - if (rot == 1) { - tmp = *list; - memcpy(list, list + 1, len - 1); - *last = tmp; - return; - } - - /* do simple right shift by one */ - if (rot == len - 1) { - tmp = *last; - memmove(list + 1, list, len - 1); - *list = tmp; - return; - } - - /* otherwise do rotate as a set of cycles in place */ - cycles = gcd(len, rot); /* number of cycles */ - do { - start = from = list + cycles; /* start index is arbitrary */ - tmp = *from; /* save entry to be overwritten */ - for (;;) { - to = from; /* next step in cycle */ - from += rot; /* go right rot positions */ - if (from > last) from -= len; /* (pointer better not wrap) */ - if (from == start) break; /* all but one shifted */ - *to = *from; /* shift left */ - } - *to = tmp; /* complete the circle */ - } while (--cycles); -} - -#endif /* MAGIC_APPEND */ - -static void -#ifdef CAN_PROTOTYPE -DispHex(void * ptr, int length) -#else -DispHex(ptr, length) - void * ptr; - int length; -#endif -{ - char * p = (char*)ptr; - int i; - for (i = 0; i < length; ++i) { - printf(" %02x", 0xFF & *(p+i)); - } -} - - -static void -#ifdef CAN_PROTOTYPE -DispStream(di_stream * s, char * message) -#else -DispStream(s, message) - di_stream * s; - char * message; -#endif -{ - -#if 0 - if (! trace) - return ; -#endif - -#define EnDis(f) (s->flags & f ? "Enabled" : "Disabled") - - printf("DispStream 0x%p", s) ; - if (message) - printf("- %s \n", message) ; - printf("\n") ; - - if (!s) { - printf(" stream pointer is NULL\n"); - } - else { - printf(" stream 0x%p\n", &(s->stream)); - printf(" zalloc 0x%p\n", s->stream.zalloc); - printf(" zfree 0x%p\n", s->stream.zfree); - printf(" opaque 0x%p\n", s->stream.opaque); - if (s->stream.msg) - printf(" msg %s\n", s->stream.msg); - else - printf(" msg \n"); - printf(" next_in 0x%p", s->stream.next_in); - if (s->stream.next_in){ - printf(" =>"); - DispHex(s->stream.next_in, 4); - } - printf("\n"); - - printf(" next_out 0x%p", s->stream.next_out); - if (s->stream.next_out){ - printf(" =>"); - DispHex(s->stream.next_out, 4); - } - printf("\n"); - - printf(" avail_in %lu\n", (unsigned long)s->stream.avail_in); - printf(" avail_out %lu\n", (unsigned long)s->stream.avail_out); - printf(" total_in %ld\n", s->stream.total_in); - printf(" total_out %ld\n", s->stream.total_out); - printf(" adler %ld\n", s->stream.adler ); - printf(" bufsize %ld\n", s->bufsize); - printf(" dictionary 0x%p\n", s->dictionary); - printf(" dict_adler 0x%ld\n",s->dict_adler); - printf(" zip_mode %d\n", s->zip_mode); - printf(" crc32 0x%x\n", (unsigned)s->crc32); - printf(" adler32 0x%x\n", (unsigned)s->adler32); - printf(" flags 0x%x\n", s->flags); - printf(" APPEND %s\n", EnDis(FLAG_APPEND)); - printf(" CRC32 %s\n", EnDis(FLAG_CRC32)); - printf(" ADLER32 %s\n", EnDis(FLAG_ADLER32)); - printf(" CONSUME %s\n", EnDis(FLAG_CONSUME_INPUT)); - -#ifdef MAGIC_APPEND - printf(" window 0x%p\n", s->window); -#endif - printf("\n"); - - } -} - -static di_stream * -#ifdef CAN_PROTOTYPE -InitStream(void) -#else -InitStream() -#endif -{ - di_stream *s ; - - ZMALLOC(s, di_stream) ; - - return s ; - -} - -static void -#ifdef CAN_PROTOTYPE -PostInitStream(di_stream * s, int flags, int bufsize, int windowBits) -#else -PostInitStream(s, flags, bufsize, windowBits) - di_stream *s ; - int flags ; - int bufsize ; - int windowBits ; -#endif -{ - s->bufsize = bufsize ; - s->bufinc = bufsize ; - s->compressedBytes = - s->uncompressedBytes = - s->last_error = 0 ; - s->flags = flags ; - s->zip_mode = (windowBits < 0) ; - if (flags & FLAG_CRC32) - s->crc32 = crcInitial ; - if (flags & FLAG_ADLER32) - s->adler32 = adlerInitial ; -} - - -static SV* -#ifdef CAN_PROTOTYPE -deRef(SV * sv, char * string) -#else -deRef(sv, string) -SV * sv ; -char * string; -#endif -{ - dTHX; - SvGETMAGIC(sv); - - if (SvROK(sv)) { - sv = SvRV(sv) ; - SvGETMAGIC(sv); - switch(SvTYPE(sv)) { - case SVt_PVAV: - case SVt_PVHV: - case SVt_PVCV: - croak("%s: buffer parameter is not a SCALAR reference", string); - } - if (SvROK(sv)) - croak("%s: buffer parameter is a reference to a reference", string) ; - } - - if (!SvOK(sv)) { - sv = newSVpv("", 0); - } - - return sv ; -} - -static SV* -#ifdef CAN_PROTOTYPE -deRef_l(SV * sv, char * string) -#else -deRef_l(sv, string) -SV * sv ; -char * string ; -#endif -{ - dTHX; - bool wipe = 0 ; - - SvGETMAGIC(sv); - wipe = ! SvOK(sv) ; - - if (SvROK(sv)) { - sv = SvRV(sv) ; - SvGETMAGIC(sv); - wipe = ! SvOK(sv) ; - - switch(SvTYPE(sv)) { - case SVt_PVAV: - case SVt_PVHV: - case SVt_PVCV: - croak("%s: buffer parameter is not a SCALAR reference", string); - } - if (SvROK(sv)) - croak("%s: buffer parameter is a reference to a reference", string) ; - } - - if (SvREADONLY(sv) && PL_curcop != &PL_compiling) - croak("%s: buffer parameter is read-only", string); - - SvUPGRADE(sv, SVt_PV); - - if (wipe) - SvCUR_set(sv, 0); - - SvOOK_off(sv); - SvPOK_only(sv); - - return sv ; -} - - -#include "constants.h" - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib PREFIX = Zip_ - -REQUIRE: 1.924 -PROTOTYPES: DISABLE - -INCLUDE: constants.xs - -BOOT: - /* Check this version of zlib is == 1 */ - if (zlibVersion()[0] != '1') - croak("Compress::Zlib needs zlib version 1.x\n") ; - - { - /* Create the $os_code scalar */ - SV * os_code_sv = perl_get_sv("Compress::Zlib::gzip_os_code", GV_ADDMULTI) ; - sv_setiv(os_code_sv, GZIP_OS_CODE) ; - } - - { - /* Create the $gzerror scalar */ - SV * gzerror_sv = perl_get_sv(GZERRNO, GV_ADDMULTI) ; - sv_setiv(gzerror_sv, 0) ; - sv_setpv(gzerror_sv, "") ; - SvIOK_on(gzerror_sv) ; - } - -#define Zip_zlib_version() (char*)zlib_version -char* -Zip_zlib_version() - -unsigned -ZLIB_VERNUM() - CODE: -#ifdef ZLIB_VERNUM - RETVAL = ZLIB_VERNUM ; -#else - /* 1.1.4 => 0x1140 */ - RETVAL = (ZLIB_VERSION[0] - '0') << 12 ; - RETVAL += (ZLIB_VERSION[2] - '0') << 8 ; - RETVAL += (ZLIB_VERSION[4] - '0') << 4 ; -#endif - OUTPUT: - RETVAL - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib PREFIX = Zip_ - -#define Zip_adler32(buf, adler) adler32(adler, buf, (uInt)len) - -uLong -Zip_adler32(buf, adler=adlerInitial) - uLong adler = NO_INIT - STRLEN len = NO_INIT - Bytef * buf = NO_INIT - SV * sv = ST(0) ; - INIT: - /* If the buffer is a reference, dereference it */ - sv = deRef(sv, "adler32") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(sv) && !sv_utf8_downgrade(sv, 1)) - croak("Wide character in Compress::Zlib::adler32"); -#endif - buf = (Byte*)SvPVbyte(sv, len) ; - - if (items < 2) - adler = adlerInitial; - else if (SvOK(ST(1))) - adler = SvUV(ST(1)) ; - else - adler = adlerInitial; - -#define Zip_crc32(buf, crc) crc32(crc, buf, (uInt)len) - -uLong -Zip_crc32(buf, crc=crcInitial) - uLong crc = NO_INIT - STRLEN len = NO_INIT - Bytef * buf = NO_INIT - SV * sv = ST(0) ; - INIT: - /* If the buffer is a reference, dereference it */ - sv = deRef(sv, "crc32") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(sv) && !sv_utf8_downgrade(sv, 1)) - croak("Wide character in Compress::Zlib::crc32"); -#endif - buf = (Byte*)SvPVbyte(sv, len) ; - - if (items < 2) - crc = crcInitial; - else if (SvOK(ST(1))) - crc = SvUV(ST(1)) ; - else - crc = crcInitial; - - -uLong -crc32_combine(crc1, crc2, len2) - uLong crc1 - uLong crc2 - z_off_t len2 - CODE: -#ifndef AT_LEAST_ZLIB_1_2_2_1 - crc1 = crc1; crc2 = crc2 ; len2 = len2; /* Silence -Wall */ - croak("crc32_combine needs zlib 1.2.3 or better"); -#else - RETVAL = crc32_combine(crc1, crc2, len2); -#endif - OUTPUT: - RETVAL - - -uLong -adler32_combine(adler1, adler2, len2) - uLong adler1 - uLong adler2 - z_off_t len2 - CODE: -#ifndef AT_LEAST_ZLIB_1_2_2_1 - adler1 = adler1; adler2 = adler2 ; len2 = len2; /* Silence -Wall */ - croak("adler32_combine needs zlib 1.2.3 or better"); -#else - RETVAL = adler32_combine(adler1, adler2, len2); -#endif - OUTPUT: - RETVAL - - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib - -void -_deflateInit(flags,level, method, windowBits, memLevel, strategy, bufsize, dictionary) - int flags - int level - int method - int windowBits - int memLevel - int strategy - uLong bufsize - SV* dictionary - PPCODE: - int err ; - deflateStream s ; - - if (trace) - warn("in _deflateInit(level=%d, method=%d, windowBits=%d, memLevel=%d, strategy=%d, bufsize=%ld\n", - level, method, windowBits, memLevel, strategy, bufsize) ; - if ((s = InitStream() )) { - - s->Level = level; - s->Method = method; - s->WindowBits = windowBits; - s->MemLevel = memLevel; - s->Strategy = strategy; - - err = deflateInit2(&(s->stream), level, - method, windowBits, memLevel, strategy); - - /* Check if a dictionary has been specified */ - - if (err == Z_OK && SvCUR(dictionary)) { -#ifdef UTF8_AVAILABLE - if (DO_UTF8(dictionary) && !sv_utf8_downgrade(dictionary, 1)) - croak("Wide character in Compress::Zlib::Deflate::new dicrionary parameter"); -#endif - err = deflateSetDictionary(&(s->stream), (const Bytef*) SvPVbyte_nolen(dictionary), - SvCUR(dictionary)) ; - s->dict_adler = s->stream.adler ; - } - - if (err != Z_OK) { - Safefree(s) ; - s = NULL ; - } - else - PostInitStream(s, flags, bufsize, windowBits) ; - - } - else - err = Z_MEM_ERROR ; - - XPUSHs(sv_setref_pv(sv_newmortal(), - "Compress::Zlib::deflateStream", (void*)s)); - if (GIMME == G_ARRAY) { - SV * sv = sv_2mortal(newSViv(err)) ; - setDUALstatus(sv, err); - XPUSHs(sv) ; - } - -void -_inflateInit(flags, windowBits, bufsize, dictionary) - int flags - int windowBits - uLong bufsize - SV * dictionary - ALIAS: - _inflateScanInit = 1 - PPCODE: - - int err = Z_OK ; - inflateStream s ; -#ifndef MAGIC_APPEND - if (ix == 1) - croak("inflateScanInit needs zlib 1.2.1 or better"); -#endif - if (trace) - warn("in _inflateInit(windowBits=%d, bufsize=%lu, dictionary=%lu\n", - windowBits, bufsize, (unsigned long)SvCUR(dictionary)) ; - if ((s = InitStream() )) { - - s->WindowBits = windowBits; - - err = inflateInit2(&(s->stream), windowBits); - if (err != Z_OK) { - Safefree(s) ; - s = NULL ; - } - else if (SvCUR(dictionary)) { - /* Dictionary specified - take a copy for use in inflate */ - s->dictionary = newSVsv(dictionary) ; - } - if (s) { - PostInitStream(s, flags, bufsize, windowBits) ; -#ifdef MAGIC_APPEND - if (ix == 1) - { - s->window = (unsigned char *)safemalloc(WINDOW_SIZE); - } -#endif - } - } - else - err = Z_MEM_ERROR ; - - XPUSHs(sv_setref_pv(sv_newmortal(), - ix == 1 - ? "Compress::Zlib::inflateScanStream" - : "Compress::Zlib::inflateStream", - (void*)s)); - if (GIMME == G_ARRAY) { - SV * sv = sv_2mortal(newSViv(err)) ; - setDUALstatus(sv, err); - XPUSHs(sv) ; - } - - - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib::deflateStream - -void -DispStream(s, message=NULL) - Compress::Zlib::deflateStream s - char * message - -DualType -deflateReset(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = deflateReset(&(s->stream)) ; - if (RETVAL == Z_OK) { - PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ; - } - OUTPUT: - RETVAL - -DualType -deflate (s, buf, output) - Compress::Zlib::deflateStream s - SV * buf - SV * output - uInt cur_length = NO_INIT - uInt increment = NO_INIT - uInt prefix = NO_INIT - int RETVAL = 0; - CODE: - - /* If the input buffer is a reference, dereference it */ - buf = deRef(buf, "deflate") ; - - /* initialise the input buffer */ -#ifdef UTF8_AVAILABLE - if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) - croak("Wide character in Compress::Zlib::Deflate::deflate input parameter"); -#endif - s->stream.next_in = (Bytef*)SvPVbyte_nolen(buf) ; - s->stream.avail_in = SvCUR(buf) ; - - if (s->flags & FLAG_CRC32) - s->crc32 = crc32(s->crc32, s->stream.next_in, s->stream.avail_in) ; - - if (s->flags & FLAG_ADLER32) - s->adler32 = adler32(s->adler32, s->stream.next_in, s->stream.avail_in) ; - - /* and retrieve the output buffer */ - output = deRef_l(output, "deflate") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) - croak("Wide character in Compress::Zlib::Deflate::deflate output parameter"); -#endif - - if((s->flags & FLAG_APPEND) != FLAG_APPEND) { - SvCUR_set(output, 0); - /* sv_setpvn(output, "", 0); */ - } - prefix = cur_length = SvCUR(output) ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; - increment = SvLEN(output) - cur_length; - s->stream.avail_out = increment; -#ifdef SETP_BYTE - /* Check for saved output from deflateParams */ - if (s->deflateParams_out_valid) { - *(s->stream.next_out) = s->deflateParams_out_byte; - ++ s->stream.next_out; - -- s->stream.avail_out ; - s->deflateParams_out_valid = FALSE; - } -#else - /* Check for saved output from deflateParams */ - if (s->deflateParams_out_length) { - uLong plen = s->deflateParams_out_length ; - /* printf("Copy %d bytes saved data\n", plen);*/ - if (s->stream.avail_out < plen) { - /*printf("GROW from %d to %d\n", s->stream.avail_out, - SvLEN(output) + plen - s->stream.avail_out); */ - Sv_Grow(output, SvLEN(output) + plen - s->stream.avail_out) ; - } - - Copy(s->stream.next_out, s->deflateParams_out_buffer, plen, Bytef) ; - cur_length = cur_length + plen; - SvCUR_set(output, cur_length); - s->stream.next_out += plen ; - s->stream.avail_out = SvLEN(output) - cur_length ; - increment = s->stream.avail_out; - s->deflateParams_out_length = 0; - } -#endif - while (s->stream.avail_in != 0) { - - if (s->stream.avail_out == 0) { - /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; - cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; - s->stream.avail_out = increment; - s->bufinc *= 2 ; - } - - RETVAL = deflate(&(s->stream), Z_NO_FLUSH); - if (RETVAL != Z_OK) - break; - } - - s->compressedBytes += cur_length + increment - prefix - s->stream.avail_out ; - s->uncompressedBytes += SvCUR(buf) - s->stream.avail_in ; - - s->last_error = RETVAL ; - if (RETVAL == Z_OK) { - SvPOK_only(output); - SvCUR_set(output, cur_length + increment - s->stream.avail_out) ; - } - OUTPUT: - RETVAL - output - - -void -DESTROY(s) - Compress::Zlib::deflateStream s - CODE: - deflateEnd(&s->stream) ; - if (s->dictionary) - SvREFCNT_dec(s->dictionary) ; -#ifndef SETP_BYTE - if (s->deflateParams_out_buffer) - Safefree(s->deflateParams_out_buffer); -#endif - Safefree(s) ; - - -DualType -flush(s, output, f=Z_FINISH) - Compress::Zlib::deflateStream s - SV * output - int f - uInt cur_length = NO_INIT - uInt increment = NO_INIT - uInt prefix = NO_INIT - CODE: - - s->stream.avail_in = 0; /* should be zero already anyway */ - - /* retrieve the output buffer */ - output = deRef_l(output, "flush") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) - croak("Wide character in Compress::Zlib::Deflate::flush input parameter"); -#endif - if(! s->flags & FLAG_APPEND) { - SvCUR_set(output, 0); - /* sv_setpvn(output, "", 0); */ - } - prefix = cur_length = SvCUR(output) ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; - increment = SvLEN(output) - cur_length; - s->stream.avail_out = increment; -#ifdef SETP_BYTE - /* Check for saved output from deflateParams */ - if (s->deflateParams_out_valid) { - *(s->stream.next_out) = s->deflateParams_out_byte; - ++ s->stream.next_out; - -- s->stream.avail_out ; - s->deflateParams_out_valid = FALSE; - } -#else - /* Check for saved output from deflateParams */ - if (s->deflateParams_out_length) { - uLong plen = s->deflateParams_out_length ; - /* printf("Copy %d bytes saved data\n", plen); */ - if (s->stream.avail_out < plen) { - /* printf("GROW from %d to %d\n", s->stream.avail_out, - SvLEN(output) + plen - s->stream.avail_out); */ - Sv_Grow(output, SvLEN(output) + plen - s->stream.avail_out) ; - } - - Copy(s->stream.next_out, s->deflateParams_out_buffer, plen, Bytef) ; - cur_length = cur_length + plen; - SvCUR_set(output, cur_length); - s->stream.next_out += plen ; - s->stream.avail_out = SvLEN(output) - cur_length ; - increment = s->stream.avail_out; - s->deflateParams_out_length = 0; - } -#endif - - for (;;) { - if (s->stream.avail_out == 0) { - /* consumed all the available output, so extend it */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; - cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; - s->stream.avail_out = increment; - s->bufinc *= 2 ; - } - RETVAL = deflate(&(s->stream), f); - - /* deflate has finished flushing only when it hasn't used up - * all the available space in the output buffer: - */ - if (s->stream.avail_out != 0 || RETVAL != Z_OK ) - break; - } - - RETVAL = (RETVAL == Z_STREAM_END ? Z_OK : RETVAL) ; - s->last_error = RETVAL ; - - s->compressedBytes += cur_length + increment - prefix - s->stream.avail_out ; - - if (RETVAL == Z_OK) { - SvPOK_only(output); - SvCUR_set(output, cur_length + increment - s->stream.avail_out) ; - } - OUTPUT: - RETVAL - output - - -DualType -_deflateParams(s, flags, level, strategy, bufsize) - Compress::Zlib::deflateStream s - int flags - int level - int strategy - uLong bufsize - CODE: - /* printf("_deflateParams(Flags %d Level %d Strategy %d Bufsize %d)\n", flags, level, strategy, bufsize); - printf("Before -- Level %d, Strategy %d, Bufsize %d\n", s->Level, s->Strategy, s->bufsize); */ - if (flags & 1) - s->Level = level ; - if (flags & 2) - s->Strategy = strategy ; - if (flags & 4) { - s->bufsize = bufsize; - s->bufinc = bufsize; - } - /* printf("After -- Level %d, Strategy %d, Bufsize %d\n", s->Level, s->Strategy, s->bufsize);*/ -#ifdef SETP_BYTE - s->stream.avail_in = 0; - s->stream.next_out = &(s->deflateParams_out_byte) ; - s->stream.avail_out = 1; - RETVAL = deflateParams(&(s->stream), s->Level, s->Strategy); - s->deflateParams_out_valid = - (RETVAL == Z_OK && s->stream.avail_out == 0) ; - /* printf("RETVAL %d, avail out %d, byte %c\n", RETVAL, s->stream.avail_out, s->deflateParams_out_byte); */ -#else - /* printf("Level %d Strategy %d, Prev Len %d\n", - s->Level, s->Strategy, s->deflateParams_out_length); */ - s->stream.avail_in = 0; - if (s->deflateParams_out_buffer == NULL) - s->deflateParams_out_buffer = safemalloc(deflateParams_BUFFER_SIZE); - s->stream.next_out = s->deflateParams_out_buffer ; - s->stream.avail_out = deflateParams_BUFFER_SIZE; - - RETVAL = deflateParams(&(s->stream), s->Level, s->Strategy); - s->deflateParams_out_length = deflateParams_BUFFER_SIZE - s->stream.avail_out; - /* printf("RETVAL %d, length out %d, avail %d\n", - RETVAL, s->deflateParams_out_length, s->stream.avail_out ); */ -#endif - OUTPUT: - RETVAL - - -int -get_Level(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->Level ; - OUTPUT: - RETVAL - -int -get_Strategy(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->Strategy ; - OUTPUT: - RETVAL - - -uLong -get_Bufsize(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->bufsize ; - OUTPUT: - RETVAL - - -int -status(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->last_error ; - OUTPUT: - RETVAL - -uLong -crc32(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->crc32 ; - OUTPUT: - RETVAL - -uLong -dict_adler(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->dict_adler ; - OUTPUT: - RETVAL - -uLong -adler32(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->adler32 ; - OUTPUT: - RETVAL - -uLong -compressedBytes(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->compressedBytes; - OUTPUT: - RETVAL - -uLong -uncompressedBytes(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->uncompressedBytes; - OUTPUT: - RETVAL - -uLong -total_in(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->stream.total_in ; - OUTPUT: - RETVAL - -uLong -total_out(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->stream.total_out ; - OUTPUT: - RETVAL - -char* -msg(s) - Compress::Zlib::deflateStream s - CODE: - RETVAL = s->stream.msg; - OUTPUT: - RETVAL - -int -deflateTune(s, good_length, max_lazy, nice_length, max_chain) - Compress::Zlib::deflateStream s - int good_length - int max_lazy - int nice_length - int max_chain - CODE: -#ifndef AT_LEAST_ZLIB_1_2_2_3 - good_length = good_length; max_lazy = max_lazy ; /* Silence -Wall */ - nice_length = nice_length; max_chain = max_chain; /* Silence -Wall */ - croak("deflateTune needs zlib 1.2.2.3 or better"); -#else - RETVAL = deflateTune(&(s->stream), good_length, max_lazy, nice_length, max_chain); -#endif - OUTPUT: - RETVAL - - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib::inflateStream - -void -DispStream(s, message=NULL) - Compress::Zlib::inflateStream s - char * message - -DualType -inflateReset(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = inflateReset(&(s->stream)) ; - if (RETVAL == Z_OK) { - PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ; - } - OUTPUT: - RETVAL - -DualType -inflate (s, buf, output, eof=FALSE) - Compress::Zlib::inflateStream s - SV * buf - SV * output - bool eof - uInt cur_length = 0; - uInt prefix_length = 0; - uInt increment = 0; - STRLEN stmp = NO_INIT - PREINIT: -#ifdef UTF8_AVAILABLE - bool out_utf8 = FALSE; -#endif - CODE: - /* If the buffer is a reference, dereference it */ - buf = deRef(buf, "inflate") ; - - if (s->flags & FLAG_CONSUME_INPUT && SvREADONLY(buf)) - croak("Compress::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified"); -#ifdef UTF8_AVAILABLE - if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) - croak("Wide character in Compress::Zlib::Inflate::inflate input parameter"); -#endif - - /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_force(buf, stmp) ; - s->stream.avail_in = SvCUR(buf) ; - - /* and retrieve the output buffer */ - output = deRef_l(output, "inflate") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(output)) - out_utf8 = TRUE ; - if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) - croak("Wide character in Compress::Zlib::Inflate::inflate output parameter"); -#endif - if((s->flags & FLAG_APPEND) != FLAG_APPEND) { - SvCUR_set(output, 0); - } - if (SvLEN(output)) { - prefix_length = cur_length = SvCUR(output) ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; - increment = SvLEN(output) - cur_length - 1; - s->stream.avail_out = increment; - } - else { - s->stream.avail_out = 0; - } - s->bytesInflated = 0; - - while (1) { - - if (s->stream.avail_out == 0) { - /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; - cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; - s->stream.avail_out = increment; - s->bufinc *= 2 ; - } - - RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH); - - if (RETVAL == Z_STREAM_ERROR || RETVAL == Z_MEM_ERROR || - RETVAL == Z_DATA_ERROR || RETVAL == Z_STREAM_END ) - break ; - - if (RETVAL == Z_BUF_ERROR) { - if (s->stream.avail_out == 0) - continue ; - if (s->stream.avail_in == 0) { - RETVAL = Z_OK ; - break ; - } - } - - if (RETVAL == Z_NEED_DICT && s->dictionary) { - s->dict_adler = s->stream.adler ; - RETVAL = inflateSetDictionary(&(s->stream), - (const Bytef*)SvPVbyte_nolen(s->dictionary), - SvCUR(s->dictionary)); - } - - if (RETVAL != Z_OK) - break; - } -#ifdef NEED_DUMMY_BYTE_AT_END - if (eof && RETVAL == Z_OK) { - Bytef* nextIn = s->stream.next_in; - uInt availIn = s->stream.avail_in; - s->stream.next_in = (Bytef*) " "; - s->stream.avail_in = 1; - if (s->stream.avail_out == 0) { - /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; - cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; - s->stream.avail_out = increment; - s->bufinc *= 2 ; - } - RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH); - s->stream.next_in = nextIn ; - s->stream.avail_in = availIn ; - } -#endif - - s->last_error = RETVAL ; - if (RETVAL == Z_OK || RETVAL == Z_STREAM_END || RETVAL == Z_DATA_ERROR) { - unsigned in ; - - s->bytesInflated = cur_length + increment - s->stream.avail_out - prefix_length; - s->uncompressedBytes += s->bytesInflated ; - s->compressedBytes += SvCUR(buf) - s->stream.avail_in ; - - SvPOK_only(output); - SvCUR_set(output, prefix_length + s->bytesInflated) ; - *SvEND(output) = '\0'; -#ifdef UTF8_AVAILABLE - if (out_utf8) - sv_utf8_upgrade(output); -#endif - - if (s->flags & FLAG_CRC32 ) - s->crc32 = crc32(s->crc32, - (const Bytef*)SvPVbyte_nolen(output)+prefix_length, - SvCUR(output)-prefix_length) ; - - if (s->flags & FLAG_ADLER32) - s->adler32 = adler32(s->adler32, - (const Bytef*)SvPVbyte_nolen(output)+prefix_length, - SvCUR(output)-prefix_length) ; - - /* fix the input buffer */ - if (s->flags & FLAG_CONSUME_INPUT) { - in = s->stream.avail_in ; - SvCUR_set(buf, in) ; - if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; - *SvEND(buf) = '\0'; - SvSETMAGIC(buf); - } - } - OUTPUT: - RETVAL - buf - output - -uLong -inflateCount(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->bytesInflated; - OUTPUT: - RETVAL - -uLong -compressedBytes(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->compressedBytes; - OUTPUT: - RETVAL - -uLong -uncompressedBytes(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->uncompressedBytes; - OUTPUT: - RETVAL - - -DualType -inflateSync (s, buf) - Compress::Zlib::inflateStream s - SV * buf - CODE: - - /* If the buffer is a reference, dereference it */ - buf = deRef(buf, "inflateSync") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) - croak("Wide character in Compress::Zlib::Inflate::inflateSync"); -#endif - - /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_nolen(buf) ; - s->stream.avail_in = SvCUR(buf) ; - - /* inflateSync doesn't create any output */ - s->stream.next_out = (Bytef*) NULL; - s->stream.avail_out = 0; - - RETVAL = inflateSync(&(s->stream)); - s->last_error = RETVAL ; - - /* fix the input buffer */ - { - unsigned in = s->stream.avail_in ; - SvCUR_set(buf, in) ; - if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; - *SvEND(buf) = '\0'; - SvSETMAGIC(buf); - } - OUTPUT: - RETVAL - buf - -void -DESTROY(s) - Compress::Zlib::inflateStream s - CODE: - inflateEnd(&s->stream) ; - if (s->dictionary) - SvREFCNT_dec(s->dictionary) ; -#ifndef SETP_BYTE - if (s->deflateParams_out_buffer) - Safefree(s->deflateParams_out_buffer); -#endif -#ifdef MAGIC_APPEND - if (s->window) - Safefree(s->window); -#endif - Safefree(s) ; - - -uLong -status(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->last_error ; - OUTPUT: - RETVAL - -uLong -crc32(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->crc32 ; - OUTPUT: - RETVAL - -uLong -dict_adler(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->dict_adler ; - OUTPUT: - RETVAL - -uLong -total_in(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->stream.total_in ; - OUTPUT: - RETVAL - -uLong -adler32(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->adler32 ; - OUTPUT: - RETVAL - -uLong -total_out(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->stream.total_out ; - OUTPUT: - RETVAL - -char* -msg(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->stream.msg; - OUTPUT: - RETVAL - - -uLong -get_Bufsize(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->bufsize ; - OUTPUT: - RETVAL - -bool -set_Append(s, mode) - Compress::Zlib::inflateStream s - bool mode - CODE: - RETVAL = ((s->flags & FLAG_APPEND) == FLAG_APPEND); - if (mode) - s->flags |= FLAG_APPEND ; - else - s->flags &= ~FLAG_APPEND ; - OUTPUT: - RETVAL - -MODULE = Compress::Zlib PACKAGE = Compress::Zlib::inflateScanStream - -void -DESTROY(s) - Compress::Zlib::inflateScanStream s - CODE: - inflateEnd(&s->stream) ; - if (s->dictionary) - SvREFCNT_dec(s->dictionary) ; -#ifndef SETP_BYTE - if (s->deflateParams_out_buffer) - Safefree(s->deflateParams_out_buffer); -#endif -#ifdef MAGIC_APPEND - if (s->window) - Safefree(s->window); -#endif - Safefree(s) ; - -void -DispStream(s, message=NULL) - Compress::Zlib::inflateScanStream s - char * message - -DualType -inflateReset(s) - Compress::Zlib::inflateScanStream s - CODE: - RETVAL = inflateReset(&(s->stream)) ; - if (RETVAL == Z_OK) { - PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ; - } - OUTPUT: - RETVAL - -DualType -scan(s, buf, out=NULL, eof=FALSE) - Compress::Zlib::inflateScanStream s - SV * buf - SV * out - bool eof - bool eof_mode = FALSE; - int start_len = NO_INIT - STRLEN stmp = NO_INIT - CODE: - /* If the input buffer is a reference, dereference it */ -#ifndef MAGIC_APPEND - buf = buf; - croak("scan needs zlib 1.2.1 or better"); -#else - buf = deRef(buf, "inflateScan") ; -#ifdef UTF8_AVAILABLE - if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) - croak("Wide character in Compress::Zlib::InflateScan::scan input parameter"); -#endif - /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_force(buf, stmp) ; - s->stream.avail_in = SvCUR(buf) ; - start_len = s->stream.avail_in ; - s->bytesInflated = 0 ; - do - { - if (s->stream.avail_in == 0) { - RETVAL = Z_OK ; - break ; - } - - /* set up output to next available section of sliding window */ - s->stream.avail_out = WINDOW_SIZE - s->window_have; - s->stream.next_out = s->window + s->window_have; - - /* DispStream(s, "before inflate\n"); */ - - /* inflate and check for errors */ - RETVAL = inflate(&(s->stream), Z_BLOCK); - - if (start_len > 1 && ! eof_mode) - s->window_lastByte = *(s->stream.next_in - 1 ) ; - - if (RETVAL == Z_STREAM_ERROR || RETVAL == Z_MEM_ERROR || - RETVAL == Z_DATA_ERROR ) - break ; - - if (s->flags & FLAG_CRC32 ) - s->crc32 = crc32(s->crc32, s->window + s->window_have, - WINDOW_SIZE - s->window_have - s->stream.avail_out); - - if (s->flags & FLAG_ADLER32) - s->adler32 = adler32(s->adler32, s->window + s->window_have, - WINDOW_SIZE - s->window_have - s->stream.avail_out); - - s->uncompressedBytes = - s->bytesInflated += WINDOW_SIZE - s->window_have - s->stream.avail_out; - - if (s->stream.avail_out) - s->window_have = WINDOW_SIZE - s->stream.avail_out; - else { - s->window_have = 0; - s->window_full = 1; - } - - /* process end of block */ - if (s->stream.data_type & 128) { - if (s->stream.data_type & 64) { - s->window_left = s->stream.data_type & 0x1f; - } - else { - s->window_lastbit = s->stream.data_type & 0x1f; - s->lastBlockOffset = s->stream.total_in; - } - } - - } while (RETVAL != Z_STREAM_END); - - s->last_error = RETVAL ; - s->window_lastoff = s->stream.total_in ; - s->compressedBytes += SvCUR(buf) - s->stream.avail_in ; - - if (RETVAL == Z_STREAM_END) - { - s->matchedEndBlock = 1 ; - - /* save the location of the end of the compressed data */ - s->window_end = SvCUR(buf) - s->stream.avail_in - 1 ; - s->window_endOffset = s->stream.total_in ; - if (s->window_left) - { - -- s->window_endOffset ; - } - - /* if window wrapped, build dictionary from window by rotating */ - if (s->window_full) { - rotate(s->window, WINDOW_SIZE, s->window_have); - s->window_have = WINDOW_SIZE; - } - - /* if (s->flags & FLAG_CONSUME_INPUT) { */ - if (1) { - unsigned in = s->stream.avail_in ; - SvCUR_set(buf, in) ; - if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; - *SvEND(buf) = '\0'; - SvSETMAGIC(buf); - } - } -#endif - OUTPUT: - RETVAL - - -uLong -getEndOffset(s) - Compress::Zlib::inflateScanStream s - CODE: -#ifndef MAGIC_APPEND - croak("getEndOffset needs zlib 1.2.1 or better"); -#else - RETVAL = s->window_endOffset; -#endif - OUTPUT: - RETVAL - -uLong -inflateCount(s) - Compress::Zlib::inflateScanStream s - CODE: -#ifndef MAGIC_APPEND - croak("inflateCount needs zlib 1.2.1 or better"); -#else - RETVAL = s->bytesInflated; -#endif - OUTPUT: - RETVAL - -uLong -compressedBytes(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->compressedBytes; - OUTPUT: - RETVAL - -uLong -uncompressedBytes(s) - Compress::Zlib::inflateStream s - CODE: - RETVAL = s->uncompressedBytes; - OUTPUT: - RETVAL - - -uLong -getLastBlockOffset(s) - Compress::Zlib::inflateScanStream s - CODE: -#ifndef MAGIC_APPEND - croak("getLastBlockOffset needs zlib 1.2.1 or better"); -#else - RETVAL = s->lastBlockOffset - (s->window_lastbit != 0); -#endif - OUTPUT: - RETVAL - -uLong -getLastBufferOffset(s) - Compress::Zlib::inflateScanStream s - CODE: -#ifndef MAGIC_APPEND - croak("getLastBufferOffset needs zlib 1.2.1 or better"); -#else - RETVAL = s->window_lastoff; -#endif - OUTPUT: - RETVAL - -void -resetLastBlockByte(s, byte) - Compress::Zlib::inflateScanStream s - unsigned char* byte - CODE: -#ifndef MAGIC_APPEND - croak("resetLastBlockByte needs zlib 1.2.1 or better"); -#else - *byte = *byte ^ (1 << ((8 - s->window_lastbit) & 7)); -#endif - - -void -_createDeflateStream(inf_s, flags,level, method, windowBits, memLevel, strategy, bufsize) - Compress::Zlib::inflateScanStream inf_s - int flags - int level - int method - int windowBits - int memLevel - int strategy - uLong bufsize - PPCODE: - { -#ifndef MAGIC_APPEND - flags = flags; - level = level ; - method = method; - windowBits = windowBits; - memLevel = memLevel; - strategy = strategy; - bufsize= bufsize; - croak("_createDeflateStream needs zlib 1.2.1 or better"); -#else - int err ; - deflateStream s ; - - if (trace) - warn("in _createDeflateStream(level=%d, method=%d, windowBits=%d, memLevel=%d, strategy=%d, bufsize=%lu\n", - level, method, windowBits, memLevel, strategy, bufsize) ; - if ((s = InitStream() )) { - - s->Level = level; - s->Method = method; - s->WindowBits = windowBits; - s->MemLevel = memLevel; - s->Strategy = strategy; - - err = deflateInit2(&(s->stream), level, - method, windowBits, memLevel, strategy); - - if (err == Z_OK) { - err = deflateSetDictionary(&(s->stream), inf_s->window, inf_s->window_have); - s->dict_adler = s->stream.adler ; - } - - if (err != Z_OK) { - Safefree(s) ; - s = NULL ; - } - else { - PostInitStream(s, flags, bufsize, windowBits) ; - s->crc32 = inf_s->crc32; - s->adler32 = inf_s->adler32; - s->stream.adler = inf_s->stream.adler ; - /* s->stream.total_out = inf_s->bytesInflated ; */ - s->stream.total_in = inf_s->stream.total_out ; - if (inf_s->window_left) { - /* printf("** window_left %d, window_lastByte %d\n", inf_s->window_left, inf_s->window_lastByte); */ - deflatePrime(&(s->stream), 8 - inf_s->window_left, inf_s->window_lastByte); - } - } - } - else - err = Z_MEM_ERROR ; - - XPUSHs(sv_setref_pv(sv_newmortal(), - "Compress::Zlib::deflateStream", (void*)s)); - if (GIMME == G_ARRAY) { - SV * sv = sv_2mortal(newSViv(err)) ; - setDUALstatus(sv, err); - XPUSHs(sv) ; - } -#endif - } - -DualType -status(s) - Compress::Zlib::inflateScanStream s - CODE: - RETVAL = s->last_error ; - OUTPUT: - RETVAL - -uLong -crc32(s) - Compress::Zlib::inflateScanStream s - CODE: - RETVAL = s->crc32 ; - OUTPUT: - RETVAL - - -uLong -adler32(s) - Compress::Zlib::inflateScanStream s - CODE: - RETVAL = s->adler32 ; - OUTPUT: - RETVAL - diff --git a/ext/Compress/Zlib/config.in b/ext/Compress/Zlib/config.in deleted file mode 100755 index c56cc03..0000000 --- a/ext/Compress/Zlib/config.in +++ /dev/null @@ -1,27 +0,0 @@ -# Filename: config.in -# -# written by Paul Marquess -# last modified 28th October 2003 -# version 2.000 -# -# -# This file is used to control which zlib library will be used by -# Compress::Zlib -# -# See to the sections below in the README file for details of how to -# use this file. -# -# Controlling the version of zlib used by Compress::Zlib -# -# Setting the Gzip OS Code -# - -BUILD_ZLIB = True -INCLUDE = ./zlib-src -LIB = ./zlib-src - -OLD_ZLIB = False -GZIP_OS_CODE = AUTO_DETECT - - -# end of file config.in diff --git a/ext/Compress/Zlib/examples/gzcat.zlib b/ext/Compress/Zlib/examples/gzcat.zlib deleted file mode 100644 index 5ccb700..0000000 --- a/ext/Compress/Zlib/examples/gzcat.zlib +++ /dev/null @@ -1,25 +0,0 @@ -#!/usr/local/bin/perl - -use Compress::Zlib ; -use strict ; -use warnings ; - -#die "Usage: gzcat file...\n" -# unless @ARGV ; - -my $file ; -my $buffer ; - -@ARGV = '-' unless @ARGV ; - -foreach $file (@ARGV) { - my $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; - - print $buffer while $gz->gzread($buffer) > 0 ; - - die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n" - if $gzerrno != Z_STREAM_END ; - - $gz->gzclose() ; -} diff --git a/ext/Compress/Zlib/fallback/constants.h b/ext/Compress/Zlib/fallback/constants.h deleted file mode 100644 index 323f236..0000000 --- a/ext/Compress/Zlib/fallback/constants.h +++ /dev/null @@ -1,529 +0,0 @@ -#define PERL_constant_NOTFOUND 1 -#define PERL_constant_NOTDEF 2 -#define PERL_constant_ISIV 3 -#define PERL_constant_ISNO 4 -#define PERL_constant_ISNV 5 -#define PERL_constant_ISPV 6 -#define PERL_constant_ISPVN 7 -#define PERL_constant_ISSV 8 -#define PERL_constant_ISUNDEF 9 -#define PERL_constant_ISUV 10 -#define PERL_constant_ISYES 11 - -#ifndef NVTYPE -typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ -#endif -#ifndef aTHX_ -#define aTHX_ /* 5.6 or later define this for threading support. */ -#endif -#ifndef pTHX_ -#define pTHX_ /* 5.6 or later define this for threading support. */ -#endif - -static int -constant_7 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - OS_CODE Z_ASCII Z_BLOCK Z_ERRNO Z_FIXED */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'D': - if (memEQ(name, "Z_FIXE", 6)) { - /* D */ -#ifdef Z_FIXED - *iv_return = Z_FIXED; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "OS_COD", 6)) { - /* E */ -#ifdef OS_CODE - *iv_return = OS_CODE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "Z_ASCI", 6)) { - /* I */ -#ifdef Z_ASCII - *iv_return = Z_ASCII; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "Z_BLOC", 6)) { - /* K */ -#ifdef Z_BLOCK - *iv_return = Z_BLOCK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "Z_ERRN", 6)) { - /* O */ -#ifdef Z_ERRNO - *iv_return = Z_ERRNO; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_9 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - DEF_WBITS MAX_WBITS Z_UNKNOWN */ - /* Offset 2 gives the best switch position. */ - switch (name[2]) { - case 'F': - if (memEQ(name, "DEF_WBITS", 9)) { - /* ^ */ -#ifdef DEF_WBITS - *iv_return = DEF_WBITS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "Z_UNKNOWN", 9)) { - /* ^ */ -#ifdef Z_UNKNOWN - *iv_return = Z_UNKNOWN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'X': - if (memEQ(name, "MAX_WBITS", 9)) { - /* ^ */ -#ifdef MAX_WBITS - *iv_return = MAX_WBITS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_10 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - Z_DEFLATED Z_FILTERED Z_NO_FLUSH */ - /* Offset 7 gives the best switch position. */ - switch (name[7]) { - case 'R': - if (memEQ(name, "Z_FILTERED", 10)) { - /* ^ */ -#ifdef Z_FILTERED - *iv_return = Z_FILTERED; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "Z_DEFLATED", 10)) { - /* ^ */ -#ifdef Z_DEFLATED - *iv_return = Z_DEFLATED; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "Z_NO_FLUSH", 10)) { - /* ^ */ -#ifdef Z_NO_FLUSH - *iv_return = Z_NO_FLUSH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_11 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - Z_BUF_ERROR Z_MEM_ERROR Z_NEED_DICT */ - /* Offset 4 gives the best switch position. */ - switch (name[4]) { - case 'E': - if (memEQ(name, "Z_NEED_DICT", 11)) { - /* ^ */ -#ifdef Z_NEED_DICT - *iv_return = Z_NEED_DICT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'F': - if (memEQ(name, "Z_BUF_ERROR", 11)) { - /* ^ */ -#ifdef Z_BUF_ERROR - *iv_return = Z_BUF_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'M': - if (memEQ(name, "Z_MEM_ERROR", 11)) { - /* ^ */ -#ifdef Z_MEM_ERROR - *iv_return = Z_MEM_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_12 (pTHX_ const char *name, IV *iv_return, const char **pv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - ZLIB_VERSION Z_BEST_SPEED Z_DATA_ERROR Z_FULL_FLUSH Z_STREAM_END - Z_SYNC_FLUSH */ - /* Offset 4 gives the best switch position. */ - switch (name[4]) { - case 'L': - if (memEQ(name, "Z_FULL_FLUSH", 12)) { - /* ^ */ -#ifdef Z_FULL_FLUSH - *iv_return = Z_FULL_FLUSH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "Z_SYNC_FLUSH", 12)) { - /* ^ */ -#ifdef Z_SYNC_FLUSH - *iv_return = Z_SYNC_FLUSH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "Z_STREAM_END", 12)) { - /* ^ */ -#ifdef Z_STREAM_END - *iv_return = Z_STREAM_END; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "Z_BEST_SPEED", 12)) { - /* ^ */ -#ifdef Z_BEST_SPEED - *iv_return = Z_BEST_SPEED; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "Z_DATA_ERROR", 12)) { - /* ^ */ -#ifdef Z_DATA_ERROR - *iv_return = Z_DATA_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case '_': - if (memEQ(name, "ZLIB_VERSION", 12)) { - /* ^ */ -#ifdef ZLIB_VERSION - *pv_return = ZLIB_VERSION; - return PERL_constant_ISPV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant (pTHX_ const char *name, STRLEN len, IV *iv_return, const char **pv_return) { - /* Initially switch on the length of the name. */ - /* When generated this function returned values for the list of names given - in this section of perl code. Rather than manually editing these functions - to add or remove constants, which would result in this comment and section - of code becoming inaccurate, we recommend that you edit this section of - code, and use it to regenerate a new set of constant functions which you - then use to replace the originals. - - Regenerate these constant functions by feeding this entire source file to - perl -x - -#!/usr/bin/perl5.8.6 -w -use ExtUtils::Constant qw (constant_types C_constant XS_constant); - -my $types = {map {($_, 1)} qw(IV PV)}; -my @names = (qw(DEF_WBITS MAX_MEM_LEVEL MAX_WBITS OS_CODE Z_ASCII - Z_BEST_COMPRESSION Z_BEST_SPEED Z_BINARY Z_BLOCK Z_BUF_ERROR - Z_DATA_ERROR Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY Z_DEFLATED - Z_ERRNO Z_FILTERED Z_FINISH Z_FIXED Z_FULL_FLUSH Z_HUFFMAN_ONLY - Z_MEM_ERROR Z_NEED_DICT Z_NO_COMPRESSION Z_NO_FLUSH Z_NULL Z_OK - Z_PARTIAL_FLUSH Z_RLE Z_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH - Z_UNKNOWN Z_VERSION_ERROR), - {name=>"ZLIB_VERSION", type=>"PV"}); - -print constant_types(); # macro defs -foreach (C_constant ("Zlib", 'constant', 'IV', $types, undef, 3, @names) ) { - print $_, "\n"; # C constant subs -} -print "#### XS Section:\n"; -print XS_constant ("Zlib", $types); -__END__ - */ - - switch (len) { - case 4: - if (memEQ(name, "Z_OK", 4)) { -#ifdef Z_OK - *iv_return = Z_OK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 5: - if (memEQ(name, "Z_RLE", 5)) { -#ifdef Z_RLE - *iv_return = Z_RLE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 6: - if (memEQ(name, "Z_NULL", 6)) { -#ifdef Z_NULL - *iv_return = Z_NULL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 7: - return constant_7 (aTHX_ name, iv_return); - break; - case 8: - /* Names all of length 8. */ - /* Z_BINARY Z_FINISH */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'R': - if (memEQ(name, "Z_BINARY", 8)) { - /* ^ */ -#ifdef Z_BINARY - *iv_return = Z_BINARY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "Z_FINISH", 8)) { - /* ^ */ -#ifdef Z_FINISH - *iv_return = Z_FINISH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 9: - return constant_9 (aTHX_ name, iv_return); - break; - case 10: - return constant_10 (aTHX_ name, iv_return); - break; - case 11: - return constant_11 (aTHX_ name, iv_return); - break; - case 12: - return constant_12 (aTHX_ name, iv_return, pv_return); - break; - case 13: - if (memEQ(name, "MAX_MEM_LEVEL", 13)) { -#ifdef MAX_MEM_LEVEL - *iv_return = MAX_MEM_LEVEL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 14: - /* Names all of length 14. */ - /* Z_HUFFMAN_ONLY Z_STREAM_ERROR */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'T': - if (memEQ(name, "Z_STREAM_ERROR", 14)) { - /* ^ */ -#ifdef Z_STREAM_ERROR - *iv_return = Z_STREAM_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "Z_HUFFMAN_ONLY", 14)) { - /* ^ */ -#ifdef Z_HUFFMAN_ONLY - *iv_return = Z_HUFFMAN_ONLY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 15: - /* Names all of length 15. */ - /* Z_PARTIAL_FLUSH Z_VERSION_ERROR */ - /* Offset 5 gives the best switch position. */ - switch (name[5]) { - case 'S': - if (memEQ(name, "Z_VERSION_ERROR", 15)) { - /* ^ */ -#ifdef Z_VERSION_ERROR - *iv_return = Z_VERSION_ERROR; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "Z_PARTIAL_FLUSH", 15)) { - /* ^ */ -#ifdef Z_PARTIAL_FLUSH - *iv_return = Z_PARTIAL_FLUSH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 16: - if (memEQ(name, "Z_NO_COMPRESSION", 16)) { -#ifdef Z_NO_COMPRESSION - *iv_return = Z_NO_COMPRESSION; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 18: - /* Names all of length 18. */ - /* Z_BEST_COMPRESSION Z_DEFAULT_STRATEGY */ - /* Offset 14 gives the best switch position. */ - switch (name[14]) { - case 'S': - if (memEQ(name, "Z_BEST_COMPRESSION", 18)) { - /* ^ */ -#ifdef Z_BEST_COMPRESSION - *iv_return = Z_BEST_COMPRESSION; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "Z_DEFAULT_STRATEGY", 18)) { - /* ^ */ -#ifdef Z_DEFAULT_STRATEGY - *iv_return = Z_DEFAULT_STRATEGY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 21: - if (memEQ(name, "Z_DEFAULT_COMPRESSION", 21)) { -#ifdef Z_DEFAULT_COMPRESSION - *iv_return = Z_DEFAULT_COMPRESSION; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - diff --git a/ext/Compress/Zlib/fallback/constants.xs b/ext/Compress/Zlib/fallback/constants.xs deleted file mode 100644 index 02a6ef4..0000000 --- a/ext/Compress/Zlib/fallback/constants.xs +++ /dev/null @@ -1,87 +0,0 @@ -void -constant(sv) - PREINIT: -#ifdef dXSTARG - dXSTARG; /* Faster if we have it. */ -#else - dTARGET; -#endif - STRLEN len; - int type; - IV iv; - /* NV nv; Uncomment this if you need to return NVs */ - const char *pv; - INPUT: - SV * sv; - const char * s = SvPV(sv, len); - PPCODE: - /* Change this to constant(aTHX_ s, len, &iv, &nv); - if you need to return both NVs and IVs */ - type = constant(aTHX_ s, len, &iv, &pv); - /* Return 1 or 2 items. First is error message, or undef if no error. - Second, if present, is found value */ - switch (type) { - case PERL_constant_NOTFOUND: - sv = sv_2mortal(newSVpvf("%s is not a valid Zlib macro", s)); - PUSHs(sv); - break; - case PERL_constant_NOTDEF: - sv = sv_2mortal(newSVpvf( - "Your vendor has not defined Zlib macro %s, used", s)); - PUSHs(sv); - break; - case PERL_constant_ISIV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHi(iv); - break; - /* Uncomment this if you need to return NOs - case PERL_constant_ISNO: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_no); - break; */ - /* Uncomment this if you need to return NVs - case PERL_constant_ISNV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHn(nv); - break; */ - case PERL_constant_ISPV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHp(pv, strlen(pv)); - break; - /* Uncomment this if you need to return PVNs - case PERL_constant_ISPVN: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHp(pv, iv); - break; */ - /* Uncomment this if you need to return SVs - case PERL_constant_ISSV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(sv); - break; */ - /* Uncomment this if you need to return UNDEFs - case PERL_constant_ISUNDEF: - break; */ - /* Uncomment this if you need to return UVs - case PERL_constant_ISUV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHu((UV)iv); - break; */ - /* Uncomment this if you need to return YESs - case PERL_constant_ISYES: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_yes); - break; */ - default: - sv = sv_2mortal(newSVpvf( - "Unexpected return type %d while processing Zlib macro %s, used", - type, s)); - PUSHs(sv); - } diff --git a/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm b/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm deleted file mode 100644 index 531b347..0000000 --- a/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm +++ /dev/null @@ -1,137 +0,0 @@ -package Compress::Gzip::Constants; - -use strict ; -use warnings; -use bytes; - -require Exporter; - -our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); -our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); - -$VERSION = '2.000_07'; - -@ISA = qw(Exporter); - -@EXPORT= qw( - - GZIP_ID_SIZE - GZIP_ID1 - GZIP_ID2 - - GZIP_FLG_DEFAULT - GZIP_FLG_FTEXT - GZIP_FLG_FHCRC - GZIP_FLG_FEXTRA - GZIP_FLG_FNAME - GZIP_FLG_FCOMMENT - GZIP_FLG_RESERVED - - GZIP_CM_DEFLATED - - GZIP_MIN_HEADER_SIZE - GZIP_TRAILER_SIZE - - GZIP_MTIME_DEFAULT - GZIP_XFL_DEFAULT - GZIP_FEXTRA_HEADER_SIZE - GZIP_FEXTRA_MAX_SIZE - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE - GZIP_FEXTRA_SUBFIELD_ID_SIZE - GZIP_FEXTRA_SUBFIELD_LEN_SIZE - GZIP_FEXTRA_SUBFIELD_MAX_SIZE - - $GZIP_FNAME_INVALID_CHAR_RE - $GZIP_FCOMMENT_INVALID_CHAR_RE - - GZIP_FHCRC_SIZE - - GZIP_ISIZE_MAX - GZIP_ISIZE_MOD_VALUE - - - GZIP_NULL_BYTE - - GZIP_OS_DEFAULT - - %GZIP_OS_Names - - GZIP_MINIMUM_HEADER - - ); - -# Constant names derived from RFC 1952 - -use constant GZIP_ID_SIZE => 2 ; -use constant GZIP_ID1 => 0x1F; -use constant GZIP_ID2 => 0x8B; - -use constant GZIP_MIN_HEADER_SIZE => 10 ;# minimum gzip header size -use constant GZIP_TRAILER_SIZE => 8 ; - - -use constant GZIP_FLG_DEFAULT => 0x00 ; -use constant GZIP_FLG_FTEXT => 0x01 ; -use constant GZIP_FLG_FHCRC => 0x02 ; # called CONTINUATION in gzip -use constant GZIP_FLG_FEXTRA => 0x04 ; -use constant GZIP_FLG_FNAME => 0x08 ; -use constant GZIP_FLG_FCOMMENT => 0x10 ; -#use constant GZIP_FLG_ENCRYPTED => 0x20 ; # documented in gzip sources -use constant GZIP_FLG_RESERVED => (0x20 | 0x40 | 0x80) ; - -use constant GZIP_XFL_DEFAULT => 0x00 ; - -use constant GZIP_MTIME_DEFAULT => 0x00 ; - -use constant GZIP_FEXTRA_HEADER_SIZE => 2 ; -use constant GZIP_FEXTRA_MAX_SIZE => 0xFF ; -use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; -use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; -use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE + - GZIP_FEXTRA_SUBFIELD_LEN_SIZE; -use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ; - - $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x1F\x7F-\x9F]'; - $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x09\x11-\x1F\x7F-\x9F]'; - -use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip - -use constant GZIP_CM_DEFLATED => 8 ; - -use constant GZIP_NULL_BYTE => "\x00"; -use constant GZIP_ISIZE_MAX => 0xFFFFFFFF ; -use constant GZIP_ISIZE_MOD_VALUE => GZIP_ISIZE_MAX + 1 ; - -# OS Names sourced from http://www.gzip.org/format.txt - -use constant GZIP_OS_DEFAULT=> 0xFF ; -%GZIP_OS_Names = ( - 0 => 'MS-DOS', - 1 => 'Amiga', - 2 => 'VMS', - 3 => 'Unix', - 4 => 'VM/CMS', - 5 => 'Atari TOS', - 6 => 'HPFS (OS/2, NT)', - 7 => 'Macintosh', - 8 => 'Z-System', - 9 => 'CP/M', - 10 => 'TOPS-20', - 11 => 'NTFS (NT)', - 12 => 'SMS QDOS', - 13 => 'Acorn RISCOS', - 14 => 'VFAT file system (Win95, NT)', - 15 => 'MVS', - 16 => 'BeOS', - 17 => 'Tandem/NSK', - 18 => 'THEOS', - GZIP_OS_DEFAULT() => 'Unknown', - ) ; - -use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", - GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, - GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ; - - -1; diff --git a/ext/Compress/Zlib/lib/Compress/Zip/Constants.pm b/ext/Compress/Zlib/lib/Compress/Zip/Constants.pm deleted file mode 100644 index ef82024..0000000 --- a/ext/Compress/Zlib/lib/Compress/Zip/Constants.pm +++ /dev/null @@ -1,135 +0,0 @@ -package Compress::Zip::Constants; - -use strict ; -use warnings; - -require Exporter; - -our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); - -$VERSION = '1.00'; - -@ISA = qw(Exporter); - -@EXPORT= qw( - - ZIP_ID_SIZE - GZIP_ID1 - GZIP_ID2 - - GZIP_FLG_DEFAULT - GZIP_FLG_FTEXT - GZIP_FLG_FHCRC - GZIP_FLG_FEXTRA - GZIP_FLG_FNAME - GZIP_FLG_FCOMMENT - GZIP_FLG_RESERVED - - GZIP_CM_DEFLATED - - GZIP_MIN_HEADER_SIZE - GZIP_TRAILER_SIZE - - GZIP_MTIME_DEFAULT - GZIP_FEXTRA_DEFAULT - GZIP_FEXTRA_HEADER_SIZE - GZIP_FEXTRA_MAX_SIZE - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE - GZIP_FEXTRA_SUBFIELD_ID_SIZE - GZIP_FEXTRA_SUBFIELD_LEN_SIZE - GZIP_FEXTRA_SUBFIELD_MAX_SIZE - - GZIP_FNAME_INVALID_CHAR_RE - GZIP_FCOMMENT_INVALID_CHAR_RE - - GZIP_FHCRC_SIZE - - GZIP_ISIZE_MAX - GZIP_ISIZE_MOD_VALUE - - - GZIP_NULL_BYTE - - GZIP_OS_DEFAULT - - %GZIP_OS_Names - - GZIP_MINIMUM_HEADER - - ); - - -# Constants for the Zip Local Header - -use constant ZIP_ID_SIZE => 4 ; -use constant ZIP_LOCAL_ID => 0x02014B50; -use constant ZIP_LOCAL_ID1 => 0x04; -use constant ZIP_LOCAL_ID2 => 0x03; -use constant ZIP_LOCAL_ID3 => 0x4B; -use constant ZIP_LOCAL_ID4 => 0x50; - -use constant ZIP_MIN_HEADER_SIZE => 30 ; -use constant ZIP_TRAILER_SIZE => 0 ; - - -use constant GZIP_FLG_DEFAULT => 0x00 ; -use constant GZIP_FLG_FTEXT => 0x01 ; -use constant GZIP_FLG_FHCRC => 0x02 ; # called CONTINUATION in gzip -use constant GZIP_FLG_FEXTRA => 0x04 ; -use constant GZIP_FLG_FNAME => 0x08 ; -use constant GZIP_FLG_FCOMMENT => 0x10 ; -#use constant GZIP_FLG_ENCRYPTED => 0x20 ; # documented in gzip sources -use constant GZIP_FLG_RESERVED => (0x20 | 0x40 | 0x80) ; - -use constant GZIP_MTIME_DEFAULT => 0x00 ; -use constant GZIP_FEXTRA_DEFAULT => 0x00 ; -use constant GZIP_FEXTRA_HEADER_SIZE => 2 ; -use constant GZIP_FEXTRA_MAX_SIZE => 0xFFFF ; -use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => 4 ; -use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; -use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; -use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => 0xFFFF ; - -use constant GZIP_FNAME_INVALID_CHAR_RE => qr/[\x00-\x1F\x7F-\x9F]/; -use constant GZIP_FCOMMENT_INVALID_CHAR_RE => qr/[\x00-\x09\x11-\x1F\x7F-\x9F]/; - -use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip - -use constant GZIP_CM_DEFLATED => 8 ; - -use constant GZIP_NULL_BYTE => "\x00"; -use constant GZIP_ISIZE_MAX => 0xFFFFFFFF ; -use constant GZIP_ISIZE_MOD_VALUE => GZIP_ISIZE_MAX + 1 ; - -# OS Names sourced from http://www.gzip.org/format.txt - -use constant GZIP_OS_DEFAULT=> 0xFF ; -%ZIP_OS_Names = ( - 0 => 'MS-DOS', - 1 => 'Amiga', - 2 => 'VMS', - 3 => 'Unix', - 4 => 'VM/CMS', - 5 => 'Atari TOS', - 6 => 'HPFS (OS/2, NT)', - 7 => 'Macintosh', - 8 => 'Z-System', - 9 => 'CP/M', - 10 => 'TOPS-20', - 11 => 'NTFS (NT)', - 12 => 'SMS QDOS', - 13 => 'Acorn RISCOS', - 14 => 'VFAT file system (Win95, NT)', - 15 => 'MVS', - 16 => 'BeOS', - 17 => 'Tandem/NSK', - 18 => 'THEOS', - GZIP_OS_DEFAULT => 'Unknown', - ) ; - -use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", - GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, - GZIP_MTIME_DEFAULT, GZIP_FEXTRA_DEFAULT, GZIP_OS_DEFAULT) ; - - -1; diff --git a/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm b/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm deleted file mode 100644 index a01ab9b..0000000 --- a/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm +++ /dev/null @@ -1,392 +0,0 @@ -package Compress::Zlib::Common; - -use strict ; -use warnings; -use bytes; - -use Carp; -use Scalar::Util qw(blessed readonly); -use File::GlobMapper; - -require Exporter; -our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS); -@ISA = qw(Exporter); -$VERSION = '2.000_07'; - -@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput - isaFileGlobString cleanFileGlobString oneTarget - setBinModeInput setBinModeOutput - ckInOutParams - createSelfTiedObject - - WANT_CODE - WANT_EXT - WANT_UNDEF - WANT_HASH - - STATUS_OK - STATUS_ENDSTREAM - STATUS_ERROR - ); - -%EXPORT_TAGS = ( Status => [qw( STATUS_OK - STATUS_ENDSTREAM - STATUS_ERROR - )]); - - -use constant STATUS_OK => 0; -use constant STATUS_ENDSTREAM => 1; -use constant STATUS_ERROR => 2; - -our ($needBinmode); -$needBinmode = ($^O eq 'MSWin32' || - ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} ')) - ? 1 : 0 ; - -sub setBinModeInput($) -{ - my $handle = shift ; - - binmode $handle - if $needBinmode; -} - -sub setBinModeOutput($) -{ - my $handle = shift ; - - binmode $handle - if $needBinmode; -} - -sub isaFilehandle($) -{ - use utf8; # Pragma needed to keep Perl 5.6.0 happy - return (defined $_[0] and - (UNIVERSAL::isa($_[0],'GLOB') or UNIVERSAL::isa(\$_[0],'GLOB')) - and defined fileno($_[0]) ) -} - -sub isaFilename($) -{ - return (defined $_[0] and - ! ref $_[0] and - UNIVERSAL::isa(\$_[0], 'SCALAR')); -} - -sub isaFileGlobString -{ - return defined $_[0] && $_[0] =~ /^<.*>$/; -} - -sub cleanFileGlobString -{ - my $string = shift ; - - $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/; - - return $string; -} - -use constant WANT_CODE => 1 ; -use constant WANT_EXT => 2 ; -use constant WANT_UNDEF => 4 ; -#use constant WANT_HASH => 8 ; -use constant WANT_HASH => 0 ; - -sub whatIsInput($;$) -{ - my $got = whatIs(@_); - - if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') - { - use IO::File; - $got = 'handle'; - #$_[0] = \*STDIN; - $_[0] = new IO::File("<-"); - } - - return $got; -} - -sub whatIsOutput($;$) -{ - my $got = whatIs(@_); - - if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') - { - $got = 'handle'; - #$_[0] = \*STDOUT; - $_[0] = new IO::File(">-"); - } - - return $got; -} - -sub whatIs ($;$) -{ - return 'handle' if isaFilehandle($_[0]); - - my $wantCode = defined $_[1] && $_[1] & WANT_CODE ; - my $extended = defined $_[1] && $_[1] & WANT_EXT ; - my $undef = defined $_[1] && $_[1] & WANT_UNDEF ; - my $hash = defined $_[1] && $_[1] & WANT_HASH ; - - return 'undef' if ! defined $_[0] && $undef ; - - if (ref $_[0]) { - return '' if blessed($_[0]); # is an object - #return '' if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object - return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR'); - return 'array' if UNIVERSAL::isa($_[0], 'ARRAY') && $extended ; - return 'hash' if UNIVERSAL::isa($_[0], 'HASH') && $hash ; - return 'code' if UNIVERSAL::isa($_[0], 'CODE') && $wantCode ; - return ''; - } - - return 'fileglob' if $extended && isaFileGlobString($_[0]); - return 'filename'; -} - -sub oneTarget -{ - return $_[0] =~ /^(code|handle|buffer|filename)$/; -} - -sub Validator::new -{ - my $class = shift ; - - my $Class = shift ; - my $error_ref = shift ; - my $reportClass = shift ; - - my %data = (Class => $Class, - Error => $error_ref, - reportClass => $reportClass, - ) ; - - my $obj = bless \%data, $class ; - - local $Carp::CarpLevel = 1; - - my $inType = $data{inType} = whatIsInput($_[0], WANT_EXT|WANT_HASH); - my $outType = $data{outType} = whatIsOutput($_[1], WANT_EXT|WANT_HASH); - - my $oneInput = $data{oneInput} = oneTarget($inType); - my $oneOutput = $data{oneOutput} = oneTarget($outType); - - if (! $inType) - { - $obj->croakError("$reportClass: illegal input parameter") ; - #return undef ; - } - -# if ($inType eq 'hash') -# { -# $obj->{Hash} = 1 ; -# $obj->{oneInput} = 1 ; -# return $obj->validateHash($_[0]); -# } - - if (! $outType) - { - $obj->croakError("$reportClass: illegal output parameter") ; - #return undef ; - } - - - if ($inType ne 'fileglob' && $outType eq 'fileglob') - { - $obj->croakError("Need input fileglob for outout fileglob"); - } - -# if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' ) -# { -# $obj->croakError("input must ne filename or fileglob when output is a hash"); -# } - - if ($inType eq 'fileglob' && $outType eq 'fileglob') - { - $data{GlobMap} = 1 ; - $data{inType} = $data{outType} = 'filename'; - my $mapper = new File::GlobMapper($_[0], $_[1]); - if ( ! $mapper ) - { - return $obj->saveErrorString($File::GlobMapper::Error) ; - } - $data{Pairs} = $mapper->getFileMap(); - - return $obj; - } - - $obj->croakError("$reportClass: input and output $inType are identical") - if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ; - - if ($inType eq 'fileglob') # && $outType ne 'fileglob' - { - my $glob = cleanFileGlobString($_[0]); - my @inputs = glob($glob); - - if (@inputs == 0) - { - # TODO -- legal or die? - die "globmap matched zero file -- legal or die???" ; - } - elsif (@inputs == 1) - { - $obj->validateInputFilenames($inputs[0]) - or return undef; - $_[0] = $inputs[0] ; - $data{inType} = 'filename' ; - $data{oneInput} = 1; - } - else - { - $obj->validateInputFilenames(@inputs) - or return undef; - $_[0] = [ @inputs ] ; - $data{inType} = 'filenames' ; - } - } - elsif ($inType eq 'filename') - { - $obj->validateInputFilenames($_[0]) - or return undef; - } - elsif ($inType eq 'array') - { - $data{inType} = 'filenames' ; - $obj->validateInputArray($_[0]) - or return undef ; - } - - return $obj->saveErrorString("$reportClass: output buffer is read-only") - if $outType eq 'buffer' && readonly(${ $_[1] }); - - if ($outType eq 'filename' ) - { - $obj->croakError("$reportClass: output filename is undef or null string") - if ! defined $_[1] || $_[1] eq '' ; - } - - return $obj ; -} - -sub Validator::saveErrorString -{ - my $self = shift ; - ${ $self->{Error} } = shift ; - return undef; - -} - -sub Validator::croakError -{ - my $self = shift ; - $self->saveErrorString($_[0]); - croak $_[0]; -} - - - -sub Validator::validateInputFilenames -{ - my $self = shift ; - - foreach my $filename (@_) - { - $self->croakError("$self->{reportClass}: input filename is undef or null string") - if ! defined $filename || $filename eq '' ; - - next if $filename eq '-'; - - if (! -e $filename ) - { - return $self->saveErrorString("input file '$filename' does not exist"); - } - - if (! -r $filename ) - { - return $self->saveErrorString("cannot open file '$filename': $!"); - } - } - - return 1 ; -} - -sub Validator::validateInputArray -{ - my $self = shift ; - - if ( @{ $_[0] } == 0 ) - { - return $self->saveErrorString("empty array reference") ; - } - - foreach my $element ( @{ $_[0] } ) - { - my $inType = whatIsInput($element); - - if (! $inType) - { - $self->croakError("unknown input parameter") ; - } - elsif($inType eq 'filename') - { - $self->validateInputFilenames($element) - or return undef ; - } - else - { - $self->croakError("not a filename") ; - } - } - - return 1 ; -} - -#sub Validator::validateHash -#{ -# my $self = shift ; -# my $href = shift ; -# -# while (my($k, $v) = each %$href) -# { -# my $ktype = whatIsInput($k); -# my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ; -# -# if ($ktype ne 'filename') -# { -# return $self->saveErrorString("hash key not filename") ; -# } -# -# my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ; -# if (! $valid{$vtype}) -# { -# return $self->saveErrorString("hash value not ok") ; -# } -# } -# -# return $self ; -#} - -sub createSelfTiedObject -{ - my $class = shift || (caller)[0] ; - my $error_ref = shift ; - - my $obj = bless Symbol::gensym(), ref($class) || $class; - tie *$obj, $obj if $] >= 5.005; - *$obj->{Closed} = 1 ; - $$error_ref = ''; - *$obj->{Error} = $error_ref ; - my $errno = 0 ; - *$obj->{ErrorNo} = \$errno ; - - return $obj; -} - - -1; diff --git a/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm b/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm deleted file mode 100644 index 540f892..0000000 --- a/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm +++ /dev/null @@ -1,75 +0,0 @@ - -package Compress::Zlib::FileConstants ; - -use strict ; -use warnings; -use bytes; - -require Exporter; - -our ($VERSION, @ISA, @EXPORT); - -$VERSION = '2.000_07'; - -@ISA = qw(Exporter); - -@EXPORT= qw( - - ZLIB_HEADER_SIZE - ZLIB_TRAILER_SIZE - - ZLIB_CMF_CM_OFFSET - ZLIB_CMF_CM_BITS - ZLIB_CMF_CM_DEFLATED - - ZLIB_CMF_CINFO_OFFSET - ZLIB_CMF_CINFO_BITS - - ZLIB_FLG_FCHECK_OFFSET - ZLIB_FLG_FCHECK_BITS - - ZLIB_FLG_FDICT_OFFSET - ZLIB_FLG_FDICT_BITS - - ZLIB_FLG_LEVEL_OFFSET - ZLIB_FLG_LEVEL_BITS - - ZLIB_FLG_LEVEL_FASTEST - ZLIB_FLG_LEVEL_FAST - ZLIB_FLG_LEVEL_DEFAULT - ZLIB_FLG_LEVEL_SLOWEST - - ZLIB_FDICT_SIZE - - ); - -# Constant names derived from RFC1950 - -use constant ZLIB_HEADER_SIZE => 2; -use constant ZLIB_TRAILER_SIZE => 4; - -use constant ZLIB_CMF_CM_OFFSET => 0; -use constant ZLIB_CMF_CM_BITS => 0xF ; # 0b1111 -use constant ZLIB_CMF_CM_DEFLATED => 8; - -use constant ZLIB_CMF_CINFO_OFFSET => 4; -use constant ZLIB_CMF_CINFO_BITS => 0xF ; # 0b1111; - -use constant ZLIB_FLG_FCHECK_OFFSET => 0; -use constant ZLIB_FLG_FCHECK_BITS => 0x1F ; # 0b11111; - -use constant ZLIB_FLG_FDICT_OFFSET => 5; -use constant ZLIB_FLG_FDICT_BITS => 0x1 ; # 0b1; - -use constant ZLIB_FLG_LEVEL_OFFSET => 6; -use constant ZLIB_FLG_LEVEL_BITS => 0x3 ; # 0b11; - -use constant ZLIB_FLG_LEVEL_FASTEST => 0; -use constant ZLIB_FLG_LEVEL_FAST => 1; -use constant ZLIB_FLG_LEVEL_DEFAULT => 2; -use constant ZLIB_FLG_LEVEL_SLOWEST => 3; - -use constant ZLIB_FDICT_SIZE => 4; - - -1; diff --git a/ext/Compress/Zlib/lib/Compress/Zlib/ParseParameters.pm b/ext/Compress/Zlib/lib/Compress/Zlib/ParseParameters.pm deleted file mode 100644 index 71fb45b..0000000 --- a/ext/Compress/Zlib/lib/Compress/Zlib/ParseParameters.pm +++ /dev/null @@ -1,295 +0,0 @@ - -package Compress::Zlib::ParseParameters ; - -use strict; -use warnings; -use Carp; - -require Exporter; -our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.000_07'; -@ISA = qw(Exporter); - -use constant Parse_any => 0x01; -use constant Parse_unsigned => 0x02; -use constant Parse_signed => 0x04; -use constant Parse_boolean => 0x08; -use constant Parse_string => 0x10; -use constant Parse_custom => 0x12; - -use constant Parse_store_ref => 0x100 ; - -use constant OFF_PARSED => 0 ; -use constant OFF_TYPE => 1 ; -use constant OFF_DEFAULT => 2 ; -use constant OFF_FIXED => 3 ; -use constant OFF_FIRST_ONLY => 4 ; -use constant OFF_STICKY => 5 ; - -push @EXPORT, qw( ParseParameters - Parse_any Parse_unsigned Parse_signed - Parse_boolean Parse_custom Parse_string - Parse_store_ref - ); - -sub ParseParameters -{ - my $level = shift || 0 ; - - my $sub = (caller($level + 1))[3] ; - local $Carp::CarpLevel = 1 ; - my $p = new Compress::Zlib::ParseParameters() ; - $p->parse(@_) - or croak "$sub: $p->{Error}" ; - - return $p; -} - -sub new -{ - my $class = shift ; - - my $obj = { Error => '', - Got => {}, - } ; - - #return bless $obj, ref($class) || $class || __PACKAGE__ ; - return bless $obj ; -} - -sub setError -{ - my $self = shift ; - my $error = shift ; - my $retval = @_ ? shift : undef ; - - $self->{Error} = $error ; - return $retval; -} - -#sub getError -#{ -# my $self = shift ; -# return $self->{Error} ; -#} - -sub parse -{ - my $self = shift ; - - my $default = shift ; - - my $got = $self->{Got} ; - my $firstTime = keys %{ $got } == 0 ; - - my (@Bad) ; - my @entered = () ; - - # Allow the options to be passed as a hash reference or - # as the complete hash. - if (@_ == 0) { - @entered = () ; - } - elsif (@_ == 1) { - my $href = $_[0] ; - return $self->setError("Expected even number of parameters, got 1") - if ! defined $href or ! ref $href or ref $href ne "HASH" ; - - foreach my $key (keys %$href) { - push @entered, $key ; - push @entered, \$href->{$key} ; - } - } - else { - my $count = @_; - return $self->setError("Expected even number of parameters, got $count") - if $count % 2 != 0 ; - - for my $i (0.. $count / 2 - 1) { - push @entered, $_[2* $i] ; - push @entered, \$_[2* $i+1] ; - } - } - - - while (my ($key, $v) = each %$default) - { - croak "need 4 params [@$v]" - if @$v != 4 ; - - my ($first_only, $sticky, $type, $value) = @$v ; - my $x ; - $self->_checkType($key, \$value, $type, 0, \$x) - or return undef ; - - $key = lc $key; - - if ($firstTime || ! $sticky) { - $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ; - } - - $got->{$key}[OFF_PARSED] = 0 ; - } - - for my $i (0.. @entered / 2 - 1) { - my $key = $entered[2* $i] ; - my $value = $entered[2* $i+1] ; - - #print "Key [$key] Value [$value]" ; - #print defined $$value ? "[$$value]\n" : "[undef]\n"; - - $key =~ s/^-// ; - my $canonkey = lc $key; - - if ($got->{$canonkey} && ($firstTime || - ! $got->{$canonkey}[OFF_FIRST_ONLY] )) - { - my $type = $got->{$canonkey}[OFF_TYPE] ; - my $s ; - $self->_checkType($key, $value, $type, 1, \$s) - or return undef ; - #$value = $$value unless $type & Parse_store_ref ; - $value = $$value ; - $got->{$canonkey} = [1, $type, $value, $s] ; - } - else - { push (@Bad, $key) } - } - - if (@Bad) { - my ($bad) = join(", ", @Bad) ; - return $self->setError("unknown key value(s) @Bad") ; - } - - return 1; -} - -sub _checkType -{ - my $self = shift ; - - my $key = shift ; - my $value = shift ; - my $type = shift ; - my $validate = shift ; - my $output = shift; - - #local $Carp::CarpLevel = $level ; - #print "PARSE $type $key $value $validate $sub\n" ; - if ( $type & Parse_store_ref) - { - #$value = $$value - # if ref ${ $value } ; - - $$output = $value ; - return 1; - } - - $value = $$value ; - - if ($type & Parse_any) - { - $$output = $value ; - return 1; - } - elsif ($type & Parse_unsigned) - { - return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'") - if $validate && ! defined $value ; - return $self->setError("Parameter '$key' must be an unsigned int, got '$value'") - if $validate && $value !~ /^\d+$/; - - $$output = defined $value ? $value : 0 ; - return 1; - } - elsif ($type & Parse_signed) - { - return $self->setError("Parameter '$key' must be a signed int, got 'undef'") - if $validate && ! defined $value ; - return $self->setError("Parameter '$key' must be a signed int, got '$value'") - if $validate && $value !~ /^-?\d+$/; - - $$output = defined $value ? $value : 0 ; - return 1 ; - } - elsif ($type & Parse_boolean) - { - return $self->setError("Parameter '$key' must be an int, got '$value'") - if $validate && defined $value && $value !~ /^\d*$/; - $$output = defined $value ? $value != 0 : 0 ; - return 1; - } - elsif ($type & Parse_string) - { - $$output = defined $value ? $value : "" ; - return 1; - } - - $$output = $value ; - return 1; -} - - - -sub parsed -{ - my $self = shift ; - my $name = shift ; - - return $self->{Got}{lc $name}[OFF_PARSED] ; -} - -sub value -{ - my $self = shift ; - my $name = shift ; - - if (@_) - { - $self->{Got}{lc $name}[OFF_PARSED] = 1; - $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ; - $self->{Got}{lc $name}[OFF_FIXED] = $_[0] ; - } - - return $self->{Got}{lc $name}[OFF_FIXED] ; -} - -sub valueOrDefault -{ - my $self = shift ; - my $name = shift ; - my $default = shift ; - - my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ; - - return $value if defined $value ; - return $default ; -} - -sub wantValue -{ - my $self = shift ; - my $name = shift ; - - return defined $self->{Got}{lc $name}[OFF_DEFAULT] ; - -} - -sub clone -{ - my $self = shift ; - my $obj = { }; - my %got ; - - while (my ($k, $v) = each %{ $self->{Got} }) { - $got{$k} = [ @$v ]; - } - - $obj->{Error} = $self->{Error}; - $obj->{Got} = \%got ; - - return bless $obj ; -} - -1; - diff --git a/ext/Compress/Zlib/lib/CompressPlugin/Deflate.pm b/ext/Compress/Zlib/lib/CompressPlugin/Deflate.pm deleted file mode 100644 index 28ca794..0000000 --- a/ext/Compress/Zlib/lib/CompressPlugin/Deflate.pm +++ /dev/null @@ -1,164 +0,0 @@ -package CompressPlugin::Deflate ; - -use strict; -use warnings; - -use Compress::Zlib::Common qw(:Status); - -use Compress::Zlib qw(Z_OK Z_FINISH MAX_WBITS) ; -our ($VERSION); - -$VERSION = '2.000_05'; - -sub mkCompObject -{ - my $crc32 = shift ; - my $adler32 = shift ; - my $level = shift ; - my $strategy = shift ; - - my ($def, $status) = new Compress::Zlib::Deflate - -AppendOutput => 1, - -CRC32 => $crc32, - -ADLER32 => $adler32, - -Level => $level, - -Strategy => $strategy, - -WindowBits => - MAX_WBITS; - - return (undef, "Cannot create Deflate object: $status", $status) - if $status != Z_OK; - - return bless {'Def' => $def, - 'CompSize' => 0, - 'UnCompSize' => 0, - 'Error' => '', - } ; -} - -sub compr -{ - my $self = shift ; - - my $def = $self->{Def}; - - my $status = $def->deflate($_[0], $_[1]) ; - $self->{ErrorNo} = $status; - - if ($status != Z_OK) - { - $self->{Error} = "Deflate Error: $status"; - return STATUS_ERROR; - } - - return STATUS_OK; -} - -sub flush -{ - my $self = shift ; - - my $def = $self->{Def}; - - my $opt = $_[1] || Z_FINISH; - my $status = $def->flush($_[0], $opt); - $self->{ErrorNo} = $status; - - if ($status != Z_OK) - { - $self->{Error} = "Deflate Error: $status"; - return STATUS_ERROR; - } - - return STATUS_OK; - -} - -sub close -{ - my $self = shift ; - - my $def = $self->{Def}; - - $def->flush($_[0], Z_FINISH); -} - -sub reset -{ - my $self = shift ; - - my $def = $self->{Def}; - - my $status = $def->deflateReset() ; - $self->{ErrorNo} = $status; - if ($status != Z_OK) - { - $self->{Error} = "Deflate Error: $status"; - return STATUS_ERROR; - } - - return STATUS_OK; -} - -sub deflateParams -{ - my $self = shift ; - - my $def = $self->{Def}; - - my $status = $def->deflateParams(@_); - $self->{ErrorNo} = $status; - if ($status != Z_OK) - { - $self->{Error} = "deflateParams Error: $status"; - return STATUS_ERROR; - } - - return STATUS_OK; -} - - - -sub total_out -{ - my $self = shift ; - $self->{Def}->total_out(); -} - -sub total_in -{ - my $self = shift ; - $self->{Def}->total_in(); -} - -sub compressedBytes -{ - my $self = shift ; - $self->{Def}->compressedBytes(); -} - -sub uncompressedBytes -{ - my $self = shift ; - $self->{Def}->uncompressedBytes(); -} - - - - -sub crc32 -{ - my $self = shift ; - $self->{Def}->crc32(); -} - -sub adler32 -{ - my $self = shift ; - $self->{Def}->adler32(); -} - - -1; - -__END__ - diff --git a/ext/Compress/Zlib/lib/CompressPlugin/Identity.pm b/ext/Compress/Zlib/lib/CompressPlugin/Identity.pm deleted file mode 100644 index db90e97..0000000 --- a/ext/Compress/Zlib/lib/CompressPlugin/Identity.pm +++ /dev/null @@ -1,121 +0,0 @@ -package CompressPlugin::Identity ; - -use strict; -use warnings; - -use Compress::Zlib::Common qw(:Status); -use Compress::Zlib () ; -our ($VERSION); - -$VERSION = '2.000_05'; - -sub mkCompObject -{ - my $crc32 = shift ; - my $adler32 = shift ; - my $level = shift ; - my $strategy = shift ; - - return bless { - 'CompSize' => 0, - 'UnCompSize' => 0, - 'Error' => '', - 'ErrorNo' => 0, - 'wantCRC32' => $crc32, - 'CRC32' => Compress::Zlib::crc32(''), - 'wantADLER32'=> $adler32, - 'ADLER32' => Compress::Zlib::adler32(''), - } ; -} - -sub compr -{ - my $self = shift ; - - if (defined ${ $_[0] } && length ${ $_[0] }) { - $self->{CompSize} += length ${ $_[0] } ; - $self->{UnCompSize} = $self->{CompSize} ; - - $self->{CRC32} = Compress::Zlib::crc32($_[0], $self->{CRC32}) - if $self->{wantCRC32}; - - $self->{ADLER32} = Compress::Zlib::adler32($_[0], $self->{ADLER32}) - if $self->{wantADLER32}; - - ${ $_[1] } .= ${ $_[0] }; - } - - return STATUS_OK ; -} - -sub flush -{ - my $self = shift ; - - return STATUS_OK; -} - -sub close -{ - my $self = shift ; - - return STATUS_OK; -} - -sub reset -{ - my $self = shift ; - - return STATUS_OK; -} - -sub deflateParams -{ - my $self = shift ; - - return STATUS_OK; -} - -sub total_out -{ - my $self = shift ; - return $self->{UnCompSize} ; -} - -sub total_in -{ - my $self = shift ; - return $self->{UnCompSize} ; -} - -sub compressedBytes -{ - my $self = shift ; - return $self->{UnCompSize} ; -} - -sub uncompressedBytes -{ - my $self = shift ; - return $self->{UnCompSize} ; -} - -sub crc32 -{ - my $self = shift ; - return $self->{CRC32}; -} - -sub adler32 -{ - my $self = shift ; - return $self->{ADLER32}; -} - - - -1; - - -__END__ - diff --git a/ext/Compress/Zlib/lib/File/GlobMapper.pm b/ext/Compress/Zlib/lib/File/GlobMapper.pm deleted file mode 100644 index 9e7c217..0000000 --- a/ext/Compress/Zlib/lib/File/GlobMapper.pm +++ /dev/null @@ -1,697 +0,0 @@ -package File::GlobMapper; - -use strict; -use warnings; -use Carp; - -our ($CSH_GLOB); - -BEGIN -{ - if ($] < 5.006) - { - require File::BSDGlob; import File::BSDGlob qw(:glob) ; - $CSH_GLOB = File::BSDGlob::GLOB_CSH() ; - *globber = \&File::BSDGlob::csh_glob; - } - else - { - require File::Glob; import File::Glob qw(:glob) ; - $CSH_GLOB = File::Glob::GLOB_CSH() ; - #*globber = \&File::Glob::bsd_glob; - *globber = \&File::Glob::csh_glob; - } -} - -our ($Error); - -our ($VERSION, @EXPORT_OK); -$VERSION = '0.000_02'; -@EXPORT_OK = qw( globmap ); - - -our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); -$noPreBS = '(? '([^/]*)', - '?' => '([^/])', - '.' => '\.', - '[' => '([', - '(' => '(', - ')' => ')', - ); - -%wildCount = map { $_ => 1 } qw/ * ? . { ( [ /; - -sub globmap ($$;) -{ - my $inputGlob = shift ; - my $outputGlob = shift ; - - my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_) - or croak "globmap: $Error" ; - return $obj->getFileMap(); -} - -sub new -{ - my $class = shift ; - my $inputGlob = shift ; - my $outputGlob = shift ; - # TODO -- flags needs to default to whatever File::Glob does - my $flags = shift || $CSH_GLOB ; - #my $flags = shift ; - - $inputGlob =~ s/^\s*\<\s*//; - $inputGlob =~ s/\s*\>\s*$//; - - $outputGlob =~ s/^\s*\<\s*//; - $outputGlob =~ s/\s*\>\s*$//; - - my %object = - ( InputGlob => $inputGlob, - OutputGlob => $outputGlob, - GlobFlags => $flags, - Braces => 0, - WildCount => 0, - Pairs => [], - Sigil => '#', - ); - - my $self = bless \%object, ref($class) || $class ; - - $self->_parseInputGlob() - or return undef ; - - $self->_parseOutputGlob() - or return undef ; - - my @inputFiles = globber($self->{InputGlob}, $flags) ; - - if (GLOB_ERROR) - { - $Error = $!; - return undef ; - } - - #if (whatever) - { - my $missing = grep { ! -e $_ } @inputFiles ; - - if ($missing) - { - $Error = "$missing input files do not exist"; - return undef ; - } - } - - $self->{InputFiles} = \@inputFiles ; - - $self->_getFiles() - or return undef ; - - return $self; -} - -sub _retError -{ - my $string = shift ; - $Error = "$string in input fileglob" ; - return undef ; -} - -sub _unmatched -{ - my $delimeter = shift ; - - _retError("Unmatched $delimeter"); - return undef ; -} - -sub _parseBit -{ - my $self = shift ; - - my $string = shift ; - - my $out = ''; - my $depth = 0 ; - - while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//) - { - $out .= quotemeta($1) ; - $out .= $mapping{$2} if defined $mapping{$2}; - - ++ $self->{WildCount} if $wildCount{$2} ; - - if ($2 eq ',') - { - return _unmatched "(" - if $depth ; - - $out .= '|'; - } - elsif ($2 eq '(') - { - ++ $depth ; - } - elsif ($2 eq ')') - { - return _unmatched ")" - if ! $depth ; - - -- $depth ; - } - elsif ($2 eq '[') - { - # TODO -- quotemeta & check no '/' - # TODO -- check for \] & other \ within the [] - $string =~ s#(.*?\])## - or return _unmatched "[" ; - $out .= "$1)" ; - } - elsif ($2 eq ']') - { - return _unmatched "]" ; - } - elsif ($2 eq '{' || $2 eq '}') - { - return _retError "Nested {} not allowed" ; - } - } - - $out .= quotemeta $string; - - return _unmatched "(" - if $depth ; - - return $out ; -} - -sub _parseInputGlob -{ - my $self = shift ; - - my $string = $self->{InputGlob} ; - my $inGlob = ''; - - # Multiple concatenated *'s don't make sense - #$string =~ s#\*\*+#*# ; - - # TODO -- Allow space to delimit patterns? - #my @strings = split /\s+/, $string ; - #for my $str (@strings) - my $out = ''; - my $depth = 0 ; - - while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//) - { - $out .= quotemeta($1) ; - $out .= $mapping{$2} if defined $mapping{$2}; - ++ $self->{WildCount} if $wildCount{$2} ; - - if ($2 eq '(') - { - ++ $depth ; - } - elsif ($2 eq ')') - { - return _unmatched ")" - if ! $depth ; - - -- $depth ; - } - elsif ($2 eq '[') - { - # TODO -- quotemeta & check no '/' or '(' or ')' - # TODO -- check for \] & other \ within the [] - $string =~ s#(.*?\])## - or return _unmatched "["; - $out .= "$1)" ; - } - elsif ($2 eq ']') - { - return _unmatched "]" ; - } - elsif ($2 eq '}') - { - return _unmatched "}" ; - } - elsif ($2 eq '{') - { - # TODO -- check no '/' within the {} - # TODO -- check for \} & other \ within the {} - - my $tmp ; - unless ( $string =~ s/(.*?)$noPreBS\}//) - { - return _unmatched "{"; - } - #$string =~ s#(.*?)\}##; - - #my $alt = join '|', - # map { quotemeta $_ } - # split "$noPreBS,", $1 ; - my $alt = $self->_parseBit($1); - defined $alt or return 0 ; - $out .= "($alt)" ; - - ++ $self->{Braces} ; - } - } - - return _unmatched "(" - if $depth ; - - $out .= quotemeta $string ; - - - $self->{InputGlob} =~ s/$noPreBS[\(\)]//g; - $self->{InputPattern} = $out ; - - #print "# INPUT '$self->{InputGlob}' => '$out'\n"; - - return 1 ; - -} - -sub _parseOutputGlob -{ - my $self = shift ; - - my $string = $self->{OutputGlob} ; - my $maxwild = $self->{WildCount}; - - if ($self->{GlobFlags} & GLOB_TILDE) - #if (1) - { - $string =~ s{ - ^ ~ # find a leading tilde - ( # save this in $1 - [^/] # a non-slash character - * # repeated 0 or more times (0 means me) - ) - }{ - $1 - ? (getpwnam($1))[7] - : ( $ENV{HOME} || $ENV{LOGDIR} ) - }ex; - - } - - # max #1 must be == to max no of '*' in input - while ( $string =~ m/#(\d)/g ) - { - croak "Max wild is #$maxwild, you tried #$1" - if $1 > $maxwild ; - } - - my $noPreBS = '(?{OutputGlob}' => '$string'\n"; - $self->{OutputPattern} = $string ; - - return 1 ; -} - -sub _getFiles -{ - my $self = shift ; - - my %outInMapping = (); - my %inFiles = () ; - - foreach my $inFile (@{ $self->{InputFiles} }) - { - next if $inFiles{$inFile} ++ ; - - my $outFile = $inFile ; - - if ( $inFile =~ m/$self->{InputPattern}/ ) - { - no warnings 'uninitialized'; - eval "\$outFile = $self->{OutputPattern};" ; - - if (defined $outInMapping{$outFile}) - { - $Error = "multiple input files map to one output file"; - return undef ; - } - $outInMapping{$outFile} = $inFile; - push @{ $self->{Pairs} }, [$inFile, $outFile]; - } - } - - return 1 ; -} - -sub getFileMap -{ - my $self = shift ; - - return $self->{Pairs} ; -} - -sub getHash -{ - my $self = shift ; - - return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ; -} - -1; - -__END__ - -=head1 NAME - -File::GlobMapper - Extend File Glob to Allow Input and Output Files - -=head1 SYNOPSIS - - use File::GlobMapper qw( globmap ); - - my $aref = globmap $input => $output - or die $File::GlobMapper::Error ; - - my $gm = new File::GlobMapper $input => $output - or die $File::GlobMapper::Error ; - - -=head1 DESCRIPTION - -B - -=over 5 - -=item * This code is a work in progress. - -=item * There are known bugs. - -=item * The interface defined here is tentative. - -=item * There are portability issues. - -=item * Do not use in production code. - -=item * Consider yourself warned! - -=back - -This module needs Perl5.005 or better. - -This module takes the existing C module as a starting point and -extends it to allow new filenames to be derived from the files matched by -C. - -This can be useful when carrying out batch operations on multiple files that -have both an input filename and output filename and the output file can be -derived from the input filename. Examples of operations where this can be -useful include, file renaming, file copying and file compression. - - -=head2 Behind The Scenes - -To help explain what C does, consider what code you -would write if you wanted to rename all files in the current directory -that ended in C<.tar.gz> to C<.tgz>. So say these files are in the -current directory - - alpha.tar.gz - beta.tar.gz - gamma.tar.gz - -and they need renamed to this - - alpha.tgz - beta.tgz - gamma.tgz - -Below is a possible implementation of a script to carry out the rename -(error cases have been omitted) - - foreach my $old ( glob "*.tar.gz" ) - { - my $new = $old; - $new =~ s#(.*)\.tar\.gz$#$1.tgz# ; - - rename $old => $new - or die "Cannot rename '$old' to '$new': $!\n; - } - -Notice that a file glob pattern C<*.tar.gz> was used to match the -C<.tar.gz> files, then a fairly similar regular expression was used in -the substitute to allow the new filename to be created. - -Given that the file glob is just a cut-down regular expression and that it -has already done a lot of the hard work in pattern matching the filenames, -wouldn't it be handy to be able to use the patterns in the fileglob to -drive the new filename? - -Well, that's I what C does. - -Here is same snippet of code rewritten using C - - for my $pair (globmap '<*.tar.gz>' => '<#1.tgz>' ) - { - my ($from, $to) = @$pair; - rename $from => $to - or die "Cannot rename '$old' to '$new': $!\n; - } - -So how does it work? - -Behind the scenes the C function does a combination of a -file glob to match existing filenames followed by a substitute -to create the new filenames. - -Notice how both parameters to C are strings that are delimited by <>. -This is done to make them look more like file globs - it is just syntactic -sugar, but it can be handy when you want the strings to be visually -distinctive. The enclosing <> are optional, so you don't have to use them - in -fact the first thing globmap will do is remove these delimiters if they are -present. - -The first parameter to C, C<*.tar.gz>, is an I. -Once the enclosing "< ... >" is removed, this is passed (more or -less) unchanged to C to carry out a file match. - -Next the fileglob C<*.tar.gz> is transformed behind the scenes into a -full Perl regular expression, with the additional step of wrapping each -transformed wildcard metacharacter sequence in parenthesis. - -In this case the input fileglob C<*.tar.gz> will be transformed into -this Perl regular expression - - ([^/]*)\.tar\.gz - -Wrapping with parenthesis allows the wildcard parts of the Input File -Glob to be referenced by the second parameter to C, C<#1.tgz>, -the I. This parameter operates just like the replacement -part of a substitute command. The difference is that the C<#1> syntax -is used to reference sub-patterns matched in the input fileglob, rather -than the C<$1> syntax that is used with perl regular expressions. In -this case C<#1> is used to refer to the text matched by the C<*> in the -Input File Glob. This makes it easier to use this module where the -parameters to C are typed at the command line. - -The final step involves passing each filename matched by the C<*.tar.gz> -file glob through the derived Perl regular expression in turn and -expanding the output fileglob using it. - -The end result of all this is a list of pairs of filenames. By default -that is what is returned by C. In this example the data structure -returned will look like this - - ( ['alpha.tar.gz' => 'alpha.tgz'], - ['beta.tar.gz' => 'beta.tgz' ], - ['gamma.tar.gz' => 'gamma.tgz'] - ) - - -Each pair is an array reference with two elements - namely the I -filename, that C has matched, and a I filename that is -derived from the I filename. - - - -=head2 Limitations - -C has been kept simple deliberately, so it isn't intended to -solve all filename mapping operations. Under the hood C (or for -older versions of Perl, C) is used to match the files, so you -will never have the flexibility of full Perl regular expression. - -=head2 Input File Glob - -The syntax for an Input FileGlob is identical to C, except -for the following - -=over 5 - -=item 1. - -No nested {} - -=item 2. - -Whitespace does not delimit fileglobs. - -=item 3. - -The use of parenthesis can be used to capture parts of the input filename. - -=item 4. - -If an Input glob matches the same file more than once, only the first -will be used. - -=back - -The syntax - -=over 5 - -=item B<~> - -=item B<~user> - - -=item B<.> - -Matches a literal '.'. -Equivalent to the Perl regular expression - - \. - -=item B<*> - -Matches zero or more characters, except '/'. Equivalent to the Perl -regular expression - - [^/]* - -=item B - -Matches zero or one character, except '/'. Equivalent to the Perl -regular expression - - [^/]? - -=item B<\> - -Backslash is used, as usual, to escape the next character. - -=item B<[]> - -Character class. - -=item B<{,}> - -Alternation - -=item B<()> - -Capturing parenthesis that work just like perl - -=back - -Any other character it taken literally. - -=head2 Output File Glob - -The Output File Glob is a normal string, with 2 glob-like features. - -The first is the '*' metacharacter. This will be replaced by the complete -filename matched by the input file glob. So - - *.c *.Z - -The second is - -Output FileGlobs take the - -=over 5 - -=item "*" - -The "*" character will be replaced with the complete input filename. - -=item #1 - -Patterns of the form /#\d/ will be replaced with the - -=back - -=head2 Returned Data - - -=head1 EXAMPLES - -=head2 A Rename script - -Below is a simple "rename" script that uses C to determine the -source and destination filenames. - - use File::GlobMapper qw(globmap) ; - use File::Copy; - - die "rename: Usage rename 'from' 'to'\n" - unless @ARGV == 2 ; - - my $fromGlob = shift @ARGV; - my $toGlob = shift @ARGV; - - my $pairs = globmap($fromGlob, $toGlob) - or die $File::GlobMapper::Error; - - for my $pair (@$pairs) - { - my ($from, $to) = @$pair; - move $from => $to ; - } - - - -Here is an example that renames all c files to cpp. - - $ rename '*.c' '#1.cpp' - -=head2 A few example globmaps - -Below are a few examples of globmaps - -To copy all your .c file to a backup directory - - '' '' - -If you want to compress all - - '' '<*.gz>' - -To uncompress - - '' '' - -=head1 SEE ALSO - -L - -=head1 AUTHOR - -The I module was written by Paul Marquess, F. - -=head1 COPYRIGHT AND LICENSE - -Copyright (c) 2005 Paul Marquess. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. diff --git a/ext/Compress/Zlib/lib/IO/Compress/Base.pm b/ext/Compress/Zlib/lib/IO/Compress/Base.pm deleted file mode 100644 index e084612..0000000 --- a/ext/Compress/Zlib/lib/IO/Compress/Base.pm +++ /dev/null @@ -1,917 +0,0 @@ - -package IO::Compress::Base ; - -require 5.004 ; - -use strict ; -use warnings; - -use Compress::Zlib::Common; -use Compress::Zlib::ParseParameters; - -use IO::File ; -use Scalar::Util qw(blessed readonly); - -#use File::Glob; -#require Exporter ; -use Carp ; -use Symbol; -use bytes; - -our (@ISA, $VERSION, $got_encode); -@ISA = qw(Exporter IO::File); - -$VERSION = '2.000_05'; - -#Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. - -#$got_encode = 0; -#eval -#{ -# require Encode; -# Encode->import('encode', 'find_encoding'); -#}; -# -#$got_encode = 1 unless $@; - -sub saveStatus -{ - my $self = shift ; - ${ *$self->{ErrorNo} } = shift() + 0 ; - ${ *$self->{Error} } = '' ; - - return ${ *$self->{ErrorNo} } ; -} - - -sub saveErrorString -{ - my $self = shift ; - my $retval = shift ; - ${ *$self->{Error} } = shift ; - ${ *$self->{ErrorNo} } = shift() + 0 if @_ ; - - return $retval; -} - -sub croakError -{ - my $self = shift ; - $self->saveErrorString(0, $_[0]); - croak $_[0]; -} - -sub closeError -{ - my $self = shift ; - my $retval = shift ; - - my $errno = *$self->{ErrorNo}; - my $error = ${ *$self->{Error} }; - - $self->close(); - - *$self->{ErrorNo} = $errno ; - ${ *$self->{Error} } = $error ; - - return $retval; -} - - - -sub error -{ - my $self = shift ; - return ${ *$self->{Error} } ; -} - -sub errorNo -{ - my $self = shift ; - return ${ *$self->{ErrorNo} } ; -} - - -sub writeAt -{ - my $self = shift ; - my $offset = shift; - my $data = shift; - - if (defined *$self->{FH}) { - my $here = tell(*$self->{FH}); - return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) - if $here < 0 ; - seek(*$self->{FH}, $offset, SEEK_SET) - or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; - defined *$self->{FH}->write($data, length $data) - or return $self->saveErrorString(undef, $!, $!) ; - seek(*$self->{FH}, $here, SEEK_SET) - or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; - } - else { - substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ; - } - - return 1; -} - -sub getOneShotParams -{ - return ( 'MultiStream' => [1, 1, Parse_boolean, 1], - ); -} - -sub checkParams -{ - my $self = shift ; - my $class = shift ; - - my $got = shift || Compress::Zlib::ParseParameters::new(); - - $got->parse( - { - # Generic Parameters - 'AutoClose' => [1, 1, Parse_boolean, 0], - #'Encoding' => [1, 1, Parse_any, undef], - 'Strict' => [0, 1, Parse_boolean, 1], - 'Append' => [1, 1, Parse_boolean, 0], - 'BinModeIn' => [1, 1, Parse_boolean, 0], - - $self->getExtraParams(), - *$self->{OneShot} ? $self->getOneShotParams() - : (), - }, - @_) or $self->croakError("${class}: $got->{Error}") ; - - return $got ; -} - -sub _create -{ - my $obj = shift; - my $got = shift; - - *$obj->{Closed} = 1 ; - - my $class = ref $obj; - $obj->croakError("$class: Missing Output parameter") - if ! @_ && ! $got ; - - my $outValue = shift ; - my $oneShot = 1 ; - - if (! $got) - { - $oneShot = 0 ; - $got = $obj->checkParams($class, undef, @_) - or return undef ; - } - - my $lax = ! $got->value('Strict') ; - - my $outType = whatIsOutput($outValue); - - $obj->ckOutputParam($class, $outValue) - or return undef ; - - if ($outType eq 'buffer') { - *$obj->{Buffer} = $outValue; - } - else { - my $buff = "" ; - *$obj->{Buffer} = \$buff ; - } - - # Merge implies Append - my $merge = $got->value('Merge') ; - my $appendOutput = $got->value('Append') || $merge ; - - if ($merge) - { - # Switch off Merge mode if output file/buffer is empty/doesn't exist - if (($outType eq 'buffer' && length $$outValue == 0 ) || - ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) ) - { $merge = 0 } - } - - # If output is a file, check that it is writable - if ($outType eq 'filename' && -e $outValue && ! -w _) - { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) } - - elsif ($outType eq 'handle' && ! -w $outValue) - { return $obj->saveErrorString(undef, "Output filehandle is not writable" ) } - - -# TODO - encoding -# if ($got->parsed('Encoding')) { -# $obj->croakError("$class: Encode module needed to use -Encoding") -# if ! $got_encode; -# -# my $want_encoding = $got->value('Encoding'); -# my $encoding = find_encoding($want_encoding); -# -# $obj->croakError("$class: Encoding '$want_encoding' is not available") -# if ! $encoding; -# -# *$obj->{Encoding} = $encoding; -# } - - $obj->ckParams($got) - or $obj->croakError("${class}: " . $obj->error()); - - - $obj->saveStatus(STATUS_OK) ; - - my $status ; - if (! $merge) - { - *$obj->{Compress} = $obj->mkComp($class, $got) - or return undef; - - *$obj->{BytesWritten} = 0 ; - *$obj->{UnCompSize_32bit} = 0 ; - - *$obj->{Header} = $obj->mkHeader($got) ; - - if ( $outType eq 'buffer') { - ${ *$obj->{Buffer} } = '' - unless $appendOutput ; - ${ *$obj->{Buffer} } .= *$obj->{Header}; - } - else { - if ($outType eq 'handle') { - *$obj->{FH} = $outValue ; - setBinModeOutput(*$obj->{FH}) ; - $outValue->flush() ; - *$obj->{Handle} = 1 ; - if ($appendOutput) - { - seek(*$obj->{FH}, 0, SEEK_END) - or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; - - } - } - elsif ($outType eq 'filename') { - my $mode = '>' ; - $mode = '>>' - if $appendOutput; - *$obj->{FH} = new IO::File "$mode $outValue" - or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; - *$obj->{StdIO} = ($outValue eq '-'); - setBinModeOutput(*$obj->{FH}) ; - } - - - if (length *$obj->{Header}) { - defined *$obj->{FH}->write(*$obj->{Header}, length(*$obj->{Header})) - or return $obj->saveErrorString(undef, $!, $!) ; - } - } - } - else - { - *$obj->{Compress} = $obj->createMerge($outValue, $outType) - or return undef; - } - - *$obj->{Closed} = 0 ; - *$obj->{AutoClose} = $got->value('AutoClose') ; - *$obj->{Output} = $outValue; - *$obj->{ClassName} = $class; - *$obj->{Got} = $got; - *$obj->{OneShot} = 0 ; - - return $obj ; -} - -sub ckOutputParam -{ - my $self = shift ; - my $from = shift ; - my $outType = whatIsOutput($_[0]); - - $self->croakError("$from: output parameter not a filename, filehandle or scalar ref") - if ! $outType ; - - $self->croakError("$from: output filename is undef or null string") - if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ; - - $self->croakError("$from: output buffer is read-only") - if $outType eq 'buffer' && readonly(${ $_[0] }); - - return 1; -} - - -sub _def -{ - my $obj = shift ; - - my $class= (caller)[0] ; - my $name = (caller(1))[3] ; - - $obj->croakError("$name: expected at least 1 parameters\n") - unless @_ >= 1 ; - - my $input = shift ; - my $haveOut = @_ ; - my $output = shift ; - - my $x = new Validator($class, *$obj->{Error}, $name, $input, $output) - or return undef ; - - push @_, $output if $haveOut && $x->{Hash}; - - *$obj->{OneShot} = 1 ; - - my $got = $obj->checkParams($name, undef, @_) - or return undef ; - - $x->{Got} = $got ; - -# if ($x->{Hash}) -# { -# while (my($k, $v) = each %$input) -# { -# $v = \$input->{$k} -# unless defined $v ; -# -# $obj->_singleTarget($x, 1, $k, $v, @_) -# or return undef ; -# } -# -# return keys %$input ; -# } - - if ($x->{GlobMap}) - { - $x->{oneInput} = 1 ; - foreach my $pair (@{ $x->{Pairs} }) - { - my ($from, $to) = @$pair ; - $obj->_singleTarget($x, 1, $from, $to, @_) - or return undef ; - } - - return scalar @{ $x->{Pairs} } ; - } - - if (! $x->{oneOutput} ) - { - my $inFile = ($x->{inType} eq 'filenames' - || $x->{inType} eq 'filename'); - - $x->{inType} = $inFile ? 'filename' : 'buffer'; - - foreach my $in ($x->{oneInput} ? $input : @$input) - { - my $out ; - $x->{oneInput} = 1 ; - - $obj->_singleTarget($x, $inFile, $in, \$out, @_) - or return undef ; - - push @$output, \$out ; - #if ($x->{outType} eq 'array') - # { push @$output, \$out } - #else - # { $output->{$in} = \$out } - } - - return 1 ; - } - - # finally the 1 to 1 and n to 1 - return $obj->_singleTarget($x, 1, $input, $output, @_); - - croak "should not be here" ; -} - -sub _singleTarget -{ - my $obj = shift ; - my $x = shift ; - my $inputIsFilename = shift; - my $input = shift; - - if ($x->{oneInput}) - { - $obj->getFileInfo($x->{Got}, $input) - if isaFilename($input) and $inputIsFilename ; - - my $z = $obj->_create($x->{Got}, @_) - or return undef ; - - - defined $z->_wr2($input, $inputIsFilename) - or return $z->closeError(undef) ; - - return $z->close() ; - } - else - { - my $afterFirst = 0 ; - my $inputIsFilename = ($x->{inType} ne 'array'); - my $keep = $x->{Got}->clone(); - - #for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) - for my $element ( @$input) - { - my $isFilename = isaFilename($element); - - if ( $afterFirst ++ ) - { - defined addInterStream($obj, $element, $isFilename) - or return $obj->closeError(undef) ; - } - else - { - $obj->getFileInfo($x->{Got}, $element) - if $isFilename; - - $obj->_create($x->{Got}, @_) - or return undef ; - } - - defined $obj->_wr2($element, $isFilename) - or return $obj->closeError(undef) ; - - *$obj->{Got} = $keep->clone(); - } - return $obj->close() ; - } - -} - -sub _wr2 -{ - my $self = shift ; - - my $source = shift ; - my $inputIsFilename = shift; - - my $input = $source ; - if (! $inputIsFilename) - { - $input = \$source - if ! ref $source; - } - - if ( ref $input && ref $input eq 'SCALAR' ) - { - return $self->syswrite($input, @_) ; - } - - if ( ! ref $input || isaFilehandle($input)) - { - my $isFilehandle = isaFilehandle($input) ; - - my $fh = $input ; - - if ( ! $isFilehandle ) - { - $fh = new IO::File "<$input" - or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; - } - binmode $fh if *$self->{Got}->valueOrDefault('BinModeIn') ; - - my $status ; - my $buff ; - my $count = 0 ; - while (($status = read($fh, $buff, 4096)) > 0) { - $count += length $buff; - defined $self->syswrite($buff, @_) - or return undef ; - } - - return $self->saveErrorString(undef, $!, $!) - if $status < 0 ; - - if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-') - { - $fh->close() - or return undef ; - } - - return $count ; - } - - croak "Should not be here"; - return undef; -} - -sub addInterStream -{ - my $self = shift ; - my $input = shift ; - my $inputIsFilename = shift ; - - if (*$self->{Got}->value('MultiStream')) - { - $self->getFileInfo(*$self->{Got}, $input) - #if isaFilename($input) and $inputIsFilename ; - if isaFilename($input) ; - - # TODO -- newStream needs to allow gzip/zip header to be modified - return $self->newStream(); - } - elsif (*$self->{Got}->value('AutoFlush')) - { - #return $self->flush(Z_FULL_FLUSH); - } - - return 1 ; -} - -sub TIEHANDLE -{ - return $_[0] if ref($_[0]); - die "OOPS\n" ; -} - -sub UNTIE -{ - my $self = shift ; -} - -sub DESTROY -{ - my $self = shift ; - $self->close() ; - - # TODO - memory leak with 5.8.0 - this isn't called until - # global destruction - # - %{ *$self } = () ; - undef $self ; -} - - - -sub syswrite -{ - my $self = shift ; - - my $buffer ; - if (ref $_[0] ) { - $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" ) - unless ref $_[0] eq 'SCALAR' ; - $buffer = $_[0] ; - } - else { - $buffer = \$_[0] ; - } - - - if (@_ > 1) { - my $slen = defined $$buffer ? length($$buffer) : 0; - my $len = $slen; - my $offset = 0; - $len = $_[1] if $_[1] < $len; - - if (@_ > 2) { - $offset = $_[2] || 0; - $self->croakError(*$self->{ClassName} . "::write: offset outside string") - if $offset > $slen; - if ($offset < 0) { - $offset += $slen; - $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0; - } - my $rem = $slen - $offset; - $len = $rem if $rem < $len; - } - - $buffer = \substr($$buffer, $offset, $len) ; - } - - return 0 if ! defined $$buffer || length $$buffer == 0 ; - - my $buffer_length = defined $$buffer ? length($$buffer) : 0 ; - *$self->{BytesWritten} += $buffer_length ; - my $rest = 0xFFFFFFFF - *$self->{UnCompSize_32bit} ; - if ($buffer_length > $rest) { - *$self->{UnCompSize_32bit} = $buffer_length - $rest - 1; - } - else { - *$self->{UnCompSize_32bit} += $buffer_length ; - } - -# if (*$self->{Encoding}) { -# $$buffer = *$self->{Encoding}->encode($$buffer); -# } - - #my $length = length $$buffer; - my $status = *$self->{Compress}->compr($buffer, *$self->{Buffer}) ; - - return $self->saveErrorString(undef, *$self->{Compress}{Error}, - *$self->{Compress}{ErrorNo}) - if $status == STATUS_ERROR; - - - - if ( defined *$self->{FH} and length ${ *$self->{Buffer} }) { - defined *$self->{FH}->write( ${ *$self->{Buffer} }, length ${ *$self->{Buffer} } ) - or return $self->saveErrorString(undef, $!, $!); - ${ *$self->{Buffer} } = '' ; - } - - return $buffer_length; -} - -sub print -{ - my $self = shift; - - #if (ref $self) { - # $self = *$self{GLOB} ; - #} - - if (defined $\) { - if (defined $,) { - defined $self->syswrite(join($,, @_) . $\); - } else { - defined $self->syswrite(join("", @_) . $\); - } - } else { - if (defined $,) { - defined $self->syswrite(join($,, @_)); - } else { - defined $self->syswrite(join("", @_)); - } - } -} - -sub printf -{ - my $self = shift; - my $fmt = shift; - defined $self->syswrite(sprintf($fmt, @_)); -} - - - -sub flush -{ - my $self = shift ; - my $opt = shift ; - - my $status = *$self->{Compress}->flush(*$self->{Buffer}, $opt) ; - return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) - if $status == STATUS_ERROR; - - if ( defined *$self->{FH} ) { - *$self->{FH}->clearerr(); - defined *$self->{FH}->write(${ *$self->{Buffer} }, length ${ *$self->{Buffer} }) - or return $self->saveErrorString(0, $!, $!); - ${ *$self->{Buffer} } = '' ; - } - - return 1; -} - -sub newStream -{ - my $self = shift ; - - $self->_writeTrailer() - or return 0 ; - - my $got = $self->checkParams('newStream', *$self->{Got}, @_) - or return 0 ; - - $self->ckParams($got) - or $self->croakError("newStream: $self->{Error}"); - - *$self->{Header} = $self->mkHeader($got) ; - ${ *$self->{Buffer} } .= *$self->{Header} ; - - if (defined *$self->{FH}) - { - defined *$self->{FH}->write(${ *$self->{Buffer} }, - length ${ *$self->{Buffer} }) - or return $self->saveErrorString(0, $!, $!); - ${ *$self->{Buffer} } = '' ; - } - - my $status = *$self->{Compress}->reset() ; - return $self->saveErrorString(0, *$self->{Compress}{Error}, - *$self->{Compress}{ErrorNo}) - if $status == STATUS_ERROR; - - *$self->{BytesWritten} = 0 ; - *$self->{UnCompSize_32bit} = 0 ; - - return 1 ; -} - -sub _writeTrailer -{ - my $self = shift ; - - my $status = *$self->{Compress}->close(*$self->{Buffer}) ; - return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) - if $status == STATUS_ERROR; - - my $trailer = $self->mkTrailer(); - defined $trailer - or return 0; - - ${ *$self->{Buffer} } .= $trailer; - - return 1 if ! defined *$self->{FH} ; - - defined *$self->{FH}->write(${ *$self->{Buffer} }, length ${ *$self->{Buffer} }) - or return $self->saveErrorString(0, $!, $!); - - ${ *$self->{Buffer} } = '' ; - - return 1; -} - -sub _writeFinalTrailer -{ - my $self = shift ; - - ${ *$self->{Buffer} } .= $self->mkFinalTrailer(); - - return 1 if ! defined *$self->{FH} ; - - defined *$self->{FH}->write(${ *$self->{Buffer} }, length ${ *$self->{Buffer} }) - or return $self->saveErrorString(0, $!, $!); - - ${ *$self->{Buffer} } = '' ; - - return 1; -} - -sub close -{ - my $self = shift ; - - return 1 if *$self->{Closed} || ! *$self->{Compress} ; - *$self->{Closed} = 1 ; - - untie *$self - if $] >= 5.008 ; - - $self->_writeTrailer() - or return 0 ; - - $self->_writeFinalTrailer() - or return 0 ; - - if (defined *$self->{FH}) { - #if (! *$self->{Handle} || *$self->{AutoClose}) { - if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { - $! = 0 ; - *$self->{FH}->close() - or return $self->saveErrorString(0, $!, $!); - } - delete *$self->{FH} ; - # This delete can set $! in older Perls, so reset the errno - $! = 0 ; - } - - return 1; -} - - -#sub total_in -#sub total_out -#sub msg -# -#sub crc -#{ -# my $self = shift ; -# return *$self->{Compress}->crc32() ; -#} -# -#sub msg -#{ -# my $self = shift ; -# return *$self->{Compress}->msg() ; -#} -# -#sub dict_adler -#{ -# my $self = shift ; -# return *$self->{Compress}->dict_adler() ; -#} -# -#sub get_Level -#{ -# my $self = shift ; -# return *$self->{Compress}->get_Level() ; -#} -# -#sub get_Strategy -#{ -# my $self = shift ; -# return *$self->{Compress}->get_Strategy() ; -#} - - -sub tell -{ - my $self = shift ; - - #return *$self->{Compress}->total_in(); - return *$self->{BytesWritten} ; -} - -sub eof -{ - my $self = shift ; - - return *$self->{Closed} ; -} - - -sub seek -{ - my $self = shift ; - my $position = shift; - my $whence = shift ; - - my $here = $self->tell() ; - my $target = 0 ; - - #use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); - use IO::Handle ; - - if ($whence == IO::Handle::SEEK_SET) { - $target = $position ; - } - elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) { - $target = $here + $position ; - } - else { - $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter"); - } - - # short circuit if seeking to current offset - return 1 if $target == $here ; - - # Outlaw any attempt to seek backwards - $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards") - if $target < $here ; - - # Walk the file to the new offset - my $offset = $target - $here ; - - my $buffer ; - defined $self->syswrite("\x00" x $offset) - or return 0; - - return 1 ; -} - -sub binmode -{ - 1; -# my $self = shift ; -# return defined *$self->{FH} -# ? binmode *$self->{FH} -# : 1 ; -} - -sub fileno -{ - my $self = shift ; - return defined *$self->{FH} - ? *$self->{FH}->fileno() - : undef ; -} - -sub _notAvailable -{ - my $name = shift ; - return sub { croak "$name Not Available: File opened only for output" ; } ; -} - -*read = _notAvailable('read'); -*READ = _notAvailable('read'); -*readline = _notAvailable('readline'); -*READLINE = _notAvailable('readline'); -*getc = _notAvailable('getc'); -*GETC = _notAvailable('getc'); - -*FILENO = \&fileno; -*PRINT = \&print; -*PRINTF = \&printf; -*WRITE = \&syswrite; -*write = \&syswrite; -*SEEK = \&seek; -*TELL = \&tell; -*EOF = \&eof; -*CLOSE = \&close; -*BINMODE = \&binmode; - -#*sysread = \&_notAvailable; -#*syswrite = \&_write; - -1; - -__END__ - diff --git a/ext/Compress/Zlib/lib/IO/Compress/Deflate.pm b/ext/Compress/Zlib/lib/IO/Compress/Deflate.pm deleted file mode 100644 index de438f3..0000000 --- a/ext/Compress/Zlib/lib/IO/Compress/Deflate.pm +++ /dev/null @@ -1,949 +0,0 @@ -package IO::Compress::Deflate ; - -use strict ; -use warnings; - -require Exporter ; - -use IO::Compress::RawDeflate; - -use Compress::Zlib 2 ; -use Compress::Zlib::FileConstants; -use Compress::Zlib::Common qw(createSelfTiedObject); - - -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError); - -$VERSION = '2.000_07'; -$DeflateError = ''; - -@ISA = qw(Exporter IO::Compress::RawDeflate); -@EXPORT_OK = qw( $DeflateError deflate ) ; -%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; -push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; -Exporter::export_ok_tags('all'); - - -sub new -{ - my $class = shift ; - - my $obj = createSelfTiedObject($class, \$DeflateError); - return $obj->_create(undef, @_); -} - -sub deflate -{ - my $obj = createSelfTiedObject(undef, \$DeflateError); - return $obj->_def(@_); -} - - -sub bitmask($$$$) -{ - my $into = shift ; - my $value = shift ; - my $offset = shift ; - my $mask = shift ; - - return $into | (($value & $mask) << $offset ) ; -} - -sub mkDeflateHdr($$$;$) -{ - my $method = shift ; - my $cinfo = shift; - my $level = shift; - my $fdict_adler = shift ; - - my $cmf = 0; - my $flg = 0; - my $fdict = 0; - $fdict = 1 if defined $fdict_adler; - - $cmf = bitmask($cmf, $method, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS); - $cmf = bitmask($cmf, $cinfo, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS); - - $flg = bitmask($flg, $fdict, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS); - $flg = bitmask($flg, $level, ZLIB_FLG_LEVEL_OFFSET, ZLIB_FLG_LEVEL_BITS); - - my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ; - $flg = bitmask($flg, $fcheck, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS); - - my $hdr = pack("CC", $cmf, $flg) ; - $hdr .= pack("N", $fdict_adler) if $fdict ; - - return $hdr; -} - -sub mkHeader -{ - my $self = shift ; - my $param = shift ; - - my $level = $param->value('Level'); - my $strategy = $param->value('Strategy'); - - my $lflag ; - $level = 6 - if $level == Z_DEFAULT_COMPRESSION ; - - if (ZLIB_VERNUM >= 0x1210) - { - if ($strategy >= Z_HUFFMAN_ONLY || $level < 2) - { $lflag = ZLIB_FLG_LEVEL_FASTEST } - elsif ($level < 6) - { $lflag = ZLIB_FLG_LEVEL_FAST } - elsif ($level == 6) - { $lflag = ZLIB_FLG_LEVEL_DEFAULT } - else - { $lflag = ZLIB_FLG_LEVEL_SLOWEST } - } - else - { - $lflag = ($level - 1) >> 1 ; - $lflag = 3 if $lflag > 3 ; - } - - #my $wbits = (MAX_WBITS - 8) << 4 ; - my $wbits = 7; - mkDeflateHdr(ZLIB_CMF_CM_DEFLATED, $wbits, $lflag); -} - -sub ckParams -{ - my $self = shift ; - my $got = shift; - - $got->value('ADLER32' => 1); - return 1 ; -} - - -sub mkTrailer -{ - my $self = shift ; - return pack("N", *$self->{Compress}->adler32()) ; -} - -sub mkFinalTrailer -{ - return ''; -} - -#sub newHeader -#{ -# my $self = shift ; -# return *$self->{Header}; -#} - -sub getExtraParams -{ - my $self = shift ; - return $self->getZlibParams(), -} - -sub getInverseClass -{ - return ('IO::Uncompress::Inflate', - \$IO::Uncompress::Inflate::InflateError); -} - -sub getFileInfo -{ - my $self = shift ; - my $params = shift; - my $file = shift ; - -} - - - -1; - -__END__ - -=head1 NAME - -IO::Compress::Deflate - Perl interface to write RFC 1950 files/buffers - -=head1 SYNOPSIS - - use IO::Compress::Deflate qw(deflate $DeflateError) ; - - - my $status = deflate $input => $output [,OPTS] - or die "deflate failed: $DeflateError\n"; - - my $z = new IO::Compress::Deflate $output [,OPTS] - or die "deflate failed: $DeflateError\n"; - - $z->print($string); - $z->printf($format, $string); - $z->write($string); - $z->syswrite($string [, $length, $offset]); - $z->flush(); - $z->tell(); - $z->eof(); - $z->seek($position, $whence); - $z->binmode(); - $z->fileno(); - $z->newStream( [OPTS] ); - $z->deflateParams(); - $z->close() ; - - $DeflateError ; - - # IO::File mode - - print $z $string; - printf $z $format, $string; - syswrite $z, $string [, $length, $offset]; - flush $z, ; - tell $z - eof $z - seek $z, $position, $whence - binmode $z - fileno $z - close $z ; - - -=head1 DESCRIPTION - - - -B. - -=over 5 - -=item * DO NOT use in production code. - -=item * The documentation is incomplete in places. - -=item * Parts of the interface defined here are tentative. - -=item * Please report any problems you find. - -=back - - - -This module provides a Perl interface that allows writing compressed -data to files or buffer as defined in RFC 1950. - - - - - -For reading RFC 1950 files/buffers, see the companion module -L. - - -=head1 Functional Interface - -A top-level function, C, is provided to carry out -"one-shot" compression between buffers and/or files. For finer -control over the compression process, see the L -section. - - use IO::Compress::Deflate qw(deflate $DeflateError) ; - - deflate $input => $output [,OPTS] - or die "deflate failed: $DeflateError\n"; - - - -The functional interface needs Perl5.005 or better. - - -=head2 deflate $input => $output [, OPTS] - - -C expects at least two parameters, C<$input> and C<$output>. - -=head3 The C<$input> parameter - -The parameter, C<$input>, is used to define the source of -the uncompressed data. - -It can take one of the following forms: - -=over 5 - -=item A filename - -If the C<$input> parameter is a simple scalar, it is assumed to be a -filename. This file will be opened for reading and the input data -will be read from it. - -=item A filehandle - -If the C<$input> parameter is a filehandle, the input data will be -read from it. -The string '-' can be used as an alias for standard input. - -=item A scalar reference - -If C<$input> is a scalar reference, the input data will be read -from C<$$input>. - -=item An array reference - -If C<$input> is an array reference, each element in the array must be a -filename. - -The input data will be read from each file in turn. - -The complete array will be walked to ensure that it only -contains valid filenames before any data is compressed. - - - -=item An Input FileGlob string - -If C<$input> is a string that is delimited by the characters "<" and ">" -C will assume that it is an I. The -input is the list of files that match the fileglob. - -If the fileglob does not match any files ... - -See L for more details. - - -=back - -If the C<$input> parameter is any other type, C will be returned. - - - -=head3 The C<$output> parameter - -The parameter C<$output> is used to control the destination of the -compressed data. This parameter can take one of these forms. - -=over 5 - -=item A filename - -If the C<$output> parameter is a simple scalar, it is assumed to be a -filename. This file will be opened for writing and the compressed -data will be written to it. - -=item A filehandle - -If the C<$output> parameter is a filehandle, the compressed data -will be written to it. -The string '-' can be used as an alias for standard output. - - -=item A scalar reference - -If C<$output> is a scalar reference, the compressed data will be -stored in C<$$output>. - - - -=item An Array Reference - -If C<$output> is an array reference, the compressed data will be -pushed onto the array. - -=item An Output FileGlob - -If C<$output> is a string that is delimited by the characters "<" and ">" -C will assume that it is an I. The -output is the list of files that match the fileglob. - -When C<$output> is an fileglob string, C<$input> must also be a fileglob -string. Anything else is an error. - -=back - -If the C<$output> parameter is any other type, C will be returned. - - - -=head2 Notes - -When C<$input> maps to multiple files/buffers and C<$output> is a single -file/buffer the compressed input files/buffers will all be stored -in C<$output> as a single compressed stream. - - - -=head2 Optional Parameters - -Unless specified below, the optional parameters for C, -C, are the same as those used with the OO interface defined in the -L section below. - -=over 5 - -=item AutoClose =E 0|1 - -This option applies to any input or output data streams to -C that are filehandles. - -If C is specified, and the value is true, it will result in all -input and/or output filehandles being closed once C has -completed. - -This parameter defaults to 0. - - - -=item BinModeIn =E 0|1 - -When reading from a file or filehandle, set C before reading. - -Defaults to 0. - - - - - -=item -Append =E 0|1 - -TODO - - -=back - - - -=head2 Examples - -To read the contents of the file C and write the compressed -data to the file C. - - use strict ; - use warnings ; - use IO::Compress::Deflate qw(deflate $DeflateError) ; - - my $input = "file1.txt"; - deflate $input => "$input.1950" - or die "deflate failed: $DeflateError\n"; - - -To read from an existing Perl filehandle, C<$input>, and write the -compressed data to a buffer, C<$buffer>. - - use strict ; - use warnings ; - use IO::Compress::Deflate qw(deflate $DeflateError) ; - use IO::File ; - - my $input = new IO::File " \$buffer - or die "deflate failed: $DeflateError\n"; - -To compress all files in the directory "/my/home" that match "*.txt" -and store the compressed data in the same directory - - use strict ; - use warnings ; - use IO::Compress::Deflate qw(deflate $DeflateError) ; - - deflate '' => '<*.1950>' - or die "deflate failed: $DeflateError\n"; - -and if you want to compress each file one at a time, this will do the trick - - use strict ; - use warnings ; - use IO::Compress::Deflate qw(deflate $DeflateError) ; - - for my $input ( glob "/my/home/*.txt" ) - { - my $output = "$input.1950" ; - deflate $input => $output - or die "Error compressing '$input': $DeflateError\n"; - } - - -=head1 OO Interface - -=head2 Constructor - -The format of the constructor for C is shown below - - my $z = new IO::Compress::Deflate $output [,OPTS] - or die "IO::Compress::Deflate failed: $DeflateError\n"; - -It returns an C object on success and undef on failure. -The variable C<$DeflateError> will contain an error message on failure. - -If you are running Perl 5.005 or better the object, C<$z>, returned from -IO::Compress::Deflate can be used exactly like an L filehandle. -This means that all normal output file operations can be carried out -with C<$z>. -For example, to write to a compressed file/buffer you can use either of -these forms - - $z->print("hello world\n"); - print $z "hello world\n"; - -The mandatory parameter C<$output> is used to control the destination -of the compressed data. This parameter can take one of these forms. - -=over 5 - -=item A filename - -If the C<$output> parameter is a simple scalar, it is assumed to be a -filename. This file will be opened for writing and the compressed data -will be written to it. - -=item A filehandle - -If the C<$output> parameter is a filehandle, the compressed data will be -written to it. -The string '-' can be used as an alias for standard output. - - -=item A scalar reference - -If C<$output> is a scalar reference, the compressed data will be stored -in C<$$output>. - -=back - -If the C<$output> parameter is any other type, C::new will -return undef. - -=head2 Constructor Options - -C is any combination of the following options: - -=over 5 - -=item -AutoClose =E 0|1 - -This option is only valid when the C<$output> parameter is a filehandle. If -specified, and the value is true, it will result in the C<$output> being -closed once either the C method is called or the C -object is destroyed. - -This parameter defaults to 0. - -=item -Append =E 0|1 - -Opens C<$output> in append mode. - -The behaviour of this option is dependent on the type of C<$output>. - -=over 5 - -=item * A Buffer - -If C<$output> is a buffer and C is enabled, all compressed data -will be append to the end if C<$output>. Otherwise C<$output> will be -cleared before any data is written to it. - -=item * A Filename - -If C<$output> is a filename and C is enabled, the file will be -opened in append mode. Otherwise the contents of the file, if any, will be -truncated before any compressed data is written to it. - -=item * A Filehandle - -If C<$output> is a filehandle, the file pointer will be positioned to the -end of the file via a call to C before any compressed data is written -to it. Otherwise the file pointer will not be moved. - -=back - -This parameter defaults to 0. - -=item -Merge =E 0|1 - -This option is used to compress input data and append it to an existing -compressed data stream in C<$output>. The end result is a single compressed -data stream stored in C<$output>. - - - -It is a fatal error to attempt to use this option when C<$output> is not an -RFC 1950 data stream. - - - -There are a number of other limitations with the C option: - -=over 5 - -=item 1 - -This module needs to have been built with zlib 1.2.1 or better to work. A -fatal error will be thrown if C is used with an older version of -zlib. - -=item 2 - -If C<$output> is a file or a filehandle, it must be seekable. - -=back - - -This parameter defaults to 0. - -=item -Level - -Defines the compression level used by zlib. The value should either be -a number between 0 and 9 (0 means no compression and 9 is maximum -compression), or one of the symbolic constants defined below. - - Z_NO_COMPRESSION - Z_BEST_SPEED - Z_BEST_COMPRESSION - Z_DEFAULT_COMPRESSION - -The default is Z_DEFAULT_COMPRESSION. - -Note, these constants are not imported by C by default. - - use IO::Compress::Deflate qw(:strategy); - use IO::Compress::Deflate qw(:constants); - use IO::Compress::Deflate qw(:all); - -=item -Strategy - -Defines the strategy used to tune the compression. Use one of the symbolic -constants defined below. - - Z_FILTERED - Z_HUFFMAN_ONLY - Z_RLE - Z_FIXED - Z_DEFAULT_STRATEGY - -The default is Z_DEFAULT_STRATEGY. - - - - - -=item -Strict =E 0|1 - - - -This is a placeholder option. - - - -=back - -=head2 Examples - -TODO - -=head1 Methods - -=head2 print - -Usage is - - $z->print($data) - print $z $data - -Compresses and outputs the contents of the C<$data> parameter. This -has the same behaviour as the C built-in. - -Returns true if successful. - -=head2 printf - -Usage is - - $z->printf($format, $data) - printf $z $format, $data - -Compresses and outputs the contents of the C<$data> parameter. - -Returns true if successful. - -=head2 syswrite - -Usage is - - $z->syswrite $data - $z->syswrite $data, $length - $z->syswrite $data, $length, $offset - - syswrite $z, $data - syswrite $z, $data, $length - syswrite $z, $data, $length, $offset - -Compresses and outputs the contents of the C<$data> parameter. - -Returns the number of uncompressed bytes written, or C if -unsuccessful. - -=head2 write - -Usage is - - $z->write $data - $z->write $data, $length - $z->write $data, $length, $offset - -Compresses and outputs the contents of the C<$data> parameter. - -Returns the number of uncompressed bytes written, or C if -unsuccessful. - -=head2 flush - -Usage is - - $z->flush; - $z->flush($flush_type); - flush $z ; - flush $z $flush_type; - -Flushes any pending compressed data to the output file/buffer. - -This method takes an optional parameter, C<$flush_type>, that controls -how the flushing will be carried out. By default the C<$flush_type> -used is C. Other valid values for C<$flush_type> are -C, C, C and C. It is -strongly recommended that you only set the C parameter if -you fully understand the implications of what it does - overuse of C -can seriously degrade the level of compression achieved. See the C -documentation for details. - -Returns true on success. - - -=head2 tell - -Usage is - - $z->tell() - tell $z - -Returns the uncompressed file offset. - -=head2 eof - -Usage is - - $z->eof(); - eof($z); - - - -Returns true if the C method has been called. - - - -=head2 seek - - $z->seek($position, $whence); - seek($z, $position, $whence); - - - - -Provides a sub-set of the C functionality, with the restriction -that it is only legal to seek forward in the output file/buffer. -It is a fatal error to attempt to seek backward. - -Empty parts of the file/buffer will have NULL (0x00) bytes written to them. - - - -The C<$whence> parameter takes one the usual values, namely SEEK_SET, -SEEK_CUR or SEEK_END. - -Returns 1 on success, 0 on failure. - -=head2 binmode - -Usage is - - $z->binmode - binmode $z ; - -This is a noop provided for completeness. - -=head2 fileno - - $z->fileno() - fileno($z) - -If the C<$z> object is associated with a file, this method will return -the underlying filehandle. - -If the C<$z> object is is associated with a buffer, this method will -return undef. - -=head2 close - - $z->close() ; - close $z ; - - - -Flushes any pending compressed data and then closes the output file/buffer. - - - -For most versions of Perl this method will be automatically invoked if -the IO::Compress::Deflate object is destroyed (either explicitly or by the -variable with the reference to the object going out of scope). The -exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In -these cases, the C method will be called automatically, but -not until global destruction of all live objects when the program is -terminating. - -Therefore, if you want your scripts to be able to run on all versions -of Perl, you should call C explicitly and not rely on automatic -closing. - -Returns true on success, otherwise 0. - -If the C option has been enabled when the IO::Compress::Deflate -object was created, and the object is associated with a file, the -underlying file will also be closed. - - - - -=head2 newStream([OPTS]) - -Usage is - - $z->newStream( [OPTS] ) - -Closes the current compressed data stream and starts a new one. - -OPTS consists of the following sub-set of the the options that are -available when creating the C<$z> object, - -=over 5 - -=item * Level - -=item * TODO - -=back - -=head2 deflateParams - -Usage is - - $z->deflateParams - -TODO - -=head1 Importing - -A number of symbolic constants are required by some methods in -C. None are imported by default. - -=over 5 - -=item :all - -Imports C, C<$DeflateError> and all symbolic -constants that can be used by C. Same as doing this - - use IO::Compress::Deflate qw(deflate $DeflateError :constants) ; - -=item :constants - -Import all symbolic constants. Same as doing this - - use IO::Compress::Deflate qw(:flush :level :strategy) ; - -=item :flush - -These symbolic constants are used by the C method. - - Z_NO_FLUSH - Z_PARTIAL_FLUSH - Z_SYNC_FLUSH - Z_FULL_FLUSH - Z_FINISH - Z_BLOCK - - -=item :level - -These symbolic constants are used by the C option in the constructor. - - Z_NO_COMPRESSION - Z_BEST_SPEED - Z_BEST_COMPRESSION - Z_DEFAULT_COMPRESSION - - -=item :strategy - -These symbolic constants are used by the C option in the constructor. - - Z_FILTERED - Z_HUFFMAN_ONLY - Z_RLE - Z_FIXED - Z_DEFAULT_STRATEGY - -=back - -For - -=head1 EXAMPLES - -TODO - - - - - - -=head1 SEE ALSO - -L, L, L, L, L, L, L - -L - -L, L, -L - -For RFC 1950, 1951 and 1952 see -F, -F and -F - -The primary site for the gzip program is F. - -=head1 AUTHOR - -The I module was written by Paul Marquess, -F. The latest copy of the module can be -found on CPAN in F. - -The I compression library was written by Jean-loup Gailly -F and Mark Adler F. - -The primary site for the I compression library is -F. - -=head1 MODIFICATION HISTORY - -See the Changes file. - -=head1 COPYRIGHT AND LICENSE - - -Copyright (c) 2005-2006 Paul Marquess. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - - - - diff --git a/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm b/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm deleted file mode 100644 index 840a687..0000000 --- a/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm +++ /dev/null @@ -1,1425 +0,0 @@ - -package IO::Compress::Gzip ; - -require 5.004 ; - -use strict ; -use warnings; - - -use IO::Compress::RawDeflate; - -use Compress::Zlib 2 ; -use Compress::Zlib::Common qw(:Status createSelfTiedObject); -use Compress::Gzip::Constants; - -BEGIN -{ - if (defined &utf8::downgrade ) - { *noUTF8 = \&utf8::downgrade } - else - { *noUTF8 = sub {} } -} - -require Exporter ; - -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); - -$VERSION = '2.000_07'; -$GzipError = '' ; - -@ISA = qw(Exporter IO::Compress::RawDeflate); -@EXPORT_OK = qw( $GzipError gzip ) ; -%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; -push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; -Exporter::export_ok_tags('all'); - -sub new -{ - my $class = shift ; - - my $obj = createSelfTiedObject($class, \$GzipError); - - $obj->_create(undef, @_); -} - - -sub gzip -{ - my $obj = createSelfTiedObject(undef, \$GzipError); - return $obj->_def(@_); -} - -#sub newHeader -#{ -# my $self = shift ; -# #return GZIP_MINIMUM_HEADER ; -# return $self->mkHeader(*$self->{Got}); -#} - -sub getExtraParams -{ - my $self = shift ; - - use Compress::Zlib::ParseParameters; - - return ( - # zlib behaviour - $self->getZlibParams(), - - # Gzip header fields - 'Minimal' => [0, 1, Parse_boolean, 0], - 'Comment' => [0, 1, Parse_any, undef], - 'Name' => [0, 1, Parse_any, undef], - 'Time' => [0, 1, Parse_any, undef], - 'TextFlag' => [0, 1, Parse_boolean, 0], - 'HeaderCRC' => [0, 1, Parse_boolean, 0], - 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Zlib::gzip_os_code], - 'ExtraField'=> [0, 1, Parse_string, undef], - 'ExtraFlags'=> [0, 1, Parse_any, undef], - - ); -} - - -sub ckParams -{ - my $self = shift ; - my $got = shift ; - - # gzip always needs crc32 - $got->value('CRC32' => 1); - - return 1 - if $got->value('Merge') ; - - my $lax = ! $got->value('Strict') ; - - - { - if (! $got->parsed('Time') ) { - # Modification time defaults to now. - $got->value('Time' => time) ; - } - - # Check that the Name & Comment don't have embedded NULLs - # Also check that they only contain ISO 8859-1 chars. - if ($got->parsed('Name') && defined $got->value('Name')) { - my $name = $got->value('Name'); - - return $self->saveErrorString(undef, "Null Character found in Name", - Z_DATA_ERROR) - if ! $lax && $name =~ /\x00/ ; - - return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name", - Z_DATA_ERROR) - if ! $lax && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ; - } - - if ($got->parsed('Comment') && defined $got->value('Comment')) { - my $comment = $got->value('Comment'); - - return $self->saveErrorString(undef, "Null Character found in Comment", - Z_DATA_ERROR) - if ! $lax && $comment =~ /\x00/ ; - - return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment", - Z_DATA_ERROR) - if ! $lax && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o; - } - - if ($got->parsed('OS_Code') ) { - my $value = $got->value('OS_Code'); - - return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'") - if $value < 0 || $value > 255 ; - - } - - # gzip only supports Deflate at present - $got->value('Method' => Z_DEFLATED) ; - - if ( ! $got->parsed('ExtraFlags')) { - $got->value('ExtraFlags' => 2) - if $got->value('Level') == Z_BEST_SPEED ; - $got->value('ExtraFlags' => 4) - if $got->value('Level') == Z_BEST_COMPRESSION ; - } - - if ($got->parsed('ExtraField')) { - - my $bad = $self->parseExtraField($got, $lax) ; - return $self->saveErrorString(undef, $bad, Z_DATA_ERROR) - if $bad ; - - my $len = length $got->value('ExtraField') ; - return $self->saveErrorString(undef, ExtraFieldError("Too Large"), - Z_DATA_ERROR) - if $len > GZIP_FEXTRA_MAX_SIZE; - } - } - - return 1; -} - -sub mkTrailer -{ - my $self = shift ; - return pack("V V", *$self->{Compress}->crc32(), - *$self->{UnCompSize_32bit}); -} - -sub getInverseClass -{ - return ('IO::Uncompress::Gunzip', - \$IO::Uncompress::Gunzip::GunzipError); -} - -sub getFileInfo -{ - my $self = shift ; - my $params = shift; - my $filename = shift ; - - my $defaultTime = (stat($filename))[9] ; - - $params->value('Name' => $filename) - if ! $params->parsed('Name') ; - - $params->value('Time' => $defaultTime) - if ! $params->parsed('Time') ; -} - - -sub mkHeader -{ - my $self = shift ; - my $param = shift ; - - # stort-circuit if a minimal header is requested. - return GZIP_MINIMUM_HEADER if $param->value('Minimal') ; - - # METHOD - my $method = $param->valueOrDefault('Method', GZIP_CM_DEFLATED) ; - - # FLAGS - my $flags = GZIP_FLG_DEFAULT ; - $flags |= GZIP_FLG_FTEXT if $param->value('TextFlag') ; - $flags |= GZIP_FLG_FHCRC if $param->value('HeaderCRC') ; - $flags |= GZIP_FLG_FEXTRA if $param->wantValue('ExtraField') ; - $flags |= GZIP_FLG_FNAME if $param->wantValue('Name') ; - $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('Comment') ; - - # MTIME - my $time = $param->valueOrDefault('Time', GZIP_MTIME_DEFAULT) ; - - # EXTRA FLAGS - my $extra_flags = $param->valueOrDefault('ExtraFlags', GZIP_XFL_DEFAULT); - - # OS CODE - my $os_code = $param->valueOrDefault('OS_Code', GZIP_OS_DEFAULT) ; - - - my $out = pack("C4 V C C", - GZIP_ID1, # ID1 - GZIP_ID2, # ID2 - $method, # Compression Method - $flags, # Flags - $time, # Modification Time - $extra_flags, # Extra Flags - $os_code, # Operating System Code - ) ; - - # EXTRA - if ($flags & GZIP_FLG_FEXTRA) { - my $extra = $param->value('ExtraField') ; - $out .= pack("v", length $extra) . $extra ; - } - - # NAME - if ($flags & GZIP_FLG_FNAME) { - my $name .= $param->value('Name') ; - $name =~ s/\x00.*$//; - $out .= $name ; - # Terminate the filename with NULL unless it already is - $out .= GZIP_NULL_BYTE - if !length $name or - substr($name, 1, -1) ne GZIP_NULL_BYTE ; - } - - # COMMENT - if ($flags & GZIP_FLG_FCOMMENT) { - my $comment .= $param->value('Comment') ; - $comment =~ s/\x00.*$//; - $out .= $comment ; - # Terminate the comment with NULL unless it already is - $out .= GZIP_NULL_BYTE - if ! length $comment or - substr($comment, 1, -1) ne GZIP_NULL_BYTE; - } - - # HEADER CRC - $out .= pack("v", crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ; - - noUTF8($out); - - return $out ; -} - -sub ExtraFieldError -{ - return "Error with ExtraField Parameter: $_[0]" ; -} - -sub validateExtraFieldPair -{ - my $pair = shift ; - my $lax = shift ; - - return ExtraFieldError("Not an array ref") - unless ref $pair && ref $pair eq 'ARRAY'; - - return ExtraFieldError("SubField must have two parts") - unless @$pair == 2 ; - - return ExtraFieldError("SubField ID is a reference") - if ref $pair->[0] ; - - return ExtraFieldError("SubField Data is a reference") - if ref $pair->[1] ; - - # ID is exactly two chars - return ExtraFieldError("SubField ID not two chars long") - unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; - - # Check that the 2nd byte of the ID isn't 0 - return ExtraFieldError("SubField ID 2nd byte is 0x00") - if ! $lax && substr($pair->[0], 1, 1) eq "\x00" ; - - return ExtraFieldError("SubField Data too long") - if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ; - - - return undef ; -} - -sub parseExtra -{ - my $data = shift ; - my $lax = shift ; - - return undef - if $lax ; - - my $XLEN = length $data ; - - return ExtraFieldError("Too Large") - if $XLEN > GZIP_FEXTRA_MAX_SIZE; - - my $offset = 0 ; - while ($offset < $XLEN) { - - return ExtraFieldError("FEXTRA Body") - if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); - $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; - - my $subLen = unpack("v", substr($data, $offset, - GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); - $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; - - return ExtraFieldError("FEXTRA Body") - if $offset + $subLen > $XLEN ; - - my $bad = validateExtraFieldPair( [$id, - substr($data, $offset, $subLen)], $lax ); - return $bad if $bad ; - - $offset += $subLen ; - } - - return undef ; -} - -sub parseExtraField -{ - my $self = shift ; - my $got = shift ; - my $lax = shift ; - - # ExtraField can be any of - # - # -ExtraField => $data - # -ExtraField => [$id1, $data1, - # $id2, $data2] - # ... - # ] - # -ExtraField => [ [$id1 => $data1], - # [$id2 => $data2], - # ... - # ] - # -ExtraField => { $id1 => $data1, - # $id2 => $data2, - # ... - # } - - - return undef - unless $got->parsed('ExtraField') ; - - return parseExtra($got->value('ExtraField'), $lax) - unless ref $got->value('ExtraField') ; - - my $data = $got->value('ExtraField'); - my $out = '' ; - - if (ref $data eq 'ARRAY') { - if (ref $data->[0]) { - - foreach my $pair (@$data) { - return ExtraFieldError("Not list of lists") - unless ref $pair eq 'ARRAY' ; - - my $bad = validateExtraFieldPair($pair, $lax) ; - return $bad if $bad ; - - $out .= $pair->[0] . pack("v", length $pair->[1]) . - $pair->[1] ; - } - } - else { - return ExtraFieldError("Not even number of elements") - unless @$data % 2 == 0; - - for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) { - my $bad = validateExtraFieldPair([$data->[$ix], $data->[$ix+1]], $lax) ; - return $bad if $bad ; - - $out .= $data->[$ix] . pack("v", length $data->[$ix+1]) . - $data->[$ix+1] ; - } - } - } - elsif (ref $data eq 'HASH') { - while (my ($id, $info) = each %$data) { - my $bad = validateExtraFieldPair([$id, $info], $lax); - return $bad if $bad ; - - $out .= $id . pack("v", length $info) . $info ; - } - } - else { - return ExtraFieldError("Not a scalar, array ref or hash ref") ; - } - - $got->value('ExtraField' => $out); - - return undef; -} - -sub mkFinalTrailer -{ - return ''; -} - -1; - -__END__ - -=head1 NAME - -IO::Compress::Gzip - Perl interface to write RFC 1952 files/buffers - -=head1 SYNOPSIS - - use IO::Compress::Gzip qw(gzip $GzipError) ; - - - my $status = gzip $input => $output [,OPTS] - or die "gzip failed: $GzipError\n"; - - my $z = new IO::Compress::Gzip $output [,OPTS] - or die "gzip failed: $GzipError\n"; - - $z->print($string); - $z->printf($format, $string); - $z->write($string); - $z->syswrite($string [, $length, $offset]); - $z->flush(); - $z->tell(); - $z->eof(); - $z->seek($position, $whence); - $z->binmode(); - $z->fileno(); - $z->newStream( [OPTS] ); - $z->deflateParams(); - $z->close() ; - - $GzipError ; - - # IO::File mode - - print $z $string; - printf $z $format, $string; - syswrite $z, $string [, $length, $offset]; - flush $z, ; - tell $z - eof $z - seek $z, $position, $whence - binmode $z - fileno $z - close $z ; - - -=head1 DESCRIPTION - - - -B. - -=over 5 - -=item * DO NOT use in production code. - -=item * The documentation is incomplete in places. - -=item * Parts of the interface defined here are tentative. - -=item * Please report any problems you find. - -=back - - - -This module provides a Perl interface that allows writing compressed -data to files or buffer as defined in RFC 1952. - - -All the gzip headers defined in RFC 1952 can be created using -this module. - - - - -For reading RFC 1952 files/buffers, see the companion module -L. - - -=head1 Functional Interface - -A top-level function, C, is provided to carry out -"one-shot" compression between buffers and/or files. For finer -control over the compression process, see the L -section. - - use IO::Compress::Gzip qw(gzip $GzipError) ; - - gzip $input => $output [,OPTS] - or die "gzip failed: $GzipError\n"; - - - -The functional interface needs Perl5.005 or better. - - -=head2 gzip $input => $output [, OPTS] - - -C expects at least two parameters, C<$input> and C<$output>. - -=head3 The C<$input> parameter - -The parameter, C<$input>, is used to define the source of -the uncompressed data. - -It can take one of the following forms: - -=over 5 - -=item A filename - -If the C<$input> parameter is a simple scalar, it is assumed to be a -filename. This file will be opened for reading and the input data -will be read from it. - -=item A filehandle - -If the C<$input> parameter is a filehandle, the input data will be -read from it. -The string '-' can be used as an alias for standard input. - -=item A scalar reference - -If C<$input> is a scalar reference, the input data will be read -from C<$$input>. - -=item An array reference - -If C<$input> is an array reference, each element in the array must be a -filename. - -The input data will be read from each file in turn. - -The complete array will be walked to ensure that it only -contains valid filenames before any data is compressed. - - - -=item An Input FileGlob string - -If C<$input> is a string that is delimited by the characters "<" and ">" -C will assume that it is an I. The -input is the list of files that match the fileglob. - -If the fileglob does not match any files ... - -See L for more details. - - -=back - -If the C<$input> parameter is any other type, C will be returned. - - - -In addition, if C<$input> is a simple filename, the default values for -two of the gzip header fields created by this function will be sourced -from that file -- the NAME gzip header field will be populated with -the filename itself, and the MTIME header field will be set to the -modification time of the file. -The intention here is to mirror part of the behaviour of the gzip -executable. -If you do not want to use these defaults they can be overridden by -explicitly setting the C and C