From: Rafael Garcia-Suarez Date: Wed, 5 Oct 2005 15:53:34 +0000 (+0000) Subject: Upgrade to Compress::Zlib 2.000_05 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=642e522ca519399524c3fc05cc7ff04ae62b068a;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Compress::Zlib 2.000_05 p4raw-id: //depot/perl@25695 --- diff --git a/MANIFEST b/MANIFEST index 839f353..6d96e25 100644 --- a/MANIFEST +++ b/MANIFEST @@ -149,34 +149,65 @@ ext/Cwd/ppport.h portability header for Cwd ext/Cwd/t/cwd.t See if Cwd works ext/Cwd/t/taint.t See if Cwd works with taint ext/Cwd/t/win32.t See if Cwd works on Win32 -ext/Compress/Zlib/ANNOUNCE Compress::Zlib -ext/Compress/Zlib/Makefile.PL Compress::Zlib -ext/Compress/Zlib/README Compress::Zlib ext/Compress/Zlib/Changes Compress::Zlib -ext/Compress/Zlib/Zlib.pm Compress::Zlib -ext/Compress/Zlib/Zlib.xs Compress::Zlib ext/Compress/Zlib/config.in 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/gzcat.zlib Compress::Zlib ext/Compress/Zlib/examples/gzgrep Compress::Zlib ext/Compress/Zlib/examples/gzstream Compress::Zlib -ext/Compress/Zlib/fallback.h Compress::Zlib -ext/Compress/Zlib/fallback.xs Compress::Zlib -ext/Compress/Zlib/t/01version.t Compress::Zlib -ext/Compress/Zlib/t/02zlib.t Compress::Zlib -ext/Compress/Zlib/t/03examples.t Compress::Zlib -ext/Compress/Zlib/t/04encoding.t Compress::Zlib -ext/Compress/Zlib/t/05gzsetp.t Compress::Zlib -ext/Compress/Zlib/t/06gzdopen.t Compress::Zlib -ext/Compress/Zlib/typemap Compress::Zlib +ext/Compress/Zlib/fallback/constants.h Compress::Zlib +ext/Compress/Zlib/fallback/constants.xs Compress::Zlib +ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm Compress::Zlib +ext/Compress/Zlib/lib/Compress/Zlib/Common.pm Compress::Zlib +ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm Compress::Zlib +ext/Compress/Zlib/lib/Compress/Zlib/ParseParameters.pm Compress::Zlib +ext/Compress/Zlib/lib/File/GlobMapper.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Compress/Deflate.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Compress/Gzip.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Compress/RawDeflate.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Uncompress/AnyInflate.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Uncompress/Gunzip.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Uncompress/Inflate.pm Compress::Zlib +ext/Compress/Zlib/lib/IO/Uncompress/RawInflate.pm Compress::Zlib +ext/Compress/Zlib/Makefile.PL Compress::Zlib +ext/Compress/Zlib/pod/FAQ.pod Compress::Zlib +ext/Compress/Zlib/ppport.h Compress::Zlib +ext/Compress/Zlib/README Compress::Zlib +ext/Compress/Zlib/t/01version.t Compress::Zlib +ext/Compress/Zlib/t/02zlib.t Compress::Zlib +ext/Compress/Zlib/t/03zlib-v1.t Compress::Zlib +ext/Compress/Zlib/t/04def.t Compress::Zlib +ext/Compress/Zlib/t/05examples.t Compress::Zlib +ext/Compress/Zlib/t/06gzsetp.t Compress::Zlib +ext/Compress/Zlib/t/07bufsize.t Compress::Zlib +ext/Compress/Zlib/t/08encoding.t Compress::Zlib +ext/Compress/Zlib/t/09gziphdr.t Compress::Zlib +ext/Compress/Zlib/t/10defhdr.t Compress::Zlib +ext/Compress/Zlib/t/11truncate.t Compress::Zlib +ext/Compress/Zlib/t/12any.t Compress::Zlib +ext/Compress/Zlib/t/13prime.t Compress::Zlib +ext/Compress/Zlib/t/14gzopen.t Compress::Zlib +ext/Compress/Zlib/t/15multi.t Compress::Zlib +ext/Compress/Zlib/t/16oneshot.t Compress::Zlib +ext/Compress/Zlib/t/17isize.t Compress::Zlib +ext/Compress/Zlib/t/18lvalue.t Compress::Zlib +ext/Compress/Zlib/t/19destroy.t Compress::Zlib +ext/Compress/Zlib/t/20tied.t Compress::Zlib +ext/Compress/Zlib/t/21newtied.t Compress::Zlib +ext/Compress/Zlib/t/22merge.t Compress::Zlib +ext/Compress/Zlib/t/23misc.t Compress::Zlib +ext/Compress/Zlib/t/99pod.t Compress::Zlib +ext/Compress/Zlib/t/globmapper.t Compress::Zlib +ext/Compress/Zlib/typemap Compress::Zlib +ext/Compress/Zlib/Zlib.pm Compress::Zlib ext/Compress/Zlib/zlib-src/adler32.c Compress::Zlib ext/Compress/Zlib/zlib-src/compress.c Compress::Zlib ext/Compress/Zlib/zlib-src/crc32.c Compress::Zlib ext/Compress/Zlib/zlib-src/crc32.h Compress::Zlib ext/Compress/Zlib/zlib-src/deflate.c Compress::Zlib ext/Compress/Zlib/zlib-src/deflate.h Compress::Zlib -ext/Compress/Zlib/zlib-src/gzio.c Compress::Zlib ext/Compress/Zlib/zlib-src/infback.c Compress::Zlib ext/Compress/Zlib/zlib-src/inffast.c Compress::Zlib ext/Compress/Zlib/zlib-src/inffast.h Compress::Zlib @@ -189,9 +220,10 @@ ext/Compress/Zlib/zlib-src/trees.c Compress::Zlib ext/Compress/Zlib/zlib-src/trees.h Compress::Zlib ext/Compress/Zlib/zlib-src/uncompr.c Compress::Zlib ext/Compress/Zlib/zlib-src/zconf.h Compress::Zlib -ext/Compress/Zlib/zlib-src/zlib.h Compress::Zlib +ext/Compress/Zlib/zlib-src/zlib.h Compress::Zlib ext/Compress/Zlib/zlib-src/zutil.c Compress::Zlib ext/Compress/Zlib/zlib-src/zutil.h Compress::Zlib +ext/Compress/Zlib/Zlib.xs Compress::Zlib ext/Data/Dumper/Changes Data pretty printer, changelog ext/Data/Dumper/Dumper.pm Data pretty printer, module ext/Data/Dumper/Dumper.xs Data pretty printer, externals @@ -2187,6 +2219,7 @@ lib/vmsish.t Tests for vmsish.pm lib/warnings.pm For "use warnings" lib/warnings/register.pm For "use warnings::register" lib/warnings.t See if warning controls work +lib/ZlibTestUtils.pm Compress::Zlib locale.c locale-specific utility functions makeaperl.SH perl script that produces a new perl binary makedef.pl Create symbol export lists for linking diff --git a/ext/Compress/Zlib/ANNOUNCE b/ext/Compress/Zlib/ANNOUNCE deleted file mode 100644 index 5bb34cd..0000000 --- a/ext/Compress/Zlib/ANNOUNCE +++ /dev/null @@ -1,51 +0,0 @@ - Compress::Zlib - 1.00 - -Announcing release 1.00 of Compress::Zlib (formerly known as Zip -in the module list). - -What is Compress::Zlib? -======================= - -Compress::Zlib is a Perl external module which provides an interface to -the info-zip zlib compression library. zlib is a general purpose -compression library. - -Some of the features provided by Compress::Zlib include: - - * in-memory compression and decompression - * read and write gzip (.gz) files directly. - -By way of an example here is a small script which reads gzipped files -and writes the unzipped output to standard output. - - - use Compress::Zlib ; - - die "Usage: gzcat file...\n" - unless @ARGV ; - - foreach $file (@ARGV) { - $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; - - print $buffer while $gz->gzread($buffer) > 0 ; - - die "Error reading from $file: $gzerrno\n" if $gzerrno ; - - $gz->gzclose() ; - } - - -Availability -============ - -The latest copy of Compress::ZLib is available on CPAN - - http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz - -and zlib is available at - - http://www.gzip.org/zlib/ - - -Paul Marquess diff --git a/ext/Compress/Zlib/Changes b/ext/Compress/Zlib/Changes index aa9bcc0..93ddaeb 100644 --- a/ext/Compress/Zlib/Changes +++ b/ext/Compress/Zlib/Changes @@ -1,13 +1,44 @@ CHANGES ------- - 1.40 - 23 September 2005 + 2.000_05 4 October 2005 - * Fixed failure of 03examples.t for some windows systems. + * Renamed IO::* to IO::Compress::* & IO::Uncompress::* - 1.39 - 15 September 2005 + 2.000_04 23 September 2005 - * Fixed dTHX macro for 5.00503 on FreeBSD + * Fixed some more non-portable test that were failing on VMS. + + * fixed problem where error messages in the oneshot interface were + getting lost. + + 2.000_03 12 September 2005 + + * Fixed some non-portable test that were failing on VMS. + + * Fixed export of zlib constants from the IO::* classes + + 2.000_02 6 September 2005 + + * Split Append mode into Append and Merge + + * Fixed typos in the documentation. + + * Added pod/FAQ.pod + + * Added libscan to Makefile.PL + + * Added InputLength for IO::Gunzip et al + + 2.000_01 22 August 2005 + + * Fixed VERSION in Compress::Gzip::Constants + + * Removed Compress::Gzip::Info from the distribution. + + 2.000_00 21 August 2005 + + * First Beta relase of Compress::zlib rewrite. 1.38 - 6 September 2005 @@ -92,7 +123,7 @@ CHANGES 1.31 - 29 October 2003 * Reinstated the creation of .bak files - $^I seems to need a - backup file on Windows. For OpenVMS, the extension _bak is used. + backup file on Windows. For OpenVMS, the extenstion _bak is used. 1.30 - 28 October 2003 @@ -153,40 +184,20 @@ CHANGES variable to config.in to flag an old version of zlib. Split out the tests for gzsetparams into t/05gzsetp.t - 1.17 - 22 October 2002 + 1.17 - 23 May 2002 * Moved the test to check the versions of libz & zlib.h into a separate file and added troubleshooting notes to README. * In gzopen, only attempt to call "tell" for normal files. + * Fixed to work in taint mode. + * Broke changes out of README into Changes file. * Replaced internal use of Z_PARTIAL_FLUSH symbol with Z_SYNC_FLUSH. zlib.h says /* will be removed, use Z_SYNC_FLUSH instead */ - * Added support for zlib functions inflateSync and deflateParams. - - * Added support for zlib functions gzeof and gzsetparams. - - * Added support for access to adler, total_in & total_out - - * The compress function can now take an optional parameter that - allows the compression level to be specified. This mirrors the - compress2 function available in zlib. - - * memGzip doesn't work properly with perl 5.8.0 when it is given - UTF-8 data. Bug spotted by Andreas J. Koenig. - - * Added note about Linux zlib-devel RPM to README. - - * Fixed recursive build problem on win32 machines. - - * Fixed problem with the test harness on Mac OS X. - Thanks to Carl Johan Berglund for reporting the problem and - helping track it down. - - 1.16 - 13 December 2001 * Fixed bug in Makefile.PL that stopped "perl Makefile.PL PREFIX=..." @@ -209,7 +220,7 @@ CHANGES 1.13 - 31st June 2001 - * Make sure config.in is consistent when released. + * Make sure config.in is consistant when released. 1.12 - 28th April 2001 diff --git a/ext/Compress/Zlib/Makefile.PL b/ext/Compress/Zlib/Makefile.PL index eea4402..1088436 100755 --- a/ext/Compress/Zlib/Makefile.PL +++ b/ext/Compress/Zlib/Makefile.PL @@ -4,7 +4,7 @@ use strict ; require 5.004 ; use ExtUtils::MakeMaker 5.16 ; -use Config ; +use Config qw(%Config) ; use File::Copy ; BEGIN @@ -22,16 +22,14 @@ my $ZLIB_LIB ; my $ZLIB_INCLUDE ; my $BUILD_ZLIB = 0 ; my $OLD_ZLIB = '' ; -my $EXTRA_DEFINE = ''; -my $WALL = ''; -#$WALL = ' -Wall '; +my $WALL = '' ; +my $GZIP_OS_CODE = -1 ; -unless($ENV{PERL_CORE}) { - $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; -} +#$WALL = ' -pedantic ' if $Config{'cc'} =~ /gcc/ ; +$WALL = ' -Wall ' if $Config{'cc'} =~ /gcc/ ; # don't ask if MM_USE_DEFAULT is set -- enables perl core building on cygwin -if ($^O =~ /cygwin/i and not $ENV{PERL_MM_USE_DEFAULT} and not $ENV{PERL_CORE}) +if ($^O =~ /cygwin/i and not $ENV{PERL_MM_USE_DEFAULT}) { print < 'Compress::Zlib', - VERSION_FROM => 'Zlib.pm', + VERSION_FROM => 'Zlib.pm', INC => "-I$ZLIB_INCLUDE" , - DEFINE => "$OLD_ZLIB $WALL $EXTRA_DEFINE" , - XS => { 'Zlib.xs' => 'Zlib.c' }, + DEFINE => "$OLD_ZLIB $WALL -DGZIP_OS_CODE=$GZIP_OS_CODE" , + XS => { 'Zlib.xs' => 'Zlib.c' }, + PREREQ_PM => { 'Scalar::Util' => 0, + $] >= 5.005 && $] < 5.006 ? ('File::BSDGlob' => 0) : () }, 'depend' => { 'Makefile' => 'config.in' }, 'clean' => { FILES => '*.c constants.h constants.xs' }, 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz', - DIST_DEFAULT => 'MyDoubleCheck Downgrade tardist', + DIST_DEFAULT => 'MyDoubleCheck downgrade tardist', }, ($BUILD_ZLIB ? zlib_files($ZLIB_LIB) @@ -103,6 +111,7 @@ my @names = qw( Z_BEST_COMPRESSION Z_BEST_SPEED Z_BINARY + Z_BLOCK Z_BUF_ERROR Z_DATA_ERROR Z_DEFAULT_COMPRESSION @@ -111,6 +120,7 @@ my @names = qw( Z_ERRNO Z_FILTERED Z_FINISH + Z_FIXED Z_FULL_FLUSH Z_HUFFMAN_ONLY Z_MEM_ERROR @@ -120,12 +130,15 @@ my @names = qw( Z_NULL Z_OK Z_PARTIAL_FLUSH + Z_RLE Z_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH Z_UNKNOWN Z_VERSION_ERROR + ); + #ZLIB_VERNUM if (eval {require ExtUtils::Constant; 1}) { # Check the constants above all appear in @EXPORT in Zlib.pm @@ -162,38 +175,40 @@ if (eval {require ExtUtils::Constant; 1}) { ); } else { - copy ('fallback.h', 'constants.h') - or die "Can't copy fallback.h to constants.h: $!"; - copy ('fallback.xs', 'constants.xs') - or die "Can't copy fallback.xs to constants.xs: $!"; + foreach my $name (qw( constants.h constants.xs )) + { + my $from = catfile('fallback', $name); + copy ($from, $name) + or die "Can't copy $from to $name: $!"; + } } sub MY::libscan { - my $self = shift ; - my $path = shift ; + my $self = shift; + my $path = shift; return undef - if $path =~ /(~|\.bak|_bak)$/ || - $path =~ /^\..*\.swp$/ ; + if $path =~ /(~|\.bak|_bak)$/ || + $path =~ /\..*\.swp$/ ; - return $path; + return $path; } - sub MY::postamble { my $postamble = <<'EOM'; -Downgrade: +downgrade: @echo Downgrading. perl Makefile.PL -downgrade MyDoubleCheck: @echo Checking config.in is setup for a release - @(grep '^LIB *= *./zlib' config.in && \ - grep '^INCLUDE *= *./zlib' config.in && \ + @(grep '^LIB *= *./zlib-src' config.in && \ + grep '^INCLUDE *= *./zlib-src' config.in && \ grep '^OLD_ZLIB *= *False' config.in && \ + grep '^GZIP_OS_CODE *= *AUTO_DETECT' config.in && \ grep '^BUILD_ZLIB *= *True' config.in) >/dev/null || \ (echo config.in needs fixing ; exit 1) @echo config.in is ok @@ -206,6 +221,39 @@ MyTrebleCheck: (echo found unexpected $$^W ; exit 1) @echo All is ok. +longtest: + @echo Running test suite with Devel::Cover + $(MAKE) test COMPRESS_ZLIB_RUN_ALL=1 + +cover: + @echo Running test suite with Devel::Cover + HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test + +longcover: + @echo Running test suite with Devel::Cover + HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test COMPRESS_ZLIB_RUN_ALL=1 + +test-utf8: + @echo Running test suite with utf-8 enabled + env LC_ALL=en_GB.UTF-8 $(MAKE) test + +test-utf8de: + @echo Running test suite with utf-8 and non-english enabled + env LC_ALL=de_DE.UTF-8 $(MAKE) test + +EOM + + $postamble .= <<'EOM' if $^O eq 'linux' ; + +gcov: + @echo Running test suite with gcov and Devel::Cover [needs gcc 3.4?] + #@test "${CC}" = "gcc" || (echo 'gcov' needs gcc, you have ${CC} ; exit 1) + rm -f *.o *.gcov *.da *.bbg *.bb *.gcno + $(MAKE) OPTIMIZE=-g DEFINE="-fprofile-arcs -ftest-coverage" + HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test + #gcov Zlib.xs + #gcov2perl -db cover_db Zlib.xs.gcov + EOM return $postamble; @@ -217,7 +265,7 @@ sub ParseCONFIG my ($k, $v) ; my @badkey = () ; my %Info = () ; - my @Options = qw( INCLUDE LIB BUILD_ZLIB OLD_ZLIB ) ; + my @Options = qw( INCLUDE LIB BUILD_ZLIB OLD_ZLIB GZIP_OS_CODE ) ; my %ValidOption = map {$_, 1} @Options ; my %Parsed = %ValidOption ; my $CONFIG = 'config.in' ; @@ -258,8 +306,6 @@ sub ParseCONFIG $ZLIB_LIB = VMS::Filespec::vmspath($ZLIB_LIB); } - $EXTRA_DEFINE = $ENV{EXTRA_DEFINE} if defined $ENV{EXTRA_DEFINE}; - my $y = $ENV{'OLD_ZLIB'} || $Info{'OLD_ZLIB'} ; $OLD_ZLIB = '-DOLD_ZLIB' if $y and $y =~ /^yes|on|true|1$/i; @@ -283,18 +329,33 @@ sub ParseCONFIG unless -e catfile($ZLIB_LIB, 'zlib.h') ; - # check Makefile.zlib has been copied to ZLIB_LIB - #copy 'Makefile.zlib', catfile($ZLIB_LIB, 'Makefile.PL') || - #die "Could not copy Makefile.zlib to " . catfile($ZLIB_LIB, 'Makefile.PL') . ": $!\n" ; - #print "Created a Makefile.PL for zlib\n" ; - # write the Makefile print "Building Zlib enabled\n" ; } + $GZIP_OS_CODE = defined $ENV{'GZIP_OS_CODE'} + ? $ENV{'GZIP_OS_CODE'} + : $Info{'GZIP_OS_CODE'} ; + + die "GZIP_OS_CODE not 'AUTO_DETECT' or a number between 0 and 255\n" + unless uc $GZIP_OS_CODE eq 'AUTO_DETECT' + || ( $GZIP_OS_CODE =~ /^(\d+)$/ && $1 >= 0 && $1 <= 255) ; + + if (uc $GZIP_OS_CODE eq 'AUTO_DETECT') + { + print "Auto Detect Gzip OS Code..\n" ; + $GZIP_OS_CODE = getOSCode() ; + } + + my $name = getOSname($GZIP_OS_CODE); + print "Setting Gzip OS Code to $GZIP_OS_CODE [$name]\n" ; + print <= 5.006000 || $upgrade) { @@ -353,6 +418,10 @@ sub UpDowngrade my $vars = join ', ', split ' ', $2; $_ = "${indent}our ($vars);\n"; } + elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/) + { + $_ = "$1$2\n"; + } }; } @@ -378,6 +447,8 @@ sub doUpDown my $our_sub = shift; my $warn_sub = shift; + return if -d $_[0]; + local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; local (@ARGV) = shift; @@ -408,23 +479,23 @@ sub zlib_files # zlib 1.2.0 or greater # @h_files = qw(crc32.h inffast.h inflate.h trees.h zconf.in.h - zutil.h deflate.h inffixed.h inftrees.h zconf.h - zlib.h + zutil.h deflate.h inffixed.h inftrees.h zconf.h + zlib.h ); @c_files = qw(adler32 crc32 infback inflate uncompr - compress deflate gzio inffast inftrees - trees zutil + compress deflate inffast inftrees + trees zutil ); } else { # zlib 1.1.x @h_files = qw(deflate.h infcodes.h inftrees.h zconf.h zutil.h - infblock.h inffast.h infutil.h zlib.h + infblock.h inffast.h infutil.h zlib.h ); - @c_files = qw(adler32 compress crc32 gzio uncompr - deflate trees zutil inflate infblock - inftrees infcodes infutil inffast + @c_files = qw(adler32 compress crc32 uncompr + deflate trees zutil inflate infblock + inftrees infcodes infutil inffast ); } @@ -446,5 +517,62 @@ sub zlib_files } + +my @GZIP_OS_Names ; +my %OSnames ; + +BEGIN +{ + @GZIP_OS_Names = ( + [ '' => 0, 'MS-DOS' ], + [ 'amigaos' => 1, 'Amiga' ], + [ 'VMS' => 2, 'VMS' ], + [ '' => 3, 'Unix/Default' ], + [ '' => 4, 'VM/CMS' ], + [ '' => 5, 'Atari TOS' ], + [ 'os2' => 6, 'HPFS (OS/2, NT)' ], + [ 'MacOS' => 7, 'Macintosh' ], + [ '' => 8, 'Z-System' ], + [ '' => 9, 'CP/M' ], + [ '' => 10, 'TOPS-20' ], + [ '' => 11, 'NTFS (NT)' ], + [ '' => 12, 'SMS QDOS' ], + [ '' => 13, 'Acorn RISCOS' ], + [ 'MSWin32' => 14, 'VFAT file system (Win95, NT)' ], + [ '' => 15, 'MVS' ], + [ 'beos' => 16, 'BeOS' ], + [ '' => 17, 'Tandem/NSK' ], + [ '' => 18, 'THEOS' ], + [ '' => 255, 'Unknown OS' ], + ); + + %OSnames = map { $$_[1] => $$_[2] } + @GZIP_OS_Names ; +} + +sub getOSCode +{ + my $default = 3 ; # Unix is the default + + my $uname = $^O; + + for my $h (@GZIP_OS_Names) + { + my ($pattern, $code, $name) = @$h; + + return $code + if $pattern && $uname eq $pattern ; + } + + return $default ; +} + +sub getOSname +{ + my $code = shift ; + + return $OSnames{$code} || 'Unknown OS' ; +} + # end of file Makefile.PL diff --git a/ext/Compress/Zlib/README b/ext/Compress/Zlib/README index 086a72b..efeb32f 100644 --- a/ext/Compress/Zlib/README +++ b/ext/Compress/Zlib/README @@ -1,20 +1,29 @@ + Compress::Zlib - Version 1.40 + Version 2.000_05 + + 4 Oct 2005 - 23 September 2005 + 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. - 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. - The directory zlib-src contains a subset of the source files copied - directly from zlib version 1.2.3. These files are Copyright(C) - 1995-2005 Jean-loup Gailly and Mark Adler. - Full source for the zlib library is available at + The directory zlib-src contains a subset of the + source files copied directly from zlib version 1.2.3. + These files are Copyright(C) 1995-2005 + Jean-loup Gailly and Mark Adler. + Full source for the zlib library is available at http://www.zlib.org + WARNING + THIS IS BETA CODE. + + DO NOT use in production code. + Please report any problems. + DESCRIPTION ----------- @@ -29,6 +38,8 @@ module below once you have installed this one. http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz + + PREREQUISITES ------------- @@ -90,13 +101,11 @@ library is used: 3. Use a pre-built zlib library. Note that if you intend to use either Option 2 or 3, you need to have -zlib version 1.0.6 or better. Although this module can build with old -versions of zlib, it is strongly recommended that you use the most recent -version of zlib available. +zlib version 1.0.5 or better. The contents of the file config.in are used to control which of the -three options is actually used. This file is used during the +three options is actually used. This file is read during the perl Makefile.PL @@ -111,10 +120,11 @@ before building this module. For option 1, edit the file config.in and set the variables in it as follows: - BUILD_ZLIB = True - INCLUDE = ./zlib-src - LIB = ./zlib-src - OLD_ZLIB = False + BUILD_ZLIB = True + INCLUDE = ./zlib-src + LIB = ./zlib-src + OLD_ZLIB = False + GZIP_OS_CODE = AUTO_DETECT Option 2 @@ -122,17 +132,18 @@ before building this module. For option 2, fetch a copy of the zlib source distribution from http://www.zlib.org and unpack it into the Compress::Zlib source - directory. Assuming you have fetched zlib 1.1.4, it will create a - directory called zlib-1.1.4. + directory. Assuming you have fetched zlib 1.2.3, it will create a + directory called zlib-1.2.3. Now set the variables in the file config.in as follows (if the version - you have fetched isn't 1.1.4, change the INCLUDE and LIB variables + you have fetched isn't 1.2.3, change the INCLUDE and LIB variables appropriately): - BUILD_ZLIB = True - INCLUDE = ./zlib-1.1.4 - LIB = ./zlib-1.1.4 - OLD_ZLIB = False + BUILD_ZLIB = True + INCLUDE = ./zlib-1.2.3 + LIB = ./zlib-1.2.3 + OLD_ZLIB = False + GZIP_OS_CODE = AUTO_DETECT Option 3 @@ -148,21 +159,53 @@ before building this module. Secondly, find the directory where the file zlib.h is stored. Now set the INCLUDE variable in the config.in file to that directory. - Next set BUILD_ZLIB to False + Next set BUILD_ZLIB to False. Finally, if you are running zlib 1.0.5 or older, set the OLD_ZLIB variable to True. Otherwise set it to False. As an example, if the zlib library on your system is in /usr/local/lib, - zlib.h is in /usr/local/include and zlib is more older than version + zlib.h is in /usr/local/include and zlib is more recent than version 1.0.5, the variables in config.in should be set as follows: - BUILD_ZLIB = False - INCLUDE = /usr/local/include - LIB = /usr/local/lib - OLD_ZLIB = True + BUILD_ZLIB = False + INCLUDE = /usr/local/include + LIB = /usr/local/lib + OLD_ZLIB = False + GZIP_OS_CODE = AUTO_DETECT +Setting the Gzip OS Code +------------------------ + +Every gzip stream stores a byte in its header to identify the Operating System +that was used to create the gzip stream. When you build Compress::Zlib it will +attempt to determine the value that is correct for your Operating System. This +will then be used by IO::Gzip as the default value for the OS byte in all gzip +headers it creates. + +The variable GZIP_OS_CODE in the config.in file controls the setting of this +value when building Compress::Zlib. If GZIP_OS_CODE is set to AUTO_DETECT, +Compress::Zlib will attempt to determine the correct value for your Operating +System. + +Alternatively, you can override auto-detection of the default OS code and +explicitly set it yourself. Set the GZIP_OS_CODE variable in the config.in file +to be a number between 0 and 255. For example + + GZIP_OS_CODE = 3 + +See RFC 1952 for valid OS codes that can be used. + +If you are running one of the less popular Operating Systems, it could be that +the default value picked by this module is incorrect or the default value (3) +is used when there is a better value available. When Compress::Zlib cannot +determine what operating system you are running, it will use the default value +3 for the OS code. + +If you find you have to change this value, because you think the value auto +detected is incorrect, please take a few moments to contact the author of this +module. TROUBLESHOOTING @@ -201,7 +244,6 @@ Try removing the one you don't want to use and rebuild. - Solaris build fails with "language optional software package not installed" --------------------------------------------------------------------------- @@ -222,7 +264,7 @@ lived in /usr/ucb. To continue with building this module, you need to get a C compiler, or tell Perl where your C compiler is, if you already have one. -Assuming you have now got a C compiler, what you do next will be dependant +Assuming you have now got a C compiler, what you do next will be dependent on what C compiler you have installed. If you have just installed Sun's C compiler, you shouldn't have to do anything. Just try rebuilding this module. @@ -273,6 +315,22 @@ The solution is either: mileage may vary. +The t/17isize Test Suite +------------------------ + +This test suite checks that Compress::Zlib can cope with gzip files +that are larger than 2^32 bytes. + +By default these test are NOT run when you do a "make test". If you +really want to run them, you need to execute "make longtest". + +Be warned though -- this test suite can take hours to run on a slow box. + +Also, due to the way the tests are constructed, some architectures will +run out of memory during these test. This should not be considered a bug +in the Compress::Zlib module. + + HP-UX Notes ----------- @@ -333,25 +391,6 @@ instructions given at the start of this file. -Mac OX X Notes --------------- - -Some versions of Mac OS X are failing a number of the tests in the -06gzdopen.t test harness. - -The functionality being exercised in these tests is checking that it is -possible to call gzopen with an existing Perl filehandle instead of a -filename. For some reason it does not seem possible to extract a -numeric file descriptor (using fileno) from a FILE* and then make use -of it. - -If you happen to now how to fix for this, I would like to hear from you. - -In the meantime, a workaround that has been reported to me is to use fink, -available at http://fink.sourceforge.net - - - FEEDBACK -------- diff --git a/ext/Compress/Zlib/Zlib.pm b/ext/Compress/Zlib/Zlib.pm index f6e48ac..8ba529e 100644 --- a/ext/Compress/Zlib/Zlib.pm +++ b/ext/Compress/Zlib/Zlib.pm @@ -1,12 +1,3 @@ -# File : Zlib.pm -# Author : Paul Marquess -# Created : 23 September 2005 -# Version : 1.40 -# -# 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. -# package Compress::Zlib; @@ -15,72 +6,73 @@ 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 ; -our ($VERSION, @ISA, @EXPORT, $AUTOLOAD); -our ($deflateDefault, $deflateParamsDefault, $inflateDefault); +use bytes ; +our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); -$VERSION = "1.40" ; +$VERSION = '2.000_05'; +$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 + deflateInit inflateInit - gzip gunzip + compress uncompress - gzopen - $gzerrno + gzopen $gzerrno - adler32 - crc32 + adler32 crc32 - ZLIB_VERSION - ZLIB_VERNUM + ZLIB_VERSION + ZLIB_VERNUM - DEF_WBITS - OS_CODE + DEF_WBITS + OS_CODE MAX_MEM_LEVEL - MAX_WBITS - - Z_ASCII - Z_BEST_COMPRESSION - Z_BEST_SPEED - Z_BINARY - Z_BUF_ERROR - Z_DATA_ERROR - Z_DEFAULT_COMPRESSION - Z_DEFAULT_STRATEGY + 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_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_STREAM_END - Z_STREAM_ERROR - Z_SYNC_FLUSH - Z_UNKNOWN - Z_VERSION_ERROR + 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/.*:://; @@ -91,174 +83,416 @@ sub AUTOLOAD { 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', $VERSION); -} or do { + XSLoader::load('Compress::Zlib', $XS_VERSION); + 1; +} +or do { require DynaLoader; local @ISA = qw(DynaLoader); - bootstrap Compress::Zlib $VERSION ; -} ; - + bootstrap Compress::Zlib $XS_VERSION ; +}; + # Preloaded methods go here. -sub isaFilehandle($) +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 $fh = shift ; + my $value = shift ; - return ((UNIVERSAL::isa($fh,'GLOB') or UNIVERSAL::isa(\$fh,'GLOB')) - and defined fileno($fh) ) + 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 isaFilename($) +sub _save_gzerr { - my $name = shift ; + my $gz = shift ; + my $test_eof = shift ; - return (! ref $name and UNIVERSAL::isa(\$name, 'SCALAR')) ; + 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) = @_ ; - - if (isaFilehandle $file) { - IO::Handle::flush($file) ; - my $offset = tell($file) ; - gzdopen_(fileno($file), $mode, $offset) ; - } - elsif (isaFilename $file) { - gzopen_($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 { - croak "gzopen: file parameter is not a filehandle or filename" + $gz = new IO::Uncompress::Gunzip($file, 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 ParseParameters($@) +sub Compress::Zlib::gzFile::gzreadline { - my ($default, @rest) = @_ ; - my (%got) = %$default ; - my (@Bad) ; - my ($key, $value) ; - my $sub = (caller(1))[3] ; - my %options = () ; + my $self = shift ; - # allow the options to be passed as a hash reference or - # as the complete hash. - if (@rest == 1) { + my $gz = $self->[0] ; + $_[0] = $gz->getline() ; + _save_gzerr($gz, 1); + return defined $_[0] ? length $_[0] : 0 ; +} - croak "$sub: parameter is not a reference to a hash" - if ref $rest[0] ne "HASH" ; +sub Compress::Zlib::gzFile::gzwrite +{ + my $self = shift ; + my $gz = $self->[0] ; - %options = %{ $rest[0] } ; - } - elsif (@rest >= 2) { - my $count = @rest; - croak "$sub: Expected even number of parameters, got $count" - if @rest % 2 != 0 ; - %options = @rest ; - } + return _set_gzerr(Z_STREAM_ERROR()) + if $self->[1] ne 'deflate'; - while (($key, $value) = each %options) - { - $key =~ s/^-// ; + my $status = $gz->write($_[0]) ; + _save_gzerr($gz); + return $status ; +} - if (exists $default->{$key}) - { $got{$key} = $value } - else - { push (@Bad, $key) } - } - - if (@Bad) { - my ($bad) = join(", ", @Bad) ; - croak "unknown key value(s) @Bad" ; +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 ; - return \%got ; + my $gz = $self->[0] ; + my $status = $gz->flush($f) ; + _save_gzerr($gz); + return $status ; } -$deflateDefault = { - 'Level' => Z_DEFAULT_COMPRESSION(), - 'Method' => Z_DEFLATED(), - 'WindowBits' => MAX_WBITS(), - 'MemLevel' => MAX_MEM_LEVEL(), - 'Strategy' => Z_DEFAULT_STRATEGY(), - 'Bufsize' => 4096, - 'Dictionary' => "", - } ; - -$deflateParamsDefault = { - 'Level' => undef, - 'Strategy' => undef, - 'Bufsize' => undef, - } ; - -$inflateDefault = { - 'WindowBits' => MAX_WBITS(), - 'Bufsize' => 4096, - 'Dictionary' => "", - } ; +sub Compress::Zlib::gzFile::gzclose +{ + my $self = shift ; + my $gz = $self->[0] ; + my $status = $gz->close() ; + _save_gzerr($gz); + return ! $status ; +} -sub deflateInit(@) +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->{Deflate}->deflateParams(-Level => $level, + -Strategy => $strategy); + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzerror { - my ($got) = ParseParameters($deflateDefault, @_) ; - no warnings; - croak "deflateInit: Bufsize must be >= 1, you specified $got->{Bufsize}" - unless $got->{Bufsize} >= 1; - _deflateInit($got->{Level}, $got->{Method}, $got->{WindowBits}, - $got->{MemLevel}, $got->{Strategy}, $got->{Bufsize}, - $got->{Dictionary}) ; - + my $self = shift ; + my $gz = $self->[0] ; + + return $Compress::Zlib::gzerrno ; } -sub inflateInit(@) +sub Compress::Zlib::Deflate::new +{ + my $pkg = shift ; + my ($got) = ParseParameters(0, + { + 'AppendOutput' => [Parse_boolean, 0], + 'CRC32' => [Parse_boolean, 0], + 'ADLER32' => [Parse_boolean, 0], + 'Bufsize' => [Parse_unsigned, 4096], + + 'Level' => [Parse_signed, Z_DEFAULT_COMPRESSION()], + 'Method' => [Parse_unsigned, Z_DEFLATED()], + 'WindowBits' => [Parse_signed, MAX_WBITS()], + 'MemLevel' => [Parse_unsigned, MAX_MEM_LEVEL()], + 'Strategy' => [Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'Dictionary' => [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' => [Parse_boolean, 0], + 'CRC32' => [Parse_boolean, 0], + 'ADLER32' => [Parse_boolean, 0], + 'ConsumeInput' => [Parse_boolean, 1], + 'Bufsize' => [Parse_unsigned, 4096], + + 'WindowBits' => [Parse_signed, MAX_WBITS()], + 'Dictionary' => [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' => [Parse_boolean, 0], + 'ADLER32' => [Parse_boolean, 0], + 'Bufsize' => [Parse_unsigned, 4096], + + 'WindowBits' => [Parse_signed, -MAX_WBITS()], + 'Dictionary' => [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 ($got) = ParseParameters($inflateDefault, @_) ; - no warnings; - croak "inflateInit: Bufsize must be >= 1, you specified $got->{Bufsize}" - unless $got->{Bufsize} >= 1; - _inflateInit($got->{WindowBits}, $got->{Bufsize}, $got->{Dictionary}); + my $pkg = shift ; + my ($got) = ParseParameters(0, + { + 'AppendOutput' => [Parse_boolean, 0], + 'CRC32' => [Parse_boolean, 0], + 'ADLER32' => [Parse_boolean, 0], + 'Bufsize' => [Parse_unsigned, 4096], + 'Level' => [Parse_signed, Z_DEFAULT_COMPRESSION()], + 'Method' => [Parse_unsigned, Z_DEFLATED()], + 'WindowBits' => [Parse_signed, - MAX_WBITS()], + 'MemLevel' => [Parse_unsigned, MAX_MEM_LEVEL()], + 'Strategy' => [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::deflateStream::deflateParams { my $self = shift ; - my ($got) = ParseParameters($deflateParamsDefault, @_) ; - croak "deflateParams needs Level and/or Strategy" - unless defined $got->{Level} || defined $got->{Strategy}; - no warnings; - croak "deflateParams: Bufsize must be >= 1, you specified $got->{Bufsize}" - unless !defined $got->{Bufsize} || $got->{Bufsize} >= 1; + my ($got) = ParseParameters(0, { + 'Level' => [Parse_signed, undef], + 'Strategy' => [Parse_unsigned, undef], + 'Bufsize' => [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; - if (defined $got->{Level}) - { $flags |= 1 } - else - { $got->{Level} = 0 } - - if (defined $got->{Strategy}) - { $flags |= 2 } - else - { $got->{Strategy} = 0 } - - $got->{Bufsize} = 0 - if !defined $got->{Bufsize}; - - $self->_deflateParams($flags, $got->{Level}, $got->{Strategy}, - $got->{Bufsize}); - + $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, $out, $err, $in) ; + my ($x, $output, $err, $in) =('', '', '', '') ; if (ref $_[0] ) { $in = $_[0] ; - croak "not a scalar reference" unless ref $in eq 'SCALAR' ; + croak "not a scalar reference" unless ref $in eq 'SCALAR' ; } else { $in = \$_[0] ; @@ -266,116 +500,277 @@ sub compress($;$) my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); + $x = new Compress::Zlib::Deflate -AppendOutput => 1, -Level => $level + or return undef ; - if ( (($x, $err) = deflateInit(Level => $level))[1] == Z_OK()) { - - ($output, $err) = $x->deflate($in) ; - return undef unless $err == Z_OK() ; + $err = $x->deflate($in, $output) ; + return undef unless $err == Z_OK() ; - ($out, $err) = $x->flush() ; - return undef unless $err == Z_OK() ; + $err = $x->flush($output) ; + return undef unless $err == Z_OK() ; - return ($output . $out) ; + return $output ; - } - - return undef ; } - sub uncompress($) { - my ($x, $output, $err, $in) ; + my ($x, $output, $err, $in) =('', '', '', '') ; if (ref $_[0] ) { $in = $_[0] ; - croak "not a scalar reference" unless ref $in eq 'SCALAR' ; + croak "not a scalar reference" unless ref $in eq 'SCALAR' ; } else { $in = \$_[0] ; } - if ( (($x, $err) = inflateInit())[1] == Z_OK()) { + $x = new Compress::Zlib::Inflate -ConsumeInput => 0 or return undef ; - ($output, $err) = $x->__unc_inflate($in) ; - return undef unless $err == Z_STREAM_END() ; + $err = $x->inflate($in, $output) ; + return undef unless $err == Z_STREAM_END() ; - return $output ; - } + return $output ; +} + + +### This stuff is for backward compat. with Compress::Zlib 1.x + - return undef ; +sub deflateInit(@) +{ + my ($got) = ParseParameters(0, + { + 'Bufsize' => [Parse_unsigned, 4096], + 'Level' => [Parse_signed, Z_DEFAULT_COMPRESSION()], + 'Method' => [Parse_unsigned, Z_DEFLATED()], + 'WindowBits' => [Parse_signed, MAX_WBITS()], + 'MemLevel' => [Parse_unsigned, MAX_MEM_LEVEL()], + 'Strategy' => [Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'Dictionary' => [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{def}, $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' => [Parse_unsigned, 4096], + 'WindowBits' => [Parse_signed, MAX_WBITS()], + 'Dictionary' => [Parse_any, ""], + }, @_) ; -# Constants -use constant MAGIC1 => 0x1f ; -use constant MAGIC2 => 0x8b ; -use constant OSCODE => 3 ; + croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . + $got->value('Bufsize') + unless $got->value('Bufsize') >= 1; -use constant FTEXT => 1 ; -use constant FHCRC => 2 ; -use constant FEXTRA => 4 ; -use constant FNAME => 8 ; -use constant FCOMMENT => 16 ; -use constant NULL => pack("C", 0) ; -use constant RESERVED => 0xE0 ; + my $status = 0 ; + my (%obj) = () ; + ($obj{def}, $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 ; + +sub deflate +{ + my $self = shift ; + my $output ; + #my (@rest) = @_ ; + + my $status = $self->{def}->deflate($_[0], $output) ; + + wantarray ? ($output, $status) : $output ; +} + +sub flush +{ + my $self = shift ; + my $output ; + my $flag = shift || Compress::Zlib::Z_FINISH(); + my $status = $self->{def}->flush($output, $flag) ; + + wantarray ? ($output, $status) : $output ; +} + +sub deflateParams +{ + my $self = shift ; + $self->{def}->deflateParams(@_) ; +} + +sub msg +{ + my $self = shift ; + $self->{def}->msg() ; +} + +sub total_in +{ + my $self = shift ; + $self->{def}->total_in() ; +} + +sub total_out +{ + my $self = shift ; + $self->{def}->total_out() ; +} + +sub dict_adler +{ + my $self = shift ; + $self->{def}->dict_adler() ; +} + +sub get_Level +{ + my $self = shift ; + $self->{def}->get_Level() ; +} + +sub get_Strategy +{ + my $self = shift ; + $self->{def}->get_Strategy() ; +} + +#sub DispStream +#{ +# my $self = shift ; +# $self->{def}->DispStream($_[0]) ; +#} + +package Zlib::OldInflate ; + +sub inflate +{ + my $self = shift ; + my $output ; + my $status = $self->{def}->inflate($_[0], $output) ; + wantarray ? ($output, $status) : $output ; +} + +sub inflateSync +{ + my $self = shift ; + $self->{def}->inflateSync($_[0]) ; +} + +sub msg +{ + my $self = shift ; + $self->{def}->msg() ; +} + +sub total_in +{ + my $self = shift ; + $self->{def}->total_in() ; +} + +sub total_out +{ + my $self = shift ; + $self->{def}->total_out() ; +} + +sub dict_adler +{ + my $self = shift ; + $self->{def}->dict_adler() ; +} + +#sub DispStream +#{ +# my $self = shift ; +# $self->{def}->DispStream($_[0]) ; +#} + +package Compress::Zlib ; + +use Compress::Gzip::Constants; -use constant MIN_HDR_SIZE => 10 ; # minimum gzip header size - sub memGzip($) { - my $x = deflateInit( + my $x = new Compress::Zlib::Deflate( + -AppendOutput => 1, + -CRC32 => 1, + -ADLER32 => 0, -Level => Z_BEST_COMPRESSION(), - -WindowBits => - MAX_WBITS(), + -WindowBits => - MAX_WBITS(), ) or return undef ; # write a minimal gzip header - my(@m); - push @m, pack("C" . MIN_HDR_SIZE, - MAGIC1, MAGIC2, Z_DEFLATED(), 0,0,0,0,0,0, OSCODE) ; + my $output = GZIP_MINIMUM_HEADER ; # if the deflation buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]) ; - my ($output, $status) = $x->deflate($string) ; - push @m, $output ; + my $status = $x->deflate($string, \$output) ; $status == Z_OK() or return undef ; - ($output, $status) = $x->flush() ; - push @m, $output ; + $status = $x->flush(\$output) ; $status == Z_OK() or return undef ; - push @m, pack("V V", crc32($string), $x->total_in()); + return $output . pack("V V", $x->crc32(), $x->total_in()) ; - return join "", @m; } + sub _removeGzipHeader($) { my $string = shift ; return Z_DATA_ERROR() - if length($$string) < MIN_HDR_SIZE ; + if length($$string) < GZIP_MIN_HEADER_SIZE ; my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = unpack ('CCCCVCC', $$string); return Z_DATA_ERROR() - unless $magic1 == MAGIC1 and $magic2 == MAGIC2 and - $method == Z_DEFLATED() and !($flags & RESERVED()) ; - substr($$string, 0, MIN_HDR_SIZE) = '' ; + 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 & FEXTRA) + if ($flags & GZIP_FLG_FEXTRA) { return Z_DATA_ERROR() - if length($$string) < 2 ; + if length($$string) < GZIP_FEXTRA_HEADER_SIZE ; my ($extra_len) = unpack ('v', $$string); - $extra_len += 2; + $extra_len += GZIP_FEXTRA_HEADER_SIZE; return Z_DATA_ERROR() if length($$string) < $extra_len ; @@ -383,29 +778,29 @@ sub _removeGzipHeader($) } # skip orig name - if ($flags & FNAME) + if ($flags & GZIP_FLG_FNAME) { - my $name_end = index ($$string, NULL); + 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 & FCOMMENT) + if ($flags & GZIP_FLG_FCOMMENT) { - my $comment_end = index ($$string, NULL); + 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 & FHCRC) + if ($flags & GZIP_FLG_FHCRC) { return Z_DATA_ERROR() - if length ($$string) < 2 ; - substr($$string, 0, 2) = ''; + if length ($$string) < GZIP_FHCRC_SIZE ; + substr($$string, 0, GZIP_FHCRC_SIZE) = ''; } return Z_OK(); @@ -421,10 +816,13 @@ sub memGunzip($) or return undef; my $bufsize = length $$string > 4096 ? length $$string : 4096 ; - my $x = inflateInit( -WindowBits => - MAX_WBITS(), - -Bufsize => $bufsize) + my $x = new Compress::Zlib::Inflate({-WindowBits => - MAX_WBITS(), + -Bufsize => $bufsize}) + or return undef; - my ($output, $status) = $x->inflate($string); + + my $output = "" ; + my $status = $x->inflate($string, $output); return undef unless $status == Z_STREAM_END(); @@ -440,7 +838,6 @@ sub memGunzip($) { $$string = ''; } - return $output; } @@ -456,26 +853,35 @@ Compress::Zlib - Interface to zlib compression library =head1 SYNOPSIS - use Compress::Zlib ; + use Compress::Zlib 2 ; - ($d, $status) = deflateInit( [OPT] ) ; - ($out, $status) = $d->deflate($buffer) ; - $status = $d->deflateParams([OPT]) ; - ($out, $status) = $d->flush() ; + ($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) = inflateInit( [OPT] ) ; - ($out, $status) = $i->inflate($buffer) ; - $status = $i->inflateSync($buffer) ; + ($i, $status) = new Compress::Zlib::Inflate( [OPT] ) ; + $status = $i->inflate($input, $output) ; + $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, [$level]) ; + $dest = compress($source) ; $dest = uncompress($source) ; $gz = gzopen($filename or filehandle, $mode) ; @@ -483,6 +889,8 @@ Compress::Zlib - Interface to zlib compression library $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) ; @@ -495,147 +903,600 @@ Compress::Zlib - Interface to zlib compression library $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). Most of the functionality provided by I is available -in I. +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. -The module can be split into two general areas of functionality, namely -in-memory compression/decompression and read/write access to I -files. Each of these areas will be discussed separately below. +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. -=head1 DEFLATE +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. -The interface I provides to the in-memory I -(and I) functions has been modified to fit into a Perl model. +Each of these areas will be discussed separately below. -The main difference is that for both inflation and deflation, the Perl -interface will I consume the complete input buffer before -returning. Also the output buffer returned will be automatically grown -to fit the amount of output available. -Here is a definition of the interface available: +=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. -=head2 B<($d, $status) = deflateInit( [OPT] )> +If you are upgrading from C 1.x, the following enhancements +have been made to the C interface: -Initialises a deflation stream. +=over 5 -It combines the features of the I functions B, -B and B. +=item 1 -If successful, it will return the initialised deflation stream, B<$d> -and B<$status> of C in a list context. In scalar context it -returns the deflation stream, B<$d>, only. +If you want to to open either STDIN or STDOUT with C, you can +optionally use the special filename "C<->" as a synonym for C<\*STDIN> and +C<\*STDOUT>. -If not successful, the returned deflation stream (B<$d>) will be -I and B<$status> will hold the exact I error code. +=item 2 -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. +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. -For backward compatibility, it is also possible to pass the parameters -as a reference to a hash containing the name=>value pairs. +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. -The function takes one optional parameter, a reference to a hash. The -contents of the hash allow the deflation interface to be tailored. +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. -Here is a list of the valid options: +=item 3 -=over 5 +Addition of C to provide a restricted C interface. -=item B<-Level> +=item 4. -Defines the compression level. Valid values are 0 through 9, -C, C, C, and -C. +Added C. -The default is C<-Level =EZ_DEFAULT_COMPRESSION>. +=back -=item B<-Method> +A more complete and flexible interface for reading/writing gzip files/buffers +is included with this module. See L and +L for more details. -Defines the compression method. The only valid value at present (and -the default) is C<-Method =EZ_DEFLATED>. +=over 5 -=item B<-WindowBits> +=item B<$gz = gzopen($filename, $mode)> -For a definition of the meaning and valid values for B -refer to the I documentation for I. +=item B<$gz = gzopen($filehandle, $mode)> -Defaults to C<-WindowBits =EMAX_WBITS>. +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. -=item B<-MemLevel> +When writing a gzip file this interface will always create the smallest +possible gzip header (exactly 10 bytes). If you want control over the +information stored in the gzip header (like the original filename or a comment) +use L instead. -For a definition of the meaning and valid values for B -refer to the I documentation for I. +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. -Defaults to C<-MemLevel =EMAX_MEM_LEVEL>. +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. -=item B<-Strategy> +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. -Defines the strategy used to tune the compression. The valid values are -C, C and C. +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. -The default is C<-Strategy =EZ_DEFAULT_STRATEGY>. +Refer to the I documentation for the exact format of the C<$mode> +parameter. -=item B<-Dictionary> -When a dictionary is specified I will automatically -call B directly after calling B. The -Adler32 value for the dictionary can be obtained by calling the method -C<$d->dict_adler()>. +=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) ;> + +Sets the file position of the + +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 deflation buffer. If the buffer has to be +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 -B. +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. -The default is 4096. =back -Here is an example of using the B optional parameter list -to override the default buffer size and compression level. All other -options will take their default values. +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 ) ; + my $d = new Compress::Zlib::Deflate ( -Bufsize => 300, + -Level => Z_BEST_SPEED ) ; -=head2 B<($out, $status) = $d-Edeflate($buffer)> +=head2 B<$status = $d-Edeflate($input, $output)> +Deflates the contents of C<$input> and writes the compressed data to +C<$output>. -Deflates the contents of B<$buffer>. The buffer can either be a scalar -or a scalar reference. When finished, B<$buffer> will be -completely processed (assuming there were no errors). If the deflation -was successful it returns the deflated output, B<$out>, and a status -value, B<$status>, of C. +The C<$input> and C<$output> parameters can be either scalars or scalar +references. -On error, B<$out> will be I and B<$status> will contain the -I error code. +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. -In a scalar context B will return B<$out> only. +On error, it returns a I error code. -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 B<$out> is empty for an error test. +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<($out, $status) = $d-Eflush([flush_type])> +=head2 B<$status = $d-Eflush($output [, $flush_type]) > Typically used to finish the deflation. Any pending output will be -returned via B<$out>. -B<$status> will have a value C if successful. +written to C<$output>. -In a scalar context B will return B<$out> only. +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 @@ -647,13 +1508,19 @@ 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 stream C<$d>. +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> @@ -667,12 +1534,39 @@ C. 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. @@ -685,26 +1579,40 @@ Returns the total number of bytes uncompressed bytes input to deflate. 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 B. It simply reads standard +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 ; + use Compress::Zlib 2 ; binmode STDIN; binmode STDOUT; - my $x = deflateInit() + my $x = new Compress::Zlib::Deflate or die "Cannot create a deflation stream\n" ; my ($output, $status) ; while (<>) { - ($output, $status) = $x->deflate($_) ; + $status = $x->deflate($_, $output) ; $status == Z_OK or die "deflation failed\n" ; @@ -712,58 +1620,63 @@ input, deflates it and writes it to standard output. print $output ; } - ($output, $status) = $x->flush() ; + $status = $x->flush($output) ; $status == Z_OK or die "deflation failed\n" ; print $output ; -=head1 INFLATE +=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) = inflateInit()> +=head2 B< ($i, $status) = new Compress::Zlib::Inflate( [OPT] ) > -Initialises an inflation stream. +Initialises an inflation object. -In a list context it returns the inflation stream, B<$i>, and the -I status code (B<$status>). In a scalar context it returns the -inflation stream only. +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, B<$i> will hold the inflation stream and B<$status> will +If successful, C<$i> will hold the inflation object and C<$status> will be C. -If not successful, B<$i> will be I and B<$status> will hold the +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 +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. - -The function takes one optional parameter, a reference to a hash. The -contents of the hash allow the deflation interface to be tailored. - +as a reference to a hash containing the name=Evalue pairs. + Here is a list of the valid options: =over 5 =item B<-WindowBits> -For a definition of the meaning and valid values for B +For a 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 -B. +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. @@ -771,51 +1684,119 @@ Default is 4096. 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 the B optional parameter to -override the default buffer size. +Here is an example of using an optional parameter to override the default +buffer size. - inflateInit( -Bufsize => 300 ) ; + my ($i, $status) = new Compress::Zlib::Inflate( -Bufsize => 300 ) ; -=head2 B<($out, $status) = $i-Einflate($buffer)> +=head2 B< $status = $i-Einflate($input, $output) > -Inflates the complete contents of B<$buffer>. The buffer can either be -a scalar or a scalar reference. +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, B<$out> will be I and B<$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. +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). +a compressed data stream (e.g. gzip, zip) and there is useful data +immediately after the deflation stream. -=head2 B<$status = $i-EinflateSync($buffer)> +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. -Scans C<$buffer> until it reaches either a I or the +=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<$buffer> -will be have all data up to the flush point removed. This can then be -passed to the C method. +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. @@ -828,16 +1809,20 @@ Returns the total number of bytes compressed bytes input to inflate. 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 B. +Here is an example of using C. use strict ; use warnings ; - use Compress::Zlib ; + use Compress::Zlib 2 ; - my $x = inflateInit() + my $x = new Compress::Zlib::Inflate() or die "Cannot create a inflation stream\n" ; my $input = '' ; @@ -847,7 +1832,7 @@ Here is an example of using B. my ($output, $status) ; while (read(STDIN, $input, 4096)) { - ($output, $status) = $x->inflate(\$input) ; + $status = $x->inflate(\$input, $output) ; print $output if $status == Z_OK or $status == Z_STREAM_END ; @@ -858,415 +1843,411 @@ Here is an example of using B. die "inflation failed\n" unless $status == Z_STREAM_END ; -=head1 COMPRESS/UNCOMPRESS +=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] )> -Two high-level functions are provided by I to perform in-memory -compression/uncompression of RFC1950 data streams. They are called -B and B. +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 two Perl subs defined below provide the equivalent -functionality. +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<$dest = compress($source [, $level] ) ;> +=item B<-Level> -Compresses B<$source>. If successful it returns the -compressed data. Otherwise it returns I. +Defines the compression level. Valid values are 0 through 9, +C, C, C, and +C. -The source buffer can either be a scalar or a scalar reference. +The default is C<-Level =EZ_DEFAULT_COMPRESSION>. -The B<$level> paramter defines the compression level. Valid values are -0 through 9, C, C, -C, and C. -If B<$level> is not specified C will be used. +=item B<-Method> +Defines the compression method. The only valid value at present (and +the default) is C<-Method =EZ_DEFLATED>. -=item B<$dest = uncompress($source) ;> +=item B<-WindowBits> -Uncompresses B<$source>. If successful it returns the uncompressed -data. Otherwise it returns I. +For a definition of the meaning and valid values for C +refer to the I documentation for I. -The source buffer can either be a scalar or a scalar reference. +Defaults to C<-WindowBits =EMAX_WBITS>. -=back +=item B<-MemLevel> -Please note: the two functions defined above are I compatible with -the Unix commands of the same name. +For a definition of the meaning and valid values for C +refer to the I documentation for I. -=head1 GZIP INTERFACE +Defaults to C<-MemLevel =EMAX_MEM_LEVEL>. -A number of functions are supplied in I for reading and writing -I files. This module provides an interface to most of them. In -general the interface provided by this module operates identically to -the functions provided by I. Any differences are explained -below. +=item B<-Strategy> -=over 5 +Defines the strategy used to tune the compression. The valid values are +C, C and C. -=item B<$gz = gzopen(filename or filehandle, mode)> +The default is C<-Strategy =EZ_DEFAULT_STRATEGY>. -This function operates identically to the I equivalent except -that it returns an object which is used to access the other I -methods. +=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()>. -As with the I equivalent, the B parameter is used to -specify both whether the file is opened for reading or writing and to -optionally specify a a compression level. Refer to the I -documentation for the exact format of the B parameter. +The default is no dictionary. -If a reference to an open filehandle is passed in place of the -filename, gzdopen will be called behind the scenes. The third example -at the end of this section, I, uses this feature. +=item B<-Bufsize> -=item B<$bytesread = $gz-Egzread($buffer [, $size]) ;> +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. -Reads B<$size> bytes from the compressed file into B<$buffer>. If -B<$size> is not specified, it will default to 4096. If the scalar -B<$buffer> is not large enough, it will be extended automatically. +The default is 4096. -Returns the number of bytes actually read. On EOF it returns 0 and in -the case of an error, -1. +=back -=item B<$bytesread = $gz-Egzreadline($line) ;> +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. -Reads the next line from the compressed file into B<$line>. + deflateInit( -Bufsize => 300, + -Level => Z_BEST_SPEED ) ; -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 B and B. +=head2 B<($out, $status) = $d-Edeflate($buffer)> -At this time B ignores the variable C<$/> -(C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use). The -end of a line is denoted by the C character C<'\n'>. -=item B<$byteswritten = $gz-Egzwrite($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. -Writes the contents of B<$buffer> to the compressed file. Returns the -number of bytes actually written, or 0 on error. +On error, C<$out> will be I and C<$status> will contain the +I error code. -=item B<$status = $gz-Egzflush($flush) ;> +In a scalar context C will return C<$out> only. -Flushes all pending output to the compressed file. -Works identically to the I function it interfaces to. Note that -the use of B can degrade compression. +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. -Returns C if B<$flush> is C and all output could be -flushed. Otherwise the zlib error code is returned. -Refer to the I documentation for the valid values of B<$flush>. +=head2 B<($out, $status) = $d-Eflush([flush_type])> -=item B<$status = $gz-Egzeof() ;> +Typically used to finish the deflation. Any pending output will be +returned via C<$out>. +C<$status> will have a value C if successful. -Returns 1 if the end of file has been detected while reading the input -file, otherwise returns 0. +In a scalar context C will return C<$out> only. -=item B<$gz-Egzclose> +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). -Closes the compressed file. Any pending data is flushed to the file -before it is closed. +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. -=item B<$gz-Egzsetparams($level, $strategy> +=head2 B<$status = $d-EdeflateParams([OPT])> -Change settings for the deflate stream C<$gz>. +Change settings for the deflate stream C<$d>. 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> +=item B<-Level> Defines the compression level. Valid values are 0 through 9, C, C, C, and C. -=item B<$strategy> +=item B<-Strategy> Defines the strategy used to tune the compression. The valid values are C, C and C. =back -=item B<$gz-Egzerror> +=head2 B<$d-Edict_adler()> -Returns the I error message or number for the last operation -associated with B<$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. +Returns the adler32 value for the dictionary. - Z_OK - Z_STREAM_END - Z_ERRNO - Z_STREAM_ERROR - Z_DATA_ERROR - Z_MEM_ERROR - Z_BUF_ERROR +=head2 B<$d-Emsg()> -=item B<$gzerrno> +Returns the last error message generated by zlib. -The B<$gzerrno> scalar holds the error code associated with the most -recent I routine. Note that unlike B, the error is -I associated with a particular file. +=head2 B<$d-Etotal_in()> -As with B it returns an error number in numeric context and -an error message in string context. Unlike B 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). +Returns the total number of bytes uncompressed bytes input to deflate. -As there is an overlap between the error numbers used by I and -UNIX, B<$gzerrno> should only be used to check for the presence of -I error in numeric context. Use B to check for specific -I errors. The I example below shows how the variable can -be used safely. +=head2 B<$d-Etotal_out()> -=back +Returns the total number of compressed bytes output from deflate. +=head2 Example -=head2 Examples -Here is an example script which uses the interface. It implements a -I function. +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 ; - - die "Usage: gzcat file...\n" - unless @ARGV ; - - my $file ; - - foreach $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 B. It implements a -very simple I like script. + binmode STDIN; + binmode STDOUT; + my $x = deflateInit() + or die "Cannot create a deflation stream\n" ; - use strict ; - use warnings ; - - use Compress::Zlib ; - - die "Usage: gzgrep pattern file...\n" - unless @ARGV >= 2; - - my $pattern = shift ; - - my $file ; - - foreach $file (@ARGV) { - my $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; + my ($output, $status) ; + while (<>) + { + ($output, $status) = $x->deflate($_) ; - while ($gz->gzreadline($_) > 0) { - print if /$pattern/ ; - } + $status == Z_OK + or die "deflation failed\n" ; - die "Error reading from $file: $gzerrno\n" - if $gzerrno != Z_STREAM_END ; - - $gz->gzclose() ; + print $output ; } - -This script, I, does the opposite of the I script -above. It reads from standard input and writes a gzip file to standard -output. - - use strict ; - use warnings ; - use Compress::Zlib ; - - binmode STDOUT; # gzopen only sets it on the fd + ($output, $status) = $x->flush() ; - my $gz = gzopen(\*STDOUT, "wb") - or die "Cannot open stdout: $gzerrno\n" ; + $status == Z_OK + or die "deflation failed\n" ; - while (<>) { - $gz->gzwrite($_) - or die "error writing: $gzerrno\n" ; - } + print $output ; - $gz->gzclose ; +=head1 Compress::Zlib 1.x Inflate Interface -=head2 Compress::Zlib::memGzip +This section defines the interface available in C version +1.x that allows in-memory uncompression using the I interface +provided by zlib. -This function is used to create an in-memory gzip file. -It creates a minimal gzip header. +Here is a definition of the interface: - $dest = Compress::Zlib::memGzip($buffer) ; -If successful, it returns the in-memory gzip file, otherwise it returns -undef. +=head2 B<($i, $status) = inflateInit()> -The buffer parameter can either be a scalar or a scalar reference. +Initialises an inflation stream. -=head2 Compress::Zlib::memGunzip +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. -This function is used to uncompress an in-memory gzip file. +If successful, C<$i> will hold the inflation stream and C<$status> will +be C. - $dest = Compress::Zlib::memGunzip($buffer) ; +If not successful, C<$i> will be I and C<$status> will hold the +I error code. -If successful, it returns the uncompressed gzip file, otherwise it -returns undef. +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: -The buffer parameter can either be a scalar or a scalar reference. The -contents of the buffer parameter are destroyed after calling this -function. +=over 5 -=head1 CHECKSUM FUNCTIONS +=item B<-WindowBits> -Two functions are provided by I to calculate a checksum. 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. +For a definition of the meaning and valid values for C +refer to the I documentation for I. - $crc = adler32($buffer [,$crc]) ; - $crc = crc32($buffer [,$crc]) ; +Defaults to C<-WindowBits =EMAX_WBITS>. -The buffer parameters can either be a scalar or a scalar reference. +=item B<-Bufsize> -If the $crc parameters is C, the crc value will be reset. +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. -=head1 FAQ +Default is 4096. -=head2 Compatibility with Unix compress/uncompress. +=item B<-Dictionary> -Although C has a pair of functions called C -and C, they are I the same as the Unix programs of the -same name. The C library is not compatable with Unix -C. +The default is no dictionary. -If you have the C program available, you can use this to -read compressed files +=back - open F, "uncompress -c $filename |"; - while () - { - ... +Here is an example of using the C optional parameter to +override the default buffer size. -If you have the C program available, you can use this to read -compressed files + inflateInit( -Bufsize => 300 ) ; - open F, "gunzip -c $filename |"; - while () - { - ... +=head2 B<($out, $status) = $i-Einflate($buffer)> -and this to write compress files if you have the C program -available +Inflates the complete contents of C<$buffer>. The buffer can either be +a scalar or a scalar reference. - open F, "| compress -c $filename "; - print F "data"; - ... - close F ; +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. -=head2 Accessing .tar.Z files +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. -The C module can optionally use C (via -the C module) to access tar files that have been compressed -with C. Unfortunately tar files compressed with the Unix C -utility cannot be read by C and so cannot be directly -accesses by C. +This feature is useful when processing a file format that encapsulates +a compressed data stream (e.g. gzip, zip). -If the C or C programs are available, you can use -one of these workarounds to read C<.tar.Z> files from C +=head2 B<$status = $i-EinflateSync($buffer)> -Firstly with C +Scans C<$buffer> until it reaches either a I or the +end of the buffer. - use strict; - use warnings; - use Archive::Tar; +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. - open F, "uncompress -c $filename |"; - my $tar = Archive::Tar->new(*F); - ... +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. -and this with C - use strict; - use warnings; - use Archive::Tar; +=head2 B<$i-Edict_adler()> - open F, "gunzip -c $filename |"; - my $tar = Archive::Tar->new(*F); - ... +Returns the adler32 value for the dictionary. -Similarly, if the C program is available, you can use this to -write a C<.tar.Z> file +=head2 B<$i-Emsg()> - use strict; - use warnings; - use Archive::Tar; - use IO::File; +Returns the last error message generated by zlib. - my $fh = newIO::File "| compress -c >$filename"; - my $tar = Archive::Tar->new(); - ... - $tar->write($fh); - $fh->close ; +=head2 B<$i-Etotal_in()> -=head2 Accessing ZIP Files +Returns the total number of bytes compressed bytes input to inflate. -Although it is possible 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 +=head2 B<$i-Etotal_out()> - http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz +Returns the total number of uncompressed bytes output from inflate. -Assuming you don't want to use this module to access zip files there -are a number of undocumented features in the zlib library you need to -be aware of. +=head2 Example -=over 5 +Here is an example of using C. -=item 1. + 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 ; -When calling B or B the B parameter -must be set to C<-MAX_WBITS>. This disables the creation of the zlib -header. +=head1 ACCESSING ZIP FILES -=item 2. +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 -The zlib function B, and so the B method supplied in -this module, assume that there is at least one trailing byte after the -compressed data stream. Normally this isn't a problem because both -the gzip and zip file formats will guarantee that there is data directly -after the compressed data stream. + http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz -=back =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-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/Zlib.xs b/ext/Compress/Zlib/Zlib.xs index 6f02146..3fce623 100644 --- a/ext/Compress/Zlib/Zlib.xs +++ b/ext/Compress/Zlib/Zlib.xs @@ -1,7 +1,7 @@ /* Filename: Zlib.xs * Author : Paul Marquess, - * Created : 30 January 2005 - * Version : 1.40 + * 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 @@ -9,13 +9,22 @@ * */ -/* Part of this code is based on the file gzio.c */ +/* 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" @@ -24,67 +33,243 @@ #include -#ifndef PERL_VERSION -#include "patchlevel.h" -#define PERL_REVISION 5 -#define PERL_VERSION PATCHLEVEL -#define PERL_SUBVERSION SUBVERSION + +#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 + +/* zlib prior to 1.06 doesn't know about z_off_t */ +#ifndef z_off_t +# define z_off_t long +#endif + +# 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 + +#endif + + +#if PERL_REVISION == 5 && (PERL_VERSION >= 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 4 )) +# define UTF8_AVAILABLE +#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 -#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 )) +#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) +{ + 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)) -# define PL_sv_undef sv_undef -# define PL_na na -# define PL_curcop curcop -# define PL_compiling compiling #endif -#ifndef newSVuv -# define newSVuv newSViv +#ifndef SvGETMAGIC +# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END #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; + 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 ; +#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" -/* typedef gzFile Compress__Zlib__gzFile ; */ -typedef struct gzType { - gzFile gz ; - SV * buffer ; - uLong offset ; - bool closed ; -} gzType ; +#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 -typedef gzType* Compress__Zlib__gzFile ; +#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 -#define GZERRNO "Compress::Zlib::gzerrno" +#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 -#define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \ - Zero(to,1,typ)) +#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) -#if 1 + static const char * const my_z_errmsg[] = { "need dictionary", /* Z_NEED_DICT 2 */ "stream end", /* Z_STREAM_END 1 */ @@ -96,8 +281,13 @@ static const char * const my_z_errmsg[] = { "buffer error", /* Z_BUF_ERROR (-5) */ "incompatible version",/* Z_VERSION_ERROR(-6) */ ""}; -#endif +#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 @@ -105,14 +295,36 @@ static const char * const my_z_errmsg[] = { #define TRACE_DEFAULT 0 #ifdef NO_WRITEABLE_DATA -#define trace TRACE_DEFAULT +# define trace TRACE_DEFAULT #else -static int trace = TRACE_DEFAULT ; + 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) @@ -121,9 +333,6 @@ SetGzErrorNo(error_no) int error_no ; #endif { -#ifdef dTHX - dTHX; -#endif char * errstr ; SV * gzerror_sv = perl_get_sv(GZERRNO, FALSE) ; @@ -143,6 +352,7 @@ int error_no ; } + static void #ifdef CAN_PROTOTYPE SetGzError(gzFile file) @@ -157,6 +367,104 @@ gzFile file ; 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) @@ -189,128 +497,102 @@ DispStream(s, message) return ; #endif - printf("DispStream 0x%p - %s \n", s, message) ; +#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"); + 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(" =>"); + 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(" =>"); + 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 %ld\n", s->stream.avail_in); - printf(" avail_out %ld\n", s->stream.avail_out); - printf(" total_in %ld\n", s->stream.total_in); - printf(" total_out %ld\n", s->stream.total_out); - printf(" adler 0x%lx\n", s->stream.adler); - printf(" reserved 0x%lx\n", s->stream.reserved); - printf(" bufsize %ld\n", s->bufsize); - printf(" dictionary 0x%p\n", s->dictionary); - printf(" dict_adler 0x%ld\n", s->dict_adler); - 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(uLong bufsize) +InitStream(void) #else -InitStream(bufsize) - uLong bufsize ; +InitStream() #endif { di_stream *s ; ZMALLOC(s, di_stream) ; - if (s) { - s->bufsize = bufsize ; - s->bufinc = bufsize ; - } - return s ; } -#define SIZE 4096 - -static int +static void #ifdef CAN_PROTOTYPE -gzreadline(Compress__Zlib__gzFile file, SV * output) +PostInitStream(di_stream * s, int flags, int bufsize, int windowBits) #else -gzreadline(file, output) - Compress__Zlib__gzFile file ; - SV * output ; +PostInitStream(s, flags, bufsize, windowBits) + di_stream *s ; + int flags ; + int bufsize ; + int windowBits ; #endif { -#ifdef dTHX - dTHX; -#endif - SV * store = file->buffer ; - char *nl = "\n"; - char *p; - char *out_ptr = SvPVX(store) ; - int n; - - while (1) { - - /* anything left from last time */ - if ((n = SvCUR(store))) { - - out_ptr = SvPVX(store) + file->offset ; - if ((p = ninstr(out_ptr, out_ptr + n - 1, nl, nl))) { - /* if (rschar != 0777 && */ - /* p = ninstr(out_ptr, out_ptr + n - 1, rs, rs+rslen-1)) { */ - - sv_catpvn(output, out_ptr, p - out_ptr + 1); - - file->offset += (p - out_ptr + 1) ; - n = n - (p - out_ptr + 1); - SvCUR_set(store, n) ; - return SvCUR(output); - } - else /* no EOL, so append the complete buffer */ - sv_catpvn(output, out_ptr, n); - - } - - - SvCUR_set(store, 0) ; - file->offset = 0 ; - out_ptr = SvPVX(store) ; - - n = gzread(file->gz, out_ptr, SIZE) ; - - if (n <= 0) - /* Either EOF or an error */ - /* so return what we have so far else signal eof */ - return (SvCUR(output)>0) ? SvCUR(output) : n ; - - SvCUR_set(store, n) ; - } + s->bufsize = bufsize ; + s->bufinc = bufsize ; + 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) @@ -320,30 +602,76 @@ SV * sv ; char * string; #endif { -#ifdef dTHX dTHX; -#endif + SvGETMAGIC(sv); + if (SvROK(sv)) { - sv = SvRV(sv) ; - switch(SvTYPE(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 (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 +{ + 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_ +MODULE = Compress::Zlib PACKAGE = Compress::Zlib PREFIX = Zip_ REQUIRE: 1.924 PROTOTYPES: DISABLE @@ -356,6 +684,12 @@ BOOT: 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) ; @@ -364,6 +698,48 @@ BOOT: } +int +_readonly_ref(sv) + SV* sv + CODE: + if (SvROK(sv)) + RETVAL = SvREADONLY(SvRV(sv)) ; + else + RETVAL = SvREADONLY(sv) ; + OUTPUT: + RETVAL + +void +_dualvar(num,str) + SV * num + SV * str +PROTOTYPE: $$ +CODE: +{ + STRLEN len; + char *ptr = SvPVbyte(str,len); + ST(0) = sv_newmortal(); + SvUPGRADE(ST(0),SVt_PVNV); + sv_setpvn(ST(0),ptr,len); + if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) { + SvNVX(ST(0)) = SvNV(num); + SvNOK_on(ST(0)); + } +#ifdef SVf_IVisUVXXXX + else if (SvUOK(num)) { + SvUVX(ST(0)) = SvUV(num); + SvIOK_on(ST(0)); + SvIsUV_on(ST(0)); + } +#endif + else { + SvIVX(ST(0)) = SvIV(num); + SvIOK_on(ST(0)); + } + XSRETURN(1); +} + + #define Zip_zlib_version() (char*)zlib_version char* Zip_zlib_version() @@ -382,282 +758,109 @@ ZLIB_VERNUM() OUTPUT: RETVAL - - -void -DispStream(s, message=NULL) - Compress::Zlib::inflateStream s - char * message - -Compress::Zlib::gzFile -gzopen_(path, mode) - char * path - char * mode - CODE: - gzFile gz ; - gz = gzopen(path, mode) ; - if (gz) { - ZMALLOC(RETVAL, gzType) ; - RETVAL->buffer = newSV(SIZE) ; - SvPOK_only(RETVAL->buffer) ; - SvCUR_set(RETVAL->buffer, 0) ; - RETVAL->offset = 0 ; - RETVAL->gz = gz ; - RETVAL->closed = FALSE ; - SetGzErrorNo(0) ; - } - else { - RETVAL = NULL ; - SetGzErrorNo(errno ? Z_ERRNO : Z_MEM_ERROR) ; - } - OUTPUT: - RETVAL - +MODULE = Compress::Zlib PACKAGE = Compress::Zlib PREFIX = Zip_ -Compress::Zlib::gzFile -gzdopen_(fh, mode, offset) - int fh - char * mode - long offset - CODE: - gzFile gz ; - if (offset != -1) - lseek(fh, offset, 0) ; - gz = gzdopen(fh, mode) ; - if (gz) { - ZMALLOC(RETVAL, gzType) ; - RETVAL->buffer = newSV(SIZE) ; - SvPOK_only(RETVAL->buffer) ; - SvCUR_set(RETVAL->buffer, 0) ; - RETVAL->offset = 0 ; - RETVAL->gz = gz ; - RETVAL->closed = FALSE ; - SetGzErrorNo(0) ; - } - else { - RETVAL = NULL ; - SetGzErrorNo(errno ? Z_ERRNO : Z_MEM_ERROR) ; - } - OUTPUT: - RETVAL +#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) ; -MODULE = Compress::Zlib PACKAGE = Compress::Zlib::gzFile PREFIX = Zip_ + 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) -#define Zip_gzread(file, buf, len) gzread(file->gz, bufp, 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) ; -int -Zip_gzread(file, buf, len=4096) - Compress::Zlib::gzFile file - unsigned len - SV * buf - voidp bufp = NO_INIT - uLong bufsize = 0 ; - int RETVAL = 0 ; - CODE: - if (SvREADONLY(buf) && PL_curcop != &PL_compiling) - croak("gzread: buffer parameter is read-only"); - SvUPGRADE(buf, SVt_PV); - SvPOK_only(buf); - SvCUR_set(buf, 0); - /* any left over from gzreadline ? */ - if ((bufsize = SvCUR(file->buffer)) > 0) { - uLong movesize ; - - if (bufsize < len) { - movesize = bufsize ; - len -= movesize ; - } - else { - movesize = len ; - len = 0 ; - } - RETVAL = movesize ; - - sv_catpvn(buf, SvPVX(file->buffer) + file->offset, movesize); - - file->offset += movesize ; - SvCUR_set(file->buffer, bufsize - movesize) ; - } - - if (len) { - bufp = (Byte*)SvGROW(buf, bufsize+len+1); - RETVAL = gzread(file->gz, ((Bytef*)bufp)+bufsize, len) ; - SetGzError(file->gz) ; - if (RETVAL >= 0) { - RETVAL += bufsize ; - SvCUR_set(buf, RETVAL) ; - *SvEND(buf) = '\0'; - } - } - OUTPUT: - RETVAL - buf - -int -gzreadline(file, buf) - Compress::Zlib::gzFile file - SV * buf - int RETVAL = 0; - CODE: - if (SvREADONLY(buf) && PL_curcop != &PL_compiling) - croak("gzreadline: buffer parameter is read-only"); - SvUPGRADE(buf, SVt_PV); - SvPOK_only(buf); - /* sv_setpvn(buf, "", SIZE) ; */ - SvGROW(buf, SIZE) ; - SvCUR_set(buf, 0); - RETVAL = gzreadline(file, buf) ; - SetGzError(file->gz) ; - OUTPUT: - RETVAL - buf - CLEANUP: - if (RETVAL >= 0) { - /* SvCUR(buf) = RETVAL; */ - /* Don't need to explicitly terminate with '\0', because - sv_catpvn aready has */ - } - -#define Zip_gzwrite(file, buf) gzwrite(file->gz, buf, (unsigned)len) -int -Zip_gzwrite(file, buf) - Compress::Zlib::gzFile file - STRLEN len = NO_INIT - voidp buf = (voidp)SvPV(ST(1), len) ; - CLEANUP: - SetGzError(file->gz) ; - -#define Zip_gzflush(file, flush) gzflush(file->gz, flush) -int -Zip_gzflush(file, flush) - Compress::Zlib::gzFile file - int flush - CLEANUP: - SetGzError(file->gz) ; - -#define Zip_gzclose(file) file->closed ? 0 : gzclose(file->gz) -int -Zip_gzclose(file) - Compress::Zlib::gzFile file - CLEANUP: - file->closed = TRUE ; - SetGzErrorNo(RETVAL) ; + if (items < 2) + crc = crcInitial; + else if (SvOK(ST(1))) + crc = SvUV(ST(1)) ; + else + crc = crcInitial; -#define Zip_gzeof(file) gzeof(file->gz) -int -Zip_gzeof(file) - Compress::Zlib::gzFile file +uLong +crc32_combine(crc1, crc2, len2) + uLong crc1 + uLong crc2 + z_off_t len2 CODE: -#ifdef OLD_ZLIB - croak("gzeof needs zlib 1.0.6 or better") ; +#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 = gzeof(file->gz); + RETVAL = crc32_combine(crc1, crc2, len2); #endif - OUTPUT: - RETVAL + OUTPUT: + RETVAL -#define Zip_gzsetparams(file,l,s) gzsetparams(file->gz,l,s) -int -Zip_gzsetparams(file, level, strategy) - Compress::Zlib::gzFile file - int level - int strategy +uLong +adler32_combine(adler1, adler2, len2) + uLong adler1 + uLong adler2 + z_off_t len2 CODE: -#ifdef OLD_ZLIB - croak("gzsetparams needs zlib 1.0.6 or better") ; +#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 = gzsetparams(file->gz, level, strategy); + RETVAL = adler32_combine(adler1, adler2, len2); #endif - OUTPUT: - RETVAL - -void -DESTROY(file) - Compress::Zlib::gzFile file - CODE: - if (! file->closed) - Zip_gzclose(file) ; - SvREFCNT_dec(file->buffer) ; - safefree((char*)file) ; - -#define Zip_gzerror(file) (char*)gzerror(file->gz, &errnum) - -char * -Zip_gzerror(file) - Compress::Zlib::gzFile file - int errnum = NO_INIT - CLEANUP: - sv_setiv(ST(0), errnum) ; - SvPOK_on(ST(0)) ; - - - -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") ; - buf = (Byte*)SvPV(sv, len) ; + OUTPUT: + RETVAL - 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") ; - buf = (Byte*)SvPV(sv, len) ; - - if (items < 2) - crc = crcInitial; - else if (SvOK(ST(1))) - crc = SvUV(ST(1)) ; - else - crc = crcInitial; MODULE = Compress::Zlib PACKAGE = Compress::Zlib void -_deflateInit(level, method, windowBits, memLevel, strategy, bufsize, dictionary) +_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 + SV* dictionary PPCODE: - int err ; deflateStream s ; if (trace) - warn("in _deflateInit(level=%d, method=%d, windowBits=%d, memLevel=%d, strategy=%d, bufsize=%d\n", + 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(bufsize)) ) { + if ((s = InitStream() )) { s->Level = level; s->Method = method; @@ -669,8 +872,13 @@ _deflateInit(level, method, windowBits, memLevel, strategy, bufsize, dictionary) method, windowBits, memLevel, strategy); /* Check if a dictionary has been specified */ + if (err == Z_OK && SvCUR(dictionary)) { - err = deflateSetDictionary(&(s->stream), (const Bytef*) SvPVX(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 ; } @@ -679,6 +887,8 @@ _deflateInit(level, method, windowBits, memLevel, strategy, bufsize, dictionary) Safefree(s) ; s = NULL ; } + else + PostInitStream(s, flags, bufsize, windowBits) ; } else @@ -686,28 +896,36 @@ _deflateInit(level, method, windowBits, memLevel, strategy, bufsize, dictionary) XPUSHs(sv_setref_pv(sv_newmortal(), "Compress::Zlib::deflateStream", (void*)s)); - if (GIMME == G_ARRAY) - XPUSHs(sv_2mortal(newSViv(err))) ; + if (GIMME == G_ARRAY) { + SV * sv = sv_2mortal(newSViv(err)) ; + setDUALstatus(sv, err); + XPUSHs(sv) ; + } void -_inflateInit(windowBits, bufsize, dictionary) +_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=%d, dictionary=%d\n", - windowBits, bufsize, SvCUR(dictionary)) ; - if ((s = InitStream(bufsize)) ) { + 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 ; @@ -716,14 +934,29 @@ _inflateInit(windowBits, bufsize, 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(), - "Compress::Zlib::inflateStream", (void*)s)); - if (GIMME == G_ARRAY) - XPUSHs(sv_2mortal(newSViv(err))) ; + 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) ; + } @@ -731,35 +964,63 @@ MODULE = Compress::Zlib PACKAGE = Compress::Zlib::deflateStream void DispStream(s, message=NULL) - Compress::Zlib::deflateStream s - char * message + 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 -void -deflate (s, buf) +DualType +deflate (s, buf, output) Compress::Zlib::deflateStream s SV * buf - uLong outsize = NO_INIT - SV * output = NO_INIT - int err = 0; - PPCODE: - - /* If the buffer is a reference, dereference it */ + SV * output + uInt cur_length = NO_INIT + uInt increment = NO_INIT + int RETVAL = 0; + CODE: + + /* If the input buffer is a reference, dereference it */ buf = deRef(buf, "deflate") ; /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPV(buf, *(STRLEN*)&s->stream.avail_in) ; - /* s->stream.next_in = (Bytef*)SvPVX(buf); */ - s->stream.avail_in = SvCUR(buf) ; - - /* and the output buffer */ - /* output = sv_2mortal(newSVpv("", s->bufinc)) ; */ - output = sv_2mortal(newSV(s->bufinc)) ; - SvPOK_only(output) ; - SvCUR_set(output, 0) ; - outsize = s->bufinc ; - s->stream.next_out = (Bytef*) SvPVX(output) ; - s->stream.avail_out = outsize; - +#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(buf, *(STRLEN*)&s->stream.avail_in) ; + /* 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); */ + } + 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; @@ -767,52 +1028,93 @@ deflate (s, buf) -- 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 */ s->bufinc *= 2 ; - SvGROW(output, outsize + s->bufinc) ; - s->stream.next_out = (Bytef*) SvPVX(output) + outsize ; - outsize += s->bufinc ; - s->stream.avail_out = s->bufinc ; + 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; } - err = deflate(&(s->stream), Z_NO_FLUSH); - if (err != Z_OK) + + RETVAL = deflate(&(s->stream), Z_NO_FLUSH); + if (RETVAL != Z_OK) break; } - if (err == Z_OK) { + s->last_error = RETVAL ; + if (RETVAL == Z_OK) { SvPOK_only(output); - SvCUR_set(output, outsize - s->stream.avail_out) ; + SvCUR_set(output, cur_length + increment - s->stream.avail_out) ; } - else - output = &PL_sv_undef ; - XPUSHs(output) ; - if (GIMME == G_ARRAY) - XPUSHs(sv_2mortal(newSViv(err))) ; + OUTPUT: + RETVAL + output - void -flush(s, f=Z_FINISH) +DESTROY(s) Compress::Zlib::deflateStream s - int f - uLong outsize = NO_INIT - SV * output = NO_INIT - int err = Z_OK ; - PPCODE: + 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 + CODE: s->stream.avail_in = 0; /* should be zero already anyway */ - /* output = sv_2mortal(newSVpv("", s->bufinc)) ; */ - output = sv_2mortal(newSV(s->bufinc)) ; - SvPOK_only(output) ; - SvCUR_set(output, 0) ; - outsize = s->bufinc ; - s->stream.next_out = (Bytef*) SvPVX(output) ; - s->stream.avail_out = outsize; - + /* 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); */ + } + 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; @@ -820,38 +1122,59 @@ flush(s, f=Z_FINISH) -- 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 */ s->bufinc *= 2 ; - SvGROW(output, outsize + s->bufinc) ; - s->stream.next_out = (Bytef*)SvPVX(output) + outsize ; - outsize += s->bufinc ; - s->stream.avail_out = s->bufinc ; + 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; } - err = deflate(&(s->stream), f); + 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 || err != Z_OK ) + if (s->stream.avail_out != 0 || RETVAL != Z_OK ) break; } - err = (err == Z_STREAM_END ? Z_OK : err) ; + RETVAL = (RETVAL == Z_STREAM_END ? Z_OK : RETVAL) ; + s->last_error = RETVAL ; - if (err == Z_OK) { + if (RETVAL == Z_OK) { SvPOK_only(output); - SvCUR_set(output, outsize - s->stream.avail_out) ; + SvCUR_set(output, cur_length + increment - s->stream.avail_out) ; } - else - output = &PL_sv_undef ; - XPUSHs(output) ; - if (GIMME == G_ARRAY) - XPUSHs(sv_2mortal(newSViv(err))) ; + OUTPUT: + RETVAL + output -int + +DualType _deflateParams(s, flags, level, strategy, bufsize) Compress::Zlib::deflateStream s int flags @@ -859,20 +1182,39 @@ _deflateParams(s, flags, level, strategy, bufsize) 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 (bufsize) { + 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 @@ -893,16 +1235,32 @@ get_Strategy(s) OUTPUT: RETVAL -void -DESTROY(s) - Compress::Zlib::deflateStream s - CODE: - deflateEnd(&s->stream) ; - if (s->dictionary) - SvREFCNT_dec(s->dictionary) ; - Safefree(s) ; + +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 @@ -912,10 +1270,18 @@ dict_adler(s) RETVAL uLong +adler32(s) + Compress::Zlib::deflateStream s + CODE: + RETVAL = s->adler32 ; + OUTPUT: + RETVAL + +uLong total_in(s) Compress::Zlib::deflateStream s CODE: - RETVAL = s->stream.total_in ; + RETVAL = s->stream.total_in ; OUTPUT: RETVAL @@ -923,7 +1289,7 @@ uLong total_out(s) Compress::Zlib::deflateStream s CODE: - RETVAL = s->stream.total_out ; + RETVAL = s->stream.total_out ; OUTPUT: RETVAL @@ -931,99 +1297,173 @@ char* msg(s) Compress::Zlib::deflateStream s CODE: - RETVAL = s->stream.msg; + 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 + Compress::Zlib::inflateStream s + char * message -void -inflate (s, buf) +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) Compress::Zlib::inflateStream s SV * buf - uLong outsize = NO_INIT - SV * output = NO_INIT - int err = Z_OK ; - ALIAS: - __unc_inflate = 1 - PPCODE: - + SV * output + uInt cur_length = NO_INIT + uInt prefix_length = NO_INIT + uInt increment = 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*)SvPVX(buf) ; - s->stream.avail_in = SvCUR(buf) ; + s->stream.next_in = (Bytef*)SvPVbyte_force(buf, *(STRLEN*)&s->stream.avail_in) ; - /* and the output buffer */ - output = sv_2mortal(newSV(s->bufinc+1)) ; - SvPOK_only(output) ; - SvCUR_set(output, 0) ; - outsize = s->bufinc ; - s->stream.next_out = (Bytef*) SvPVX(output) ; - s->stream.avail_out = outsize; - + /* 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); + } + prefix_length = cur_length = SvCUR(output) ; + s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; + increment = SvLEN(output) - cur_length; + s->stream.avail_out = increment; + s->bytesInflated = 0; + while (1) { if (s->stream.avail_out == 0) { + /* out of space in the output buffer so make it bigger */ s->bufinc *= 2 ; - SvGROW(output, outsize + s->bufinc+1) ; - s->stream.next_out = (Bytef*) SvPVX(output) + outsize ; - outsize += s->bufinc ; - s->stream.avail_out = s->bufinc ; + Sv_Grow(output, SvLEN(output) + s->bufinc + 1) ; + cur_length += increment ; + s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; + increment = s->bufinc ; + s->stream.avail_out = increment; } - err = inflate(&(s->stream), Z_SYNC_FLUSH); - if (err == Z_BUF_ERROR) { - if (s->stream.avail_out == 0) - continue ; - if (s->stream.avail_in == 0) { - err = Z_OK ; - break ; - } - } + RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH); - if (err == Z_NEED_DICT && s->dictionary) { - s->dict_adler = s->stream.adler ; - err = inflateSetDictionary(&(s->stream), - (const Bytef*)SvPVX(s->dictionary), - SvCUR(s->dictionary)); - } - - if (err != Z_OK) + + 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; } - if (err == Z_OK || err == Z_STREAM_END || err == Z_DATA_ERROR) { + 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; SvPOK_only(output); - SvCUR_set(output, outsize - s->stream.avail_out) ; - *SvEND(output) = '\0'; - - /* fix the input buffer */ - if (ix == 0) { - in = s->stream.avail_in ; - SvCUR_set(buf, in) ; - if (in) - Move(s->stream.next_in, SvPVX(buf), in, char) ; + 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); } } - else - output = &PL_sv_undef ; - XPUSHs(output) ; - if (GIMME == G_ARRAY) - XPUSHs(sv_2mortal(newSViv(err))) ; + OUTPUT: + RETVAL + buf + output -int +uLong +inflateCount(s) + Compress::Zlib::inflateStream s + CODE: + RETVAL = s->bytesInflated; + OUTPUT: + RETVAL + + +DualType inflateSync (s, buf) Compress::Zlib::inflateStream s SV * buf @@ -1031,9 +1471,13 @@ inflateSync (s, buf) /* 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*)SvPVX(buf) ; + s->stream.next_in = (Bytef*)SvPVbyte_nolen(buf) ; s->stream.avail_in = SvCUR(buf) ; /* inflateSync doesn't create any output */ @@ -1041,18 +1485,20 @@ inflateSync (s, buf) s->stream.avail_out = 0; RETVAL = inflateSync(&(s->stream)); + s->last_error = RETVAL ; + + /* fix the input buffer */ { - /* fix the input buffer */ unsigned in = s->stream.avail_in ; - SvCUR_set(buf, in) ; if (in) - Move(s->stream.next_in, SvPVX(buf), in, char) ; + Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; *SvEND(buf) = '\0'; SvSETMAGIC(buf); } OUTPUT: RETVAL + buf void DESTROY(s) @@ -1061,10 +1507,34 @@ DESTROY(s) 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: @@ -1076,7 +1546,15 @@ uLong total_in(s) Compress::Zlib::inflateStream s CODE: - RETVAL = s->stream.total_in ; + RETVAL = s->stream.total_in ; + OUTPUT: + RETVAL + +uLong +adler32(s) + Compress::Zlib::inflateStream s + CODE: + RETVAL = s->adler32 ; OUTPUT: RETVAL @@ -1084,7 +1562,7 @@ uLong total_out(s) Compress::Zlib::inflateStream s CODE: - RETVAL = s->stream.total_out ; + RETVAL = s->stream.total_out ; OUTPUT: RETVAL @@ -1092,8 +1570,328 @@ char* msg(s) Compress::Zlib::inflateStream s CODE: - RETVAL = s->stream.msg; + 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 +scan(s, buf, out=NULL) + Compress::Zlib::inflateScanStream s + SV * buf + SV * out + int start_len = NO_INIT + ALIAS: + inflate = 1 + CODE: + /* If the input buffer is a reference, dereference it */ + ix = ix ; /* warning suppression */ +#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, *(STRLEN*)&s->stream.avail_in) ; + 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) + 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->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 ; + + 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 +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 index 638d076..c56cc03 100755 --- a/ext/Compress/Zlib/config.in +++ b/ext/Compress/Zlib/config.in @@ -1,21 +1,27 @@ # Filename: config.in # # written by Paul Marquess -# last modified 18th July 2005 -# version 1.35 +# 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 section "Controlling the version of zlib used by -# Compress::Zlib" in the README file for details of how to use this file. +# 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 +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/filtdef b/ext/Compress/Zlib/examples/filtdef index 57dfeb9..71e54da 100755 --- a/ext/Compress/Zlib/examples/filtdef +++ b/ext/Compress/Zlib/examples/filtdef @@ -1,29 +1,27 @@ #!/usr/local/bin/perl +use Compress::Zlib 2 ; + use strict ; use warnings ; -use Compress::Zlib ; - binmode STDIN; binmode STDOUT; -my $x = deflateInit() + +my $x = new Compress::Zlib::Deflate() or die "Cannot create a deflation stream\n" ; -my ($output, $status) ; +my $output = '' ; + while (<>) { - ($output, $status) = $x->deflate($_) ; - - $status == Z_OK - or die "deflation failed\n" ; + $x->deflate($_, $output) == Z_OK + or die "deflate failed\n" ; print $output ; } -($output, $status) = $x->flush() ; - -$status == Z_OK - or die "deflation failed\n" ; +$x->flush($output) == Z_OK + or die "flush failed\n" ; print $output ; diff --git a/ext/Compress/Zlib/examples/filtinf b/ext/Compress/Zlib/examples/filtinf index 1df202b..bbac2c2 100755 --- a/ext/Compress/Zlib/examples/filtinf +++ b/ext/Compress/Zlib/examples/filtinf @@ -1,21 +1,23 @@ #!/usr/local/bin/perl +use Compress::Zlib 2 ; + use strict ; use warnings ; -use Compress::Zlib ; +binmode STDIN; +binmode STDOUT; -my $x = inflateInit() +my $x = new Compress::Zlib::Inflate or die "Cannot create a inflation stream\n" ; my $input = '' ; -binmode STDIN; -binmode STDOUT; +my $output = '' ; +my $status ; -my ($output, $status) ; while (read(STDIN, $input, 4096)) { - ($output, $status) = $x->inflate(\$input) ; + $status = $x->inflate($input, $output) ; print $output if $status == Z_OK or $status == Z_STREAM_END ; diff --git a/ext/Compress/Zlib/examples/gzcat b/ext/Compress/Zlib/examples/gzcat index 3bbd297..5572bae 100755 --- a/ext/Compress/Zlib/examples/gzcat +++ b/ext/Compress/Zlib/examples/gzcat @@ -1,30 +1,29 @@ #!/usr/local/bin/perl +use IO::Uncompress::Gunzip qw( $GunzipError ); use strict ; use warnings ; -use Compress::Zlib ; - #die "Usage: gzcat file...\n" # unless @ARGV ; -my $filename ; +my $file ; +my $buffer ; +my $s; @ARGV = '-' unless @ARGV ; -foreach my $filename (@ARGV) { - my $buffer ; - - my $file = $filename ; - $file = \*STDIN if $file eq '-' ; - - my $gz = gzopen($file, "rb") - or die "Cannot open $file: $gzerrno\n" ; +foreach $file (@ARGV) { + + my $gz = new IO::Uncompress::Gunzip $file + or die "Cannot open $file: $GunzipError\n" ; - print $buffer while $gz->gzread($buffer) > 0 ; + print $buffer + while ($s = $gz->read($buffer)) > 0 ; - die "Error reading from $filename: $gzerrno" . ($gzerrno+0) . "\n" - if $gzerrno != Z_STREAM_END ; + die "Error reading from $file: $GunzipError\n" + if $s < 0 ; - $gz->gzclose() ; + $gz->close() ; } + diff --git a/ext/Compress/Zlib/examples/gzcat.zlib b/ext/Compress/Zlib/examples/gzcat.zlib new file mode 100644 index 0000000..5ccb700 --- /dev/null +++ b/ext/Compress/Zlib/examples/gzcat.zlib @@ -0,0 +1,25 @@ +#!/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/examples/gzgrep b/ext/Compress/Zlib/examples/gzgrep index 324d3e6..33820ba 100755 --- a/ext/Compress/Zlib/examples/gzgrep +++ b/ext/Compress/Zlib/examples/gzgrep @@ -1,17 +1,30 @@ -#!/usr/local/bin/perl +#!/usr/bin/perl use strict ; use warnings ; +use IO::Uncompress::Gunzip qw($GunzipError); -use Compress::Zlib ; - -die "Usage: gzgrep pattern file...\n" - unless @ARGV >= 2; +die "Usage: gzgrep pattern [file...]\n" + unless @ARGV >= 1; my $pattern = shift ; - my $file ; +@ARGV = '-' unless @ARGV ; + +foreach $file (@ARGV) { + my $gz = new IO::Uncompress::Gunzip $file + or die "Cannot uncompress $file: $GunzipError\n" ; + + while (<$gz>) { + print if /$pattern/ ; + } + + die "Error reading from $file: $GunzipError\n" + if $GunzipError ; +} + +__END__ foreach $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; diff --git a/ext/Compress/Zlib/examples/gzstream b/ext/Compress/Zlib/examples/gzstream index cb03a2c..9d03bc5 100755 --- a/ext/Compress/Zlib/examples/gzstream +++ b/ext/Compress/Zlib/examples/gzstream @@ -2,17 +2,23 @@ use strict ; use warnings ; +use IO::Compress::Gzip qw(gzip $GzipError); -use Compress::Zlib ; +gzip '-' => '-', Minimal => 1 + or die "gzstream: $GzipError\n" ; -binmode STDOUT; # gzopen only sets it on the fd +#exit 0; -my $gz = gzopen(\*STDOUT, "wb") - or die "Cannot open stdout: $gzerrno\n" ; +__END__ + +#my $gz = new IO::Compress::Gzip *STDOUT +my $gz = new IO::Compress::Gzip '-' + or die "gzstream: Cannot open stdout as gzip stream: $GzipError\n" ; while (<>) { - $gz->gzwrite($_) - or die "error writing: $gzerrno\n" ; + $gz->write($_) + or die "gzstream: Error writing gzip output stream: $GzipError\n" ; } -$gz->gzclose ; +$gz->close + or die "gzstream: Error closing gzip output stream: $GzipError\n" ; diff --git a/ext/Compress/Zlib/fallback.h b/ext/Compress/Zlib/fallback/constants.h similarity index 90% rename from ext/Compress/Zlib/fallback.h rename to ext/Compress/Zlib/fallback/constants.h index 2aef05e..323f236 100644 --- a/ext/Compress/Zlib/fallback.h +++ b/ext/Compress/Zlib/fallback/constants.h @@ -24,12 +24,23 @@ 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_ERRNO */ - /* Offset 5 gives the best switch position. */ - switch (name[5]) { + 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, "OS_CODE", 7)) { - /* ^ */ + 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; @@ -39,8 +50,8 @@ constant_7 (pTHX_ const char *name, IV *iv_return) { } break; case 'I': - if (memEQ(name, "Z_ASCII", 7)) { - /* ^ */ + if (memEQ(name, "Z_ASCI", 6)) { + /* I */ #ifdef Z_ASCII *iv_return = Z_ASCII; return PERL_constant_ISIV; @@ -49,9 +60,20 @@ constant_7 (pTHX_ const char *name, IV *iv_return) { #endif } break; - case 'N': - if (memEQ(name, "Z_ERRNO", 7)) { - /* ^ */ + 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; @@ -287,16 +309,16 @@ constant (pTHX_ const char *name, STRLEN len, IV *iv_return, const char **pv_ret Regenerate these constant functions by feeding this entire source file to perl -x -#!/home/paul/perl/install/redhat6.1/bleed/bin/perl5.7.2 -w +#!/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_BUF_ERROR + 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_FULL_FLUSH Z_HUFFMAN_ONLY + 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_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH + Z_PARTIAL_FLUSH Z_RLE Z_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH Z_UNKNOWN Z_VERSION_ERROR), {name=>"ZLIB_VERSION", type=>"PV"}); @@ -320,6 +342,16 @@ __END__ #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 diff --git a/ext/Compress/Zlib/fallback.xs b/ext/Compress/Zlib/fallback/constants.xs similarity index 100% rename from ext/Compress/Zlib/fallback.xs rename to ext/Compress/Zlib/fallback/constants.xs diff --git a/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm b/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm new file mode 100644 index 0000000..358dfaa --- /dev/null +++ b/ext/Compress/Zlib/lib/Compress/Gzip/Constants.pm @@ -0,0 +1,137 @@ +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_05'; + +@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/Zlib/Common.pm b/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm new file mode 100644 index 0000000..1106105 --- /dev/null +++ b/ext/Compress/Zlib/lib/Compress/Zlib/Common.pm @@ -0,0 +1,421 @@ +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); +@ISA = qw(Exporter); +$VERSION = '2.000_05'; + +@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput ckInputParam + isaFileGlobString cleanFileGlobString oneTarget + setBinModeInput setBinModeOutput + ckOutputParam ckInOutParams + WANT_CODE + WANT_EXT + WANT_UNDEF + WANT_HASH + ); + +sub setBinModeInput($) +{ + my $handle = shift ; + + #binmode $handle if $] == 5.008 ; + #binmode $handle unless isSTDIN($handle) ; +} + +sub setBinModeOutput($) +{ + my $handle = shift ; + + #binmode $handle if $] == 5.008; + #binmode $handle unless isSTDOUT($handle) ; +} + +#sub isSTDIO($) +#{ +# my $handle = shift ; +# +# return 0 unless isaFilehandle($handle); +# return fileno $handle == fileno STDIN || fileno $handle == fileno STDOUT; +#} +# +#sub isSTDIN($) +#{ +# my $handle = shift ; +# +# return 0 unless isaFilehandle($handle); +# return fileno $handle == fileno STDIN; +#} +# +#sub isSTDOUT($) +#{ +# my $handle = shift ; +# +# return 0 unless isaFilehandle($handle); +# return fileno $handle == fileno STDOUT; +#} + +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 ; + +sub whatIsInput($;$) +{ + my $got = whatIs(@_); + #return $got; + 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(@_); + #return $got; + 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 ckInputParam ($$$;$) +{ + my $from = shift ; + my $inType = whatIsInput($_[0], $_[2]); + local $Carp::CarpLevel = 1; + + croak "$from: input parameter not a filename, filehandle, array ref or scalar ref" + if ! $inType ; + + if ($inType eq 'filename' ) + { + croak "$from: input filename is undef or null string" + if ! defined $_[0] || $_[0] eq '' ; + + if ($_[0] ne '-' && ! -e $_[0] ) + { + ${$_[1]} = "input file '$_[0]' does not exist"; + return undef; + } + } + + return 1; +} + +sub ckOutputParam ($$$) +{ + my $from = shift ; + my $outType = whatIsOutput($_[0]); + local $Carp::CarpLevel = 1; + + croak "$from: output parameter not a filename, filehandle or scalar ref" + if ! $outType ; + + croak "$from: output filename is undef or null string" + if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ; + + croak("$from: output buffer is read-only") + if $outType eq 'buffer' && readonly(${ $_[0] }); + + return 1; +} + +#sub ckInOutParams($$$$) +#{ +# my $from = shift ; +# +# ckInputParam($from, $_[0], $_[2]) +# or return undef ; +# ckOutputParam($from, $_[1], $_[2]) +# or return undef ; +# +# my $inType = whatIs($_[0]); +# my $outType = whatIs($_[1]); +# +# # Check that input != output +# if ($inType eq $outType && $_[0] eq $_[1]) +# { +# local $Carp::CarpLevel = 1; +# croak("$from: input and output $inType are identical"); +# } +# +# return 1; +#} + + +sub Validator::new +{ + my $class = shift ; + + my $Class = shift ; + my $type = shift ; + my $error_ref = shift ; + my $reportClass = shift ; + + my %data = (Class => $Class, + Type => $type, + 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) + { + croak "$reportClass: illegal input parameter" ; + #return undef ; + } + + if ($inType eq 'hash') + { + $obj->{Hash} = 1 ; + $obj->{oneInput} = 1 ; + return $obj->validateHash($_[0]); + } + + if (! $outType) + { + croak "$reportClass: illegal output parameter" ; + #return undef ; + } + + + if ($inType ne 'fileglob' && $outType eq 'fileglob') + { + ${ $data{Error} } = "Need input fileglob for outout fileglob"; + return undef ; + } + + if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' ) + { + ${ $data{Error} } = "input must ne filename or fileglob when output is a hash"; + return undef ; + } + + if ($inType eq 'fileglob' && $outType eq 'fileglob') + { + $data{GlobMap} = 1 ; + $data{inType} = $data{outType} = 'filename'; + my $mapper = new File::GlobMapper($_[0], $_[1]); + if ( ! $mapper ) + { + ${ $data{Error} } = $File::GlobMapper::Error ; + return undef ; + } + $data{Pairs} = $mapper->getFileMap(); + + return $obj; + } + + croak("$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) + { + # legal or die? + die "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') + { + $obj->validateInputArray($_[0]) + or return undef ; + } + + croak("$reportClass: output buffer is read-only") + if $outType eq 'buffer' && Compress::Zlib::_readonly_ref($_[1]); + + if ($outType eq 'filename' ) + { + croak "$reportClass: output filename is undef or null string" + if ! defined $_[1] || $_[1] eq '' ; + } + + return $obj ; +} + + +sub Validator::validateInputFilenames +{ + my $self = shift ; + + foreach my $filename (@_) + { + croak "$self->{reportClass}: input filename is undef or null string" + if ! defined $filename || $filename eq '' ; + + next if $filename eq '-'; + + if (! -e $filename ) + { + ${ $self->{Error} } = "input file '$filename' does not exist"; + return undef; + } + + if (! -r $filename ) + { + ${ $self->{Error} } = "cannot open file '$filename': $!"; + return undef; + } + } + + return 1 ; +} + +sub Validator::validateInputArray +{ + my $self = shift ; + + foreach my $element ( @{ $_[0] } ) + { + my $inType = whatIsInput($element); + + if (! $inType) + { + ${ $self->{Error} } = "unknown input parameter" ; + return undef ; + } + } + + 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') + { + ${ $self->{Error} } = "hash key not filename" ; + return undef ; + } + + my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ; + if (! $valid{$vtype}) + { + ${ $self->{Error} } = "hash value not ok" ; + return undef ; + } + } + + return $self ; +} + +1; diff --git a/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm b/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm new file mode 100644 index 0000000..69befce --- /dev/null +++ b/ext/Compress/Zlib/lib/Compress/Zlib/FileConstants.pm @@ -0,0 +1,75 @@ + +package Compress::Zlib::FileConstants ; + +use strict ; +use warnings; +use bytes; + +require Exporter; + +our ($VERSION, @ISA, @EXPORT); + +$VERSION = '2.000_05'; + +@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 new file mode 100644 index 0000000..d89ec67 --- /dev/null +++ b/ext/Compress/Zlib/lib/Compress/Zlib/ParseParameters.pm @@ -0,0 +1,262 @@ + +package Compress::Zlib::ParseParameters ; + +use strict; +use warnings; +use Carp; + +require Exporter; +our ($VERSION, @ISA, @EXPORT); +$VERSION = '2.000_05'; +@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 ; + +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 (@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] ; + } + } + + + my %got = () ; + while (my ($key, $v) = each %$default) + { + my ($type, $value) = @$v ; + my $x ; + $self->_checkType($key, \$value, $type, 0, \$x) + or return undef ; + $got{lc $key} = [0, $type, $value, $x] ; + } + + 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/^-// ; + + if ($got{lc $key}) + { + my $type = $got{lc $key}[OFF_TYPE] ; + my $s ; + $self->_checkType($key, $value, $type, 1, \$s) + or return undef ; + #$value = $$value unless $type & Parse_store_ref ; + $value = $$value ; + $got{lc $key} = [1, $type, $value, $s] ; + } + else + { push (@Bad, $key) } + } + + if (@Bad) { + my ($bad) = join(", ", @Bad) ; + return $self->setError("unknown key value(s) @Bad") ; + } + + $self->{Got} = { %got } ; + + 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) + { + $$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] ; + +} + +1; + diff --git a/ext/Compress/Zlib/lib/File/GlobMapper.pm b/ext/Compress/Zlib/lib/File/GlobMapper.pm new file mode 100644 index 0000000..b854226 --- /dev/null +++ b/ext/Compress/Zlib/lib/File/GlobMapper.pm @@ -0,0 +1,697 @@ +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::glob; + } + else + { + require File::Glob; import File::Glob qw(:glob) ; + $CSH_GLOB = File::Glob::GLOB_CSH() ; + #*globber = \&File::Glob::bsd_glob; + *globber = \&File::Glob::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 directoty + + 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 delimired 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 delimeters 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 verions 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 "*" chanacter 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 examles 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/Deflate.pm b/ext/Compress/Zlib/lib/IO/Compress/Deflate.pm new file mode 100644 index 0000000..8e7e724 --- /dev/null +++ b/ext/Compress/Zlib/lib/IO/Compress/Deflate.pm @@ -0,0 +1,852 @@ +package IO::Compress::Deflate ; + +use strict ; +use warnings; +require Exporter ; + +use IO::Compress::Gzip ; + + +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError); + +$VERSION = '2.000_05'; +$DeflateError = ''; + +@ISA = qw(Exporter IO::BaseDeflate); +@EXPORT_OK = qw( $DeflateError deflate ) ; +%EXPORT_TAGS = %IO::BaseDeflate::EXPORT_TAGS ; +push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; +Exporter::export_ok_tags('all'); + + + +sub new +{ + my $pkg = shift ; + return IO::BaseDeflate::new($pkg, 'rfc1950', undef, \$DeflateError, @_); +} + +sub deflate +{ + return IO::BaseDeflate::_def(__PACKAGE__, 'rfc1950', \$DeflateError, @_); +} + + +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(); + $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"; + + deflate \%hash [,OPTS] + or die "deflate failed: $DeflateError\n"; + +The functional interface needs Perl5.005 or better. + + +=head2 deflate $input => $output [, OPTS] + +If the first parameter is not a hash reference 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, the input data will be read from each +element of the array in turn. The action taken by C with +each element of the array will depend on the type of data stored +in it. You can mix and match any of the types defined in this list, +excluding other array or hash references. +The complete array will be walked to ensure that it only +contains valid data types 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 A Hash Reference + +If C<$output> is a hash reference, the compressed data will be written +to C<$output{$input}> as a scalar reference. + +When C<$output> is a hash reference, C<$input> must be either a filename or +list of filenames. Anything else is an error. + + +=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 deflate \%hash [, OPTS] + +If the first parameter is a hash reference, C<\%hash>, this will be used to +define both the source of uncompressed data and to control where the +compressed data is output. Each key/value pair in the hash defines a +mapping between an input filename, stored in the key, and an output +file/buffer, stored in the value. Although the input can only be a filename, +there is more flexibility to control the destination of the compressed +data. This is determined by the type of the value. Valid types are + +=over 5 + +=item undef + +If the value is C the compressed data will be written to the +value as a scalar reference. + +=item A filename + +If the value 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 value 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 the value is a scalar reference, the compressed data will be stored +in the buffer that is referenced by the scalar. + + +=item A Hash Reference + +If the value is a hash reference, the compressed data will be written +to C<$hash{$input}> as a scalar reference. + +=item An Array Reference + +If C<$output> is an array reference, the compressed data will be pushed +onto the array. + +=back + +Any other type is a error. + +=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 -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 dependant 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 behavior 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 + +Usage is + + $z->newStream + +TODO + +=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 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 new file mode 100644 index 0000000..ce4255f --- /dev/null +++ b/ext/Compress/Zlib/lib/IO/Compress/Gzip.pm @@ -0,0 +1,2546 @@ + +package IO::Compress::Gzip ; + +require 5.004 ; + +use strict ; +use warnings; + +# create RFC1952 + +require Exporter ; + +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); + +$VERSION = '2.000_05'; +$GzipError = '' ; + +@ISA = qw(Exporter IO::BaseDeflate); +@EXPORT_OK = qw( $GzipError gzip ) ; +%EXPORT_TAGS = %IO::BaseDeflate::EXPORT_TAGS ; +push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; +Exporter::export_ok_tags('all'); + +sub new +{ + my $pkg = shift ; + return IO::BaseDeflate::new($pkg, 'rfc1952', undef, \$GzipError, @_); +} + + +sub gzip +{ + return IO::BaseDeflate::_def(__PACKAGE__, 'rfc1952', \$GzipError, @_); +} + +package IO::BaseDeflate; + + +use Compress::Zlib 2 ; +use Compress::Zlib::Common; +use Compress::Zlib::FileConstants; +use Compress::Zlib::ParseParameters; +use Compress::Gzip::Constants; +use IO::Uncompress::Gunzip; + +use IO::File ; +#use File::Glob; +require Exporter ; +use Carp ; +use Symbol; +use bytes; + +our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS, $got_encode); +@ISA = qw(Exporter IO::File); +%EXPORT_TAGS = ( flush => [qw{ + Z_NO_FLUSH + Z_PARTIAL_FLUSH + Z_SYNC_FLUSH + Z_FULL_FLUSH + Z_FINISH + Z_BLOCK + }], + level => [qw{ + Z_NO_COMPRESSION + Z_BEST_SPEED + Z_BEST_COMPRESSION + Z_DEFAULT_COMPRESSION + }], + strategy => [qw{ + Z_FILTERED + Z_HUFFMAN_ONLY + Z_RLE + Z_FIXED + Z_DEFAULT_STRATEGY + }], + + ); + +{ + my %seen; + foreach (keys %EXPORT_TAGS ) + { + push @{$EXPORT_TAGS{constants}}, + grep { !$seen{$_}++ } + @{ $EXPORT_TAGS{$_} } + } + $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ; +} + +Exporter::export_ok_tags('all'); + + +BEGIN +{ + if (defined &utf8::downgrade ) + { *noUTF8 = \&utf8::downgrade } + else + { *noUTF8 = sub {} } +} + + +$VERSION = '2.000_03'; + +#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 error +{ + my $self = shift ; + return ${ *$self->{Error} } ; +} + +sub errorNo +{ + my $self = shift ; + return ${ *$self->{ErrorNo} } ; +} + +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 mkDeflateHeader ($) +{ + 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 mkGzipHeader +{ + 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 checkParams +{ + my $class = shift ; + my $type = shift ; + + my $rfc1952 = ($type eq 'rfc1952'); + my $rfc1950 = ($type eq 'rfc1950'); + + my $got = Compress::Zlib::ParseParameters::new(); + + $got->parse( + $rfc1952 ? + { + 'AutoClose'=> [Parse_boolean, 0], + #'Encoding'=> [Parse_any, undef], + 'Strict' => [Parse_boolean, 1], + 'Append' => [Parse_boolean, 0], + 'Merge' => [Parse_boolean, 0], + + # zlib behaviour + #'Method' => [Parse_unsigned, Z_DEFLATED], + 'Level' => [Parse_signed, Z_DEFAULT_COMPRESSION], + 'Strategy' => [Parse_signed, Z_DEFAULT_STRATEGY], + + # Gzip header fields + 'Minimal' => [Parse_boolean, 0], + 'Comment' => [Parse_any, undef], + 'Name' => [Parse_any, undef], + 'Time' => [Parse_any, undef], + 'TextFlag' => [Parse_boolean, 0], + 'HeaderCRC' => [Parse_boolean, 0], + 'OS_Code' => [Parse_unsigned, $Compress::Zlib::gzip_os_code], + 'ExtraField'=> [Parse_string, undef], + 'ExtraFlags'=> [Parse_any, undef], + } + : + { + 'AutoClose' => [Parse_boolean, 0], + #'Encoding' => [Parse_any, undef], + 'CRC32' => [Parse_boolean, 0], + 'ADLER32' => [Parse_boolean, 0], + 'Strict' => [Parse_boolean, 1], + 'Append' => [Parse_boolean, 0], + 'Merge' => [Parse_boolean, 0], + + # zlib behaviour + #'Method' => [Parse_unsigned, Z_DEFLATED], + 'Level' => [Parse_signed, Z_DEFAULT_COMPRESSION], + 'Strategy' => [Parse_signed, Z_DEFAULT_STRATEGY], + }, + @_) or croak "${class}: $got->{Error}" ; + + return $got ; +} + +sub new +{ + my $class = shift ; + my $type = shift ; + my $got = shift; + my $error_ref = shift ; + + croak("$class: Missing Output parameter") + if ! @_ && ! $got ; + + my $outValue = shift ; + my $oneShot = 1 ; + + if (! $got) + { + $oneShot = 0 ; + $got = checkParams($class, $type, @_) + or return undef ; + } + + my $rfc1952 = ($type eq 'rfc1952'); + my $rfc1950 = ($type eq 'rfc1950'); + my $rfc1951 = ($type eq 'rfc1951'); + + my $obj = bless Symbol::gensym(), ref($class) || $class; + tie *$obj, $obj if $] >= 5.005; + + *$obj->{Closed} = 1 ; + $$error_ref = '' ; + *$obj->{Error} = $error_ref ; + + my $lax = ! $got->value('Strict') ; + + my $outType = whatIsOutput($outValue); + + ckOutputParam($class, $outValue, $error_ref) + 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')) { +# croak("$class: Encode module needed to use -Encoding") +# if ! $got_encode; +# +# my $want_encoding = $got->value('Encoding'); +# my $encoding = find_encoding($want_encoding); +# +# croak("$class: Encoding '$want_encoding' is not available") +# if ! $encoding; +# +# *$obj->{Encoding} = $encoding; +# } + + if ($rfc1952 && ! $merge) { + + 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 $obj->saveErrorString(undef, "Null Character found in Name", + Z_DATA_ERROR) + if ! $lax && $name =~ /\x00/ ; + + return $obj->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 $obj->saveErrorString(undef, "Null Character found in Comment", + Z_DATA_ERROR) + if ! $lax && $comment =~ /\x00/ ; + + return $obj->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 $obj->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 = $obj->parseExtraField($got, $lax) ; + return $obj->saveErrorString(undef, $bad, Z_DATA_ERROR) + if $bad ; + + my $len = length $got->value('ExtraField') ; + return $obj->saveErrorString(undef, ExtraFieldError("Too Large"), + Z_DATA_ERROR) + if $len > GZIP_FEXTRA_MAX_SIZE; + } + } + + $obj->saveStatus(Z_OK) ; + + my $end_offset = 0; + my $status ; + if (! $merge) + { + (*$obj->{Deflate}, $status) = new Compress::Zlib::Deflate + -AppendOutput => 1, + -CRC32 => $rfc1952 || $got->value('CRC32'), + -ADLER32 => $rfc1950 || $got->value('ADLER32'), + -Level => $got->value('Level'), + -Strategy => $got->value('Strategy'), + -WindowBits => - MAX_WBITS; + return $obj->saveErrorString(undef, "Cannot create Deflate object: $status" ) + if $obj->saveStatus($status) != Z_OK ; + + *$obj->{BytesWritten} = 0 ; + *$obj->{ISize} = 0 ; + + *$obj->{Header} = mkDeflateHeader($got) + if $rfc1950 ; + *$obj->{Header} = '' + if $rfc1951 ; + *$obj->{Header} = mkGzipHeader($got) + if $rfc1952 ; + + if ( $outType eq 'buffer') { + ${ *$obj->{Buffer} } = '' + unless $appendOutput ; + ${ *$obj->{Buffer} } .= *$obj->{Header}; + } + else { + if ($outType eq 'handle') { + $outValue->flush() ; + *$obj->{FH} = $outValue ; + *$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 (!$rfc1951) { + defined *$obj->{FH}->write(*$obj->{Header}, length(*$obj->{Header})) + or return $obj->saveErrorString(undef, $!, $!) ; + } + } + } + else + { + my %mapping = ( 'rfc1952' => ['IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError], + 'rfc1950' => ['IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError], + 'rfc1951' => ['IO::Uncompress::RawInflate', \$IO::Uncompress::RawInflate::RawInflateError], + ); + + my $inf = IO::BaseInflate::new($mapping{$type}[0], + $type, undef, + $error_ref, 0, $outValue, + Transparent => 0, + #Strict => 1, + AutoClose => 0, + Scan => 1); + + return $obj->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) + if ! defined $inf ; + + $inf->scan() + or return $obj->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ; + $inf->zap($end_offset) + or return $obj->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ; + + (*$obj->{Deflate}, $status) = $inf->createDeflate(); + + *$obj->{Header} = *$inf->{Info}{Header}; + *$obj->{ISize} = + *$obj->{ISize} = *$obj->{BytesWritten} = *$inf->{ISize} ; + + if ( $outType eq 'buffer') + { substr( ${ *$obj->{Buffer} }, $end_offset) = '' } + elsif ($outType eq 'handle' || $outType eq 'filename') { + *$obj->{FH} = *$inf->{FH} ; + delete *$inf->{FH}; + *$obj->{FH}->flush() ; + *$obj->{Handle} = 1 if $outType eq 'handle'; + + #seek(*$obj->{FH}, $end_offset, SEEK_SET) + *$obj->{FH}->seek($end_offset, SEEK_SET) + or return $obj->saveErrorString(undef, $!, $!) ; + } + } + + *$obj->{Closed} = 0 ; + *$obj->{AutoClose} = $got->value('AutoClose') ; + *$obj->{OutputGzip} = $rfc1952; + *$obj->{OutputDeflate} = $rfc1950; + *$obj->{OutputRawDeflate} = $rfc1951; + *$obj->{Output} = $outValue; + *$obj->{ClassName} = $class; + + return $obj ; +} + +sub _def +{ + my $class = shift ; + my $type = shift ; + my $error_ref = shift ; + + my $name = (caller(1))[3] ; + + croak "$name: expected at least 1 parameters\n" + unless @_ >= 1 ; + + my $input = shift ; + my $haveOut = @_ ; + my $output = shift ; + + my $x = new Validator($class, $type, $error_ref, $name, $input, $output) + or return undef ; + + push @_, $output if $haveOut && $x->{Hash}; + + my $got = checkParams($name, $type, @_) + or return undef ; + + $x->{Got} = $got ; + $x->{ParsedTime} = $got->parsed('Time') ; + $x->{ParsedName} = $got->parsed('Name') ; + + if ($x->{Hash}) + { + while (my($k, $v) = each %$input) + { + $v = \$input->{$k} + unless defined $v ; + + _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 ; + _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 ; + + _singleTarget($x, $inFile, $in, \$out, @_) + or return undef ; + + if ($x->{outType} eq 'array') + { push @$output, \$out } + else + { $output->{$in} = \$out } + } + + return 1 ; + } + + # finally the 1 to 1 and n to 1 + return _singleTarget($x, 1, $input, $output, @_); + + croak "should not be here" ; +} + +sub _singleTarget +{ + my $x = shift ; + my $inputIsFilename = shift; + my $input = shift; + + + # For gzip, if input is simple filename, populate Name & Time in + # gzip header from filename by default. + if ($x->{Type} eq 'rfc1952' and isaFilename($input) and $inputIsFilename) + { + my $defaultTime = (stat($input))[8] ; + + $x->{Got}->value('Name' => $input) + if ! $x->{ParsedName}; + + $x->{Got}->value('Time' => $defaultTime) + if ! $x->{ParsedTime}; + } + + my $gzip = new($x->{Class}, $x->{Type}, $x->{Got}, $x->{Error}, @_) + or return undef ; + + + if ($x->{oneInput}) + { + defined $gzip->_wr2($input, $inputIsFilename) + or return undef ; + } + else + { + my $afterFirst = 0 ; + my $inputIsFilename = ($x->{inType} ne 'array'); + + for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) + { + if ( $afterFirst ++ ) + { + defined addInterStream($gzip, $x, $element, $inputIsFilename) + or return undef ; + } + + defined $gzip->_wr2($element, $inputIsFilename) + or return undef ; + } + } + + return $gzip->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': $!", $!) ; + } + setBinModeInput($fh) ; + + 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 no be here"; + return undef; +} + +sub addInterStream +{ + my $gzip = shift ; + my $x = shift ; + my $input = shift ; + my $inputIsFilename = shift ; + + if ($x->{Got}->value('MultiStream')) + { + # For gzip, if input is simple filename, populate Name & Time in + # gzip header from filename by default. + if ($x->{Type} eq 'rfc1952' and isaFilename($input) and $inputIsFilename) + { + my $defaultTime = (stat($input))[8] ; + + $x->{Got}->value('Name' => $input) + if ! $x->{ParsedName}; + + $x->{Got}->value('Time' => $defaultTime) + if ! $x->{ParsedTime}; + } + + # TODO -- newStream needs to allow gzip header to be modified + return $gzip->newStream(); + } + elsif ($x->{Got}->value('AutoFlush')) + { + return $gzip->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 validateInput +#{ +# my $class = shift ; +# +# #local $Carp::CarpLevel = 1; +# +# if ( ! ref $_[0] || +# ref $_[0] eq 'SCALAR' || +# #ref $_[0] eq 'CODE' || +# isaFilehandle($_[0]) ) +# { +# my $inType = whatIs($_[0]); +# my $outType = whatIs($_[1]); +# +# if ($inType eq 'filename' ) +# { +# croak "$class: input filename is undef or null string" +# if ! defined $_[0] || $_[0] eq '' ; +# +# if ($_[0] ne '-' && ! -e $_[0] ) +# { +# ${$_[2]} = "input file '$_[0]' does not exist"; +# $_[3] = $!; +# return undef; +# } +# +# if (! -r $_[0] ) +# { +# ${$_[2]} = "cannot open file '$_[0]': $!"; +# $_[3] = $!; +# return undef; +# } +# } +# elsif ($inType eq 'fileglob' ) +# { +# # whatever... +# } +# +# croak("$class: input and output $inType are identical") +# if defined $outType && $inType eq $outType && $_[0] eq $_[1] ; +# +# return 1 ; +# } +# +# croak "$class: input parameter not a filename, filehandle, array ref or scalar ref" +# unless ref $_[0] eq 'ARRAY' ; +# +# my $array = shift @_ ; +# foreach my $element ( @{ $array } ) +# { +# return undef +# unless validateInput($class, $element, @_); +# } +# +# return 1 ; +#} + + +#sub write +#{ +# my $self = shift ; +# +# if ( isaFilehandle $_[0] ) +# { +# return $self->_wr(@_); +# } +# +# if ( ref $_[0]) +# { +# if ( ref $_[0] eq 'SCALAR' ) +# { return $self->syswrite(@_) } +# +# if ( ref $_[0] eq 'ARRAY' ) +# { +# my ($str, $num); +# validateInput(*$self->{ClassName} . "::write", $_[0], *$self->{Output}, \$str, $num) +# or return $self->saveErrorString(undef, $str, $num); +# +# return $self->_wr(@_); +# } +# +# croak *$self->{ClassName} . "::write: input parameter not a filename, filehandle, array ref or scalar ref"; +# } +# +# # Not a reference or a filehandle +# return $self->syswrite(@_) ; +#} +# +#sub _wr +#{ +# my $self = shift ; +# +# if ( ref $_[0] && ref $_[0] eq 'SCALAR' ) +# { +# return $self->syswrite(@_) ; +# } +# +# if ( ! ref $_[0] || isaFilehandle($_[0])) +# { +# my $item = shift @_ ; +# my $isFilehandle = isaFilehandle($item) ; +# +# my $fh = $item ; +# +# if ( ! $isFilehandle ) +# { +# $fh = new IO::File "<$item" +# or return $self->saveErrorString(undef, "cannot open file '$item': $!", $!) ; +# } +# +# 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} ) +# { +# $fh->close() +# or return undef ; +# } +# +# return $count ; +# } +# +# #if ref $_[0] eq 'CODE' ; +# +# # then must be ARRAY ref +# my $count = 0 ; +# my $array = shift @_ ; +# foreach my $element ( @{ $array } ) +# { +# my $got = $self->_wr($element, @_) ; +# +# return undef +# unless defined $got ; +# +# $count += $got ; +# } +# +# return $count ; +#} + + +sub syswrite +{ + my $self = shift ; + + my $buffer ; + if (ref $_[0] ) { + croak *$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; + croak *$self->{ClassName} . "::write: offset outside string" if $offset > $slen; + if ($offset < 0) { + $offset += $slen; + croak *$self->{ClassName} . "::write: offset outside string" if $offset < 0; + } + my $rem = $slen - $offset; + $len = $rem if $rem < $len; + } + + $buffer = \substr($$buffer, $offset, $len) ; + } + + my $buffer_length = defined $$buffer ? length($$buffer) : 0 ; + *$self->{BytesWritten} += $buffer_length ; + my $rest = GZIP_ISIZE_MAX - *$self->{ISize} ; + if ($buffer_length > $rest) { + *$self->{ISize} = $buffer_length - $rest - 1; + } + else { + *$self->{ISize} += $buffer_length ; + } + +# if (*$self->{Encoding}) { +# $$buffer = *$self->{Encoding}->encode($$buffer); +# } + + #my $length = length $$buffer; + my $status = *$self->{Deflate}->deflate($buffer, *$self->{Buffer}) ; + + return $self->saveErrorString(undef,"Deflate Error: $status") + if $self->saveStatus($status) != Z_OK ; + + 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 || Z_FINISH ; + my $status = *$self->{Deflate}->flush(*$self->{Buffer}, $opt) ; + return $self->saveErrorString(0,"Deflate Error: $status") + if $self->saveStatus($status) != Z_OK ; + + 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(GZIP_MINIMUM_HEADER) + or return 0 ; + + my $status = *$self->{Deflate}->deflateReset() ; + return $self->saveErrorString(0,"Deflate Error: $status") + if $self->saveStatus($status) != Z_OK ; + + *$self->{BytesWritten} = 0 ; + *$self->{ISize} = 0 ; + + return 1 ; +} + +sub _writeTrailer +{ + my $self = shift ; + my $nextHeader = shift || '' ; + + my $status = *$self->{Deflate}->flush(*$self->{Buffer}) ; + return $self->saveErrorString(0,"Deflate Error: $status") + if $self->saveStatus($status) != Z_OK ; + + if (*$self->{OutputGzip}) { + ${ *$self->{Buffer} } .= pack("V V", *$self->{Deflate}->crc32(), + *$self->{ISize} ); + ${ *$self->{Buffer} } .= $nextHeader ; + } + + if (*$self->{OutputDeflate}) { + ${ *$self->{Buffer} } .= pack("N", *$self->{Deflate}->adler32() ); + ${ *$self->{Buffer} } .= *$self->{Header} ; + } + + 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->{Deflate} ; + *$self->{Closed} = 1 ; + + untie *$self + if $] >= 5.008 ; + + if (0) { + $self->_writeTrailer() + or return 0 ; + } + else { + + + my $status = *$self->{Deflate}->flush(*$self->{Buffer}) ; + return $self->saveErrorString(0,"Deflate Error: $status") + if $self->saveStatus($status) != Z_OK ; + + if (*$self->{OutputGzip}) { + ${ *$self->{Buffer} } .= pack("V V", *$self->{Deflate}->crc32(), + *$self->{ISize} ); + } + + if (*$self->{OutputDeflate}) { + ${ *$self->{Buffer} } .= pack("N", *$self->{Deflate}->adler32() ); + } + + + return 1 if ! defined *$self->{FH} ; + + defined *$self->{FH}->write(${ *$self->{Buffer} }, length( ${ *$self->{Buffer} } )) + or return $self->saveErrorString(0, $!, $!); + + ${ *$self->{Buffer} } = '' ; + } + + 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 deflateParams +{ + my $self = shift ; + my $level = shift ; + my $strategy = shift ; + + my $status = *$self->{Deflate}->deflateParams(-Level => $level, + -Strategy => $strategy) ; + return $self->saveErrorString(0,"deflateParams Error: $status") + if $self->saveStatus($status) != Z_OK ; + + return 1; +} + + +#sub total_in +#sub total_out +#sub msg +# +#sub crc +#{ +# my $self = shift ; +# return *$self->{Deflate}->crc32() ; +#} +# +#sub msg +#{ +# my $self = shift ; +# return *$self->{Deflate}->msg() ; +#} +# +#sub dict_adler +#{ +# my $self = shift ; +# return *$self->{Deflate}->dict_adler() ; +#} +# +#sub get_Level +#{ +# my $self = shift ; +# return *$self->{Deflate}->get_Level() ; +#} +# +#sub get_Strategy +#{ +# my $self = shift ; +# return *$self->{Deflate}->get_Strategy() ; +#} + + +sub tell +{ + my $self = shift ; + + #return *$self->{Deflate}->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 { + croak *$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 + croak *$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__ + +=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(); + $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"; + + gzip \%hash [,OPTS] + or die "gzip failed: $GzipError\n"; + +The functional interface needs Perl5.005 or better. + + +=head2 gzip $input => $output [, OPTS] + +If the first parameter is not a hash reference 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, the input data will be read from each +element of the array in turn. The action taken by C with +each element of the array will depend on the type of data stored +in it. You can mix and match any of the types defined in this list, +excluding other array or hash references. +The complete array will be walked to ensure that it only +contains valid data types 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 behavior of the gzip +executable. +If you do not want to use these defaults they can be overridden by +explicitly setting the C and C