diff options
| author | Paul Marquess <paul.marquess@btinternet.com> | 2006-03-03 10:25:48 +0000 |
|---|---|---|
| committer | Steve Peters <steve@fisharerojo.org> | 2006-03-06 02:06:04 +0000 |
| commit | 25f0751fb55a0f87a7e18ae8960f9acf2407ae32 (patch) | |
| tree | 439063d46a0c0b86716646c06a093caf2f50aa44 /ext/Compress/Zlib | |
| parent | 274ac62a3e605d66baf0a73d4dde20b3a2ea7120 (diff) | |
| download | perl-25f0751fb55a0f87a7e18ae8960f9acf2407ae32.tar.gz | |
Compress::Zlib
From: "Paul Marquess" <paul.marquess@ntlworld.com>
Message-ID: <007101c63eac$d919c6c0$4c05140a@myopwv.com>
p4raw-id: //depot/perl@27384
Diffstat (limited to 'ext/Compress/Zlib')
| -rw-r--r-- | ext/Compress/Zlib/Changes | 6 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/Makefile.PL | 609 | ||||
| -rw-r--r-- | ext/Compress/Zlib/README | 391 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/examples/filtdef | 22 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/examples/filtinf | 14 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/examples/gzcat | 29 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/examples/gzgrep | 25 | ||||
| -rwxr-xr-x | ext/Compress/Zlib/examples/gzstream | 20 | ||||
| -rw-r--r-- | ext/Compress/Zlib/lib/Compress/Zlib.pm | 1462 | ||||
| -rw-r--r-- | ext/Compress/Zlib/private/MakeUtil.pm | 287 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/01version.t | 2 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/03zlib-v1.t | 15 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/05examples.t | 9 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/06gzsetp.t | 4 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/08encoding.t | 4 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/14gzopen.t | 6 | ||||
| -rw-r--r-- | ext/Compress/Zlib/t/99pod.t | 2 |
17 files changed, 1914 insertions, 993 deletions
diff --git a/ext/Compress/Zlib/Changes b/ext/Compress/Zlib/Changes index 1b74408034..ec29cfeab4 100644 --- a/ext/Compress/Zlib/Changes +++ b/ext/Compress/Zlib/Changes @@ -1,7 +1,11 @@ CHANGES ------- - 2.000_07 9 January 2006 + 2.000_08 2 March 2006 + + * Moved the IO::* modules out into their own distributions. + + 2.000_08 9 January 2006 * Breakout zlib specific code into separate modules. diff --git a/ext/Compress/Zlib/Makefile.PL b/ext/Compress/Zlib/Makefile.PL index 4226634fd8..63c8bce450 100755 --- a/ext/Compress/Zlib/Makefile.PL +++ b/ext/Compress/Zlib/Makefile.PL @@ -3,585 +3,40 @@ use strict ; require 5.004 ; +use private::MakeUtil; use ExtUtils::MakeMaker 5.16 ; -use Config qw(%Config) ; -use File::Copy ; -BEGIN -{ - eval { require File::Spec::Functions ; File::Spec::Functions->import() } ; - if ($@) - { - *catfile = sub { return "$_[0]/$_[1]" } - } -} - -require VMS::Filespec if $^O eq 'VMS'; - -my $ZLIB_LIB ; -my $ZLIB_INCLUDE ; -my $BUILD_ZLIB = 0 ; -my $OLD_ZLIB = '' ; -my $WALL = '' ; -my $GZIP_OS_CODE = -1 ; - -#$WALL = ' -pedantic ' if $Config{'cc'} =~ /gcc/ ; -#$WALL = ' -Wall -Wno-comment ' if $Config{'cc'} =~ /gcc/ ; - -unless($ENV{PERL_CORE}) { - $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; -} - -# 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} or $ENV{PERL_CORE})) -{ - print <<EOM ; - -I see you are running Cygwin. - -Please note that this module cannot be installed on Cygwin using the -CPAN shell. The CPAN Shell uses Compress::Zlib internally and it is not -possible to delete an active DLL. - -If you are running the CPAN shell, please exit it and install this module -by hand by running 'make install' under the directory - - ~/.cpan/build/Compress-Zlib-VERSION - -EOM - - print "Do you want to continue? [Y/N]: " ; - my $answer = <STDIN> ; - - if ($answer =~ /^yes|y/i) - { - print "continuing...\n" - } - else - { - print "exiting...\n" ; - exit 1 ; - } - - -} - -ParseCONFIG() ; - -my @files = ('Zlib.pm', 't/ZlibTestUtils.pm', - glob("t/*.t"), - glob("t/*.pl"), - glob("lib/CompressPlugin/*.pm"), - glob("lib/UncompressPlugin/*.pm"), - glob("lib/IO/Compress/*.pm"), - glob("lib/IO/Uncompress/*.pm"), - glob("lib/Compress/Zlib/*.pm"), - glob("lib/Compress/Gzip/*.pm"), - glob("lib/File/*.pm"), - glob("bzip2/*.pm"), - grep(!/\.bak$/, glob("examples/*"))) ; - -UpDowngrade(@files) unless $ENV{PERL_CORE}; - -WriteMakefile( - NAME => 'Compress::Zlib', - VERSION_FROM => 'Zlib.pm', - #OPTIMIZE => '-g', - INC => "-I$ZLIB_INCLUDE" , - DEFINE => "$OLD_ZLIB $WALL -DGZIP_OS_CODE=$GZIP_OS_CODE" , - XS => { 'Zlib.xs' => 'Zlib.c'}, - $ENV{PERL_CORE} - ? (MAN3PODS => {}) - : (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', - }, - ($BUILD_ZLIB - ? zlib_files($ZLIB_LIB) - : (LIBS => [ "-L$ZLIB_LIB -lz " ]) - ), - $] >= 5.005 - ? (ABSTRACT_FROM => 'Zlib.pm', - AUTHOR => 'Paul Marquess <pmqs@cpan.org>') - : (), - - ) ; - -my @names = qw( - - DEF_WBITS - MAX_MEM_LEVEL - MAX_WBITS - OS_CODE - - Z_ASCII - Z_BEST_COMPRESSION - Z_BEST_SPEED - Z_BINARY - Z_BLOCK - Z_BUF_ERROR - Z_DATA_ERROR - Z_DEFAULT_COMPRESSION - Z_DEFAULT_STRATEGY - Z_DEFLATED - Z_ERRNO - Z_FILTERED - Z_FINISH - Z_FIXED - Z_FULL_FLUSH - Z_HUFFMAN_ONLY - Z_MEM_ERROR - Z_NEED_DICT - Z_NO_COMPRESSION - Z_NO_FLUSH - Z_NULL - Z_OK - Z_PARTIAL_FLUSH - Z_RLE - Z_STREAM_END - Z_STREAM_ERROR - Z_SYNC_FLUSH - Z_UNKNOWN - Z_VERSION_ERROR - - ); - #ZLIB_VERNUM - -if (eval {require ExtUtils::Constant; 1}) { - # Check the constants above all appear in @EXPORT in Zlib.pm - my %names = map { $_, 1} @names, 'ZLIB_VERSION'; - open F, "<Zlib.pm" or die "Cannot open Zlib.pm: $!\n"; - while (<F>) - { - last if /^\s*\@EXPORT\s+=\s+qw\(/ ; - } - - while (<F>) - { - last if /^\s*\)/ ; - /(\S+)/ ; - delete $names{$1} if defined $1 ; - } - close F ; - - if ( keys %names ) - { - my $missing = join ("\n\t", sort keys %names) ; - die "The following names are missing from \@EXPORT in Zlib.pm\n" . - "\t$missing\n" ; - } - - push @names, {name => 'ZLIB_VERSION', type => 'PV' }; - - ExtUtils::Constant::WriteConstants( - NAME => 'Zlib', - NAMES => \@names, - C_FILE => 'constants.h', - XS_FILE => 'constants.xs', - - ); -} -else { - 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; - - return undef - if $path =~ /(~|\.bak|_bak)$/ || - $path =~ /\..*\.sw(o|p)$/ || - $path =~ /\B\.svn\b/; - - return $path; -} - -sub MY::postamble -{ - my $postamble = <<'EOM'; - -downgrade: - @echo Downgrading. - perl Makefile.PL -downgrade - -MyDoubleCheck: - @echo Checking config.in is setup for a release - @(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 - -MyTrebleCheck: - @echo Checking for $$^W in files: '. "@files" . ' - @perl -ne \' \ - exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/; \ - \' ' . " @files || " . ' \ - (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-unicode: - @echo Running test suite with unicode support enabled - env PERL_UNICODE=63 $(MAKE) test - -EOM - - $postamble .= <<'EOM' if $^O eq 'linux' ; - -gcov: - @echo Running test suite with gcov and Devel::Cover [needs gcc 3.4?] - rm -f *.o *.gcov *.da *.bbg *.bb *.gcno - HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test \ - OPTIMIZE=-g \ - CCFLAGS=-O0\ -fprofile-arcs\ -ftest-coverage \ - OTHERLDFLAGS=-fprofile-arcs\ -ftest-coverage - gcov Zlib.xs - gcov2perl -db cover_db Zlib.xs.gcov -EOM - - return $postamble; - -} - -sub ParseCONFIG -{ - my ($k, $v) ; - my @badkey = () ; - my %Info = () ; - my @Options = qw( INCLUDE LIB BUILD_ZLIB OLD_ZLIB GZIP_OS_CODE ) ; - my %ValidOption = map {$_, 1} @Options ; - my %Parsed = %ValidOption ; - my $CONFIG = 'config.in' ; - - print "Parsing $CONFIG...\n" ; - - open(F, "<$CONFIG") or die "Cannot open file $CONFIG: $!\n" ; - while (<F>) { - s/^\s*|\s*$//g ; - next if /^\s*$/ or /^\s*#/ ; - s/\s*#\s*$// ; - - ($k, $v) = split(/\s+=\s+/, $_, 2) ; - $k = uc $k ; - if ($ValidOption{$k}) { - delete $Parsed{$k} ; - $Info{$k} = $v ; - } - else { - push(@badkey, $k) ; - } - } - close F ; - - print "Unknown keys in $CONFIG ignored [@badkey]\n" - if @badkey ; - - # check parsed values - my @missing = () ; - die "The following keys are missing from $CONFIG [@missing]\n" - if @missing = keys %Parsed ; - - $ZLIB_INCLUDE = $ENV{'ZLIB_INCLUDE'} || $Info{'INCLUDE'} ; - $ZLIB_LIB = $ENV{'ZLIB_LIB'} || $Info{'LIB'} ; - - if ($^O eq 'VMS') { - $ZLIB_INCLUDE = VMS::Filespec::vmspath($ZLIB_INCLUDE); - $ZLIB_LIB = VMS::Filespec::vmspath($ZLIB_LIB); - } - - my $y = $ENV{'OLD_ZLIB'} || $Info{'OLD_ZLIB'} ; - $OLD_ZLIB = '-DOLD_ZLIB' if $y and $y =~ /^yes|on|true|1$/i; - - my $x = $ENV{'BUILD_ZLIB'} || $Info{'BUILD_ZLIB'} ; - - if ($x and $x =~ /^yes|on|true|1$/i ) { - - $BUILD_ZLIB = 1 ; - - # ZLIB_LIB & ZLIB_INCLUDE must point to the same place when - # BUILD_ZLIB is specified. - die "INCLUDE & LIB must be the same when BUILD_ZLIB is True\n" - if $ZLIB_LIB ne $ZLIB_INCLUDE ; - - # Check the zlib source directory exists - die "LIB/INCLUDE directory '$ZLIB_LIB' does not exits\n" - unless -d $ZLIB_LIB ; - - # check for a well known file - die "LIB/INCLUDE directory, '$ZLIB_LIB', doesn't seem to have the zlib source files\n" - unless -e catfile($ZLIB_LIB, 'zlib.h') ; - - - # 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 <<EOM if 0 ; - INCLUDE [$ZLIB_INCLUDE] - LIB [$ZLIB_LIB] - GZIP_OS_CODE [$GZIP_OS_CODE] - OLD_ZLIB [$OLD_ZLIB] - BUILD_ZLIB [$BUILD_ZLIB] - -EOM - - print "Looks Good.\n" ; - -} - -sub UpDowngrade -{ - my @files = @_ ; - - # our and use bytes/utf8 is stable from 5.6.0 onward - # warnings is stable from 5.6.1 onward - - # Note: this code assumes that each statement it modifies is not - # split across multiple lines. - - - my $warn_sub = ''; - my $our_sub = '' ; - - my $opt = shift @ARGV || '' ; - my $upgrade = ($opt =~ /^-upgrade/i); - my $downgrade = ($opt =~ /^-downgrade/i); - push @ARGV, $opt unless $downgrade || $upgrade; - - if ($downgrade) { - # From: use|no warnings "blah" - # To: local ($^W) = 1; # use|no warnings "blah" - $warn_sub = sub { - s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ; - s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; - }; - } - elsif ($] >= 5.006001 || $upgrade) { - # From: local ($^W) = 1; # use|no warnings "blah" - # To: use|no warnings "blah" - $warn_sub = sub { - s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ; - }; - } - - if ($downgrade) { - $our_sub = sub { - if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { - my $indent = $1; - my $vars = join ' ', split /\s*,\s*/, $2; - $_ = "${indent}use vars qw($vars);\n"; - } - elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/) - { - $_ = "$1# $2\n"; - } - }; - } - elsif ($] >= 5.006000 || $upgrade) { - $our_sub = sub { - if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { - my $indent = $1; - my $vars = join ', ', split ' ', $2; - $_ = "${indent}our ($vars);\n"; - } - elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/) - { - $_ = "$1$2\n"; - } - }; - } - - if (! $our_sub && ! $warn_sub) { - warn "Up/Downgrade not needed.\n"; - if ($upgrade || $downgrade) - { exit 0 } - else - { return } - } - - foreach (@files) - { doUpDown($our_sub, $warn_sub, $_) } - - warn "Up/Downgrade complete.\n" ; - exit 0 if $upgrade || $downgrade; - -} - - -sub doUpDown -{ - my $our_sub = shift; - my $warn_sub = shift; - - return if -d $_[0]; - - local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; - local (@ARGV) = shift; - - while (<>) - { - print, last if /^__(END|DATA)__/ ; - - &{ $our_sub }() if $our_sub ; - &{ $warn_sub }() if $warn_sub ; - print ; - } - - return if eof ; - - while (<>) - { print } -} - - -sub zlib_files -{ - my $dir = shift ; - - my @h_files = (); - my @c_files = (); - - if (-f catfile($dir, "infback.c")) { - # 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 - ); - @c_files = qw(adler32 crc32 infback inflate uncompr - 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 - ); - @c_files = qw(adler32 compress crc32 uncompr - deflate trees zutil inflate infblock - inftrees infcodes infutil inffast - ); - } - - @h_files = map { catfile($dir, $_) } @h_files ; - my @o_files = map { "$_\$(OBJ_EXT)" } 'Zlib', @c_files; - @c_files = map { "$_.c" } 'Zlib', @c_files ; - - foreach my $file (@c_files) - { copy(catfile($dir, $file), '.') } - - return ( - #'H' => [ @h_files ], - 'C' => [ @c_files ] , - #'OBJECT' => qq[ @o_files ], - 'OBJECT' => q[ $(O_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' ; -} +UpDowngrade(getPerlFiles('MANIFEST')) + unless $ENV{PERL_CORE}; + +WriteMakefile( + NAME => 'Compress::Zlib', + VERSION_FROM => 'lib/Compress/Zlib.pm', + 'dist' => { COMPRESS => 'gzip', + TARFLAGS => '-chvf', + SUFFIX => 'gz', + DIST_DEFAULT => 'MyTrebleCheck tardist', + }, + + ( + $ENV{SKIP_FOR_CORE} + ? (MAN3PODS => {}) + : (PREREQ_PM => { 'Compress::Raw::Zlib' => 0, + 'IO::Compress::Base' => 0, + 'IO::Compress::Zlib' => 0, + 'Scalar::Util' => 0, + } + ) + ), + + ( + $] >= 5.005 + ? (ABSTRACT_FROM => 'lib/Compress/Zlib.pm', + AUTHOR => 'Paul Marquess <pmqs@cpan.org>') + : () + ), + +) ; # end of file Makefile.PL diff --git a/ext/Compress/Zlib/README b/ext/Compress/Zlib/README index ec1aee4e60..1a1c253c85 100644 --- a/ext/Compress/Zlib/README +++ b/ext/Compress/Zlib/README @@ -1,41 +1,30 @@ - Compress::Zlib + Compress::Zlib - Version 2.000_07 + Version 2.000_08 + + 27 Feb 2006 - 9 Jan 2006 Copyright (c) 1995-2006 Paul Marquess. All rights reserved. - This program is free software; you can redistribute it - and/or modify it under the same terms as Perl itself. + 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 - http://www.zlib.org - WARNING - THIS IS BETA CODE. + WARNING + THIS IS BETA CODE. - DO NOT use in production code. - Please report any problems. + DO NOT use in production code. + Please report any problems. DESCRIPTION ----------- -This module provides a Perl interface to most of the zlib compression -library. For more details see the pod documentation embedded in the file -Zlib.pm. -If you have downloaded this module in the expectation of manipulating the -contents of .zip files, you will need to fetch and build the Archive::Zip -module below once you have installed this one. +This module provides a Perl interface to the zlib compression library. - http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz @@ -46,14 +35,13 @@ PREREQUISITES Before you can build Compress::Zlib you need to have the following installed on your system: - * A C compiler * Perl 5.004 or better. + * Compress::Raw::Zlib + * IO::Compress::Gzip + + -By default, Compress::Zlib will build its own private copy of the zlib -library. If you want to use a different version of zlib, follow the -instructions in the section called "Controlling the version of zlib used -by Compress::Zlib" later in this document. BUILDING THE MODULE @@ -75,151 +63,23 @@ To install Compress::Zlib, run the command below: make install -UPDATES -------- - -The most recent version of Compress::Zlib is always available at - - http://www.cpan.org/modules/by-module/Compress/ - - - -Controlling the version of zlib used by Compress::Zlib ------------------------------------------------------ - -Compress::Zlib interfaces to the zlib compression library. There are -three options available to control which version/instance of the zlib -library is used: - - 1. Build a private copy of the zlib library using the zlib library - source that is included with this module. - This is the default and recommended option. - - 2. Build a private copy of the zlib library using a standard zlib - source distribution. - - 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.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 read during the - - perl Makefile.PL - -step of the build, so remember to make any required changes to config.in -before building this module. - - - - Option 1 - -------- - - 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 - GZIP_OS_CODE = AUTO_DETECT - - - Option 2 - -------- - - 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.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.2.3, change the INCLUDE and LIB - variables appropriately): - - BUILD_ZLIB = True - INCLUDE = ./zlib-1.2.3 - LIB = ./zlib-1.2.3 - OLD_ZLIB = False - GZIP_OS_CODE = AUTO_DETECT - - - Option 3 - -------- - - For option 3, you need to find out where zlib is stored on your system. - There are two parts to this. - - First, find the directory where the zlib library is stored (some common - names for the library are libz.a and libz.so). Set the LIB variable in - the config.in file to that directory. - - 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. - - 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 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 = 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 --------------- + Undefined Symbol gzsetparams ---------------------------- If you get the error shown below when you run the Compress::Zlib test -harness it probably means you are running a copy of zlib that is version -1.0.5 or older. +harness it probably means you are running a copy of zlib that is +version 1.0.5 or older. t/01version.........Can't load 'blib/arch/auto/Compress/Zlib/Zlib.so' for - module Compress::Zlib: blib/arch/auto/Compress/Zlib/Zlib.so: + module Compress::Raw::Zlib: blib/arch/auto/Compress/Raw/Zlib/Zlib.so: undefined symbol: gzsetparams at ... There are two ways to fix this problem: @@ -232,9 +92,9 @@ There are two ways to fix this problem: Test Harness 01version fails ---------------------------- -If the 01version test harness fails, and the problem isn't covered by -the scenario above, it probably means that you have two versions of zlib -installed on your system. +If the 01version test harness fails, and the problem isn't covered by the +scenario above, it probably means that you have two versions of +zlib installed on your system. Run the command below to see if this is indeed the case @@ -244,150 +104,9 @@ Try removing the one you don't want to use and rebuild. -Solaris build fails with "language optional software package not installed" ---------------------------------------------------------------------------- - -If you are trying to build this module under Solaris and you get an -error message like this - - /usr/ucb/cc: language optional software package not installed - -it means that Perl cannot find the C compiler on your system. The cryptic -message is just Sun's way of telling you that you haven't bought their -C compiler. - -When you build a Perl module that needs a C compiler, the Perl build -system tries to use the same C compiler that was used to build perl -itself. In this case your Perl binary was built with a C compiler that -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 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. - -If you have installed another C compiler, say gcc, you have to tell perl -how to use it instead of /usr/ucb/cc. - -This set of options seems to work if you want to use gcc. Your mileage -may vary. - - perl Makefile.PL CC=gcc CCCDLFLAGS=-fPIC OPTIMIZE=" " - make test - -If that doesn't work for you, it's time to make changes to the Makefile -by hand. Good luck! - - - - -Solaris build fails with "gcc: unrecognized option `-KPIC'" ------------------------------------------------------------ - -You are running Solaris and you get an error like this when you try to -build this Perl module - - gcc: unrecognized option `-KPIC' - -This symptom usually means that you are using a Perl binary that has been -built with the Sun C compiler, but you are using gcc to build this module. - -When Perl builds modules that need a C compiler, it will attempt to use -the same C compiler and command line options that was used to build perl -itself. In this case "-KPIC" is a valid option for the Sun C compiler, -but not for gcc. The equivalent option for gcc is "-fPIC". - -The solution is either: - - 1. Build both Perl and this module with the same C compiler, either - by using the Sun C compiler for both or gcc for both. - - 2. Try generating the Makefile for this module like this perl - - perl Makefile.PL CC=gcc CCCDLFLAGS=-fPIC OPTIMIZE=" " LD=gcc - make test - - This second option seems to work when mixing a Perl binary built - with the Sun C compiler and this module built with gcc. Your - 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 this test. This should not be considered a bug -in the Compress::Zlib module. - - - -HP-UX Notes ------------ - -I've had a report that when building Compress::Zlib under HP-UX that it -is necessary to have first built the zlib library with the -fpic option. - - - -Linux Notes ------------ - -Although most Linux distributions already come with zlib, some people -report getting this error when they try to build this module: - -$ make -cp Zlib.pm blib/lib/Compress/Zlib.pm -AutoSplitting blib/lib/Compress/Zlib.pm (blib/lib/auto/Compress/Zlib) -/usr/bin/perl -I/usr/lib/perl5/5.6.1/i386-linux -I/usr/lib/perl5/5.6.1 /usr/lib/perl5/5.6.1/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.6.1/ExtUtils/typemap -typemap typemap Zlib.xs > Zlib.xsc && mv Zlib.xsc Zlib.c -gcc -c -I/usr/local/include -fno-strict-aliasing -I/usr/local/include -O2 -march=i386 -mcpu=i686 -DVERSION=\"1.16\" -DXS_VERSION=\"1.16\" -fPIC -I/usr/lib/perl5/5.6.1/i386-linux/CORE Zlib.c -Zlib.xs:25:19: zlib.h: No such file or directory -make: *** [Zlib.o] Error 1 - -This usually means that you have not installed the development RPM -for zlib. Check for an RPM that start with "zlib-devel" in your Linux -distribution. - - - - -Win32 Notes ------------ - -If you are running Activestate Perl (from http://www.activestate.com), -it ships with a pre-compiled version of Compress::Zlib. To check if a -newer version of Compress::Zlib is available run this from the command -prompt - - C:\> ppm verify -upgrade Compress-Zlib - - -If you are not running Activestate Perl and you don't have access -to a C compiler, you will not be able to build and install this module. - - - - -Win32 & Cygwin Notes --------------------- - -It is not possible to install Compress::Zlib using the CPAN shell. -This is because the Compress::Zlib DLL is itself used by the CPAN shell -and it is impossible to remove a DLL while it is already loaded under -Windows. - -The workaround is to install Compress::Zlib manually using the -instructions given at the start of this file. @@ -398,42 +117,54 @@ How to report a problem with Compress::Zlib. To help me help you, I need all of the following information: - 1. The *complete* output from running this - - perl -V - - Do not edit the output in any way. - Note, I want you to run "perl -V" and NOT "perl -v". - - If your perl does not understand the "-V" option it is too - old. This module needs Perl version 5.004 or better. + 1. The Versions of everything relevant. + This includes: + + a. The *complete* output from running this + + perl -V + + Do not edit the output in any way. + Note, I want you to run "perl -V" and NOT "perl -v". + + If your perl does not understand the "-V" option it is too + old. This module needs Perl version 5.004 or better. + + b. The version of Compress::Zlib you have. + If you have successfully installed Compress::Zlib, this one-liner + will tell you: - 2. The version of Compress::Zlib you have. - If you have successfully installed Compress::Zlib, this one-liner - will tell you: + perl -MCompress::Zlib -e 'print qq[ver $Compress::Zlib::VERSION\n]' - perl -MCompress::Zlib -e 'print qq[ver $Compress::Zlib::VERSION\n]' + If you areplete* output from running this + + perl -V + + Do not edit the output in any way. + Note, I want you to run "perl -V" and NOT "perl -v". + + If your perl does not understand the "-V" option it is too + old. This module needs Perl version 5.004 or better. - If you are running windows use this + b. The version of Compress::Zlib you have. + If you have successfully installed Compress::Zlib, this one-liner + will tell you: - perl -MCompress::Zlib -e "print qq[ver $Compress::Zlib::VERSION\n]" + perl -MCompress::Zlib -e 'print qq[ver $Compress::Zlib::VERSION\n]' - If you haven't installed Compress::Zlib then search Compress::Zlib.pm - for a line like this: + If you are running windows use this - $VERSION = "1.05" ; + perl -MCompress::Zlib -e "print qq[ver $Compress::Zlib::VERSION\n]" - 3. The version of zlib you have installed. - If you have successfully installed Compress::Zlib, this one-liner - will tell you: + If you haven't installed Compress::Zlib then search Compress::Zlib.pm + for a line like this: - perl -MCompress::Zlib -e "print q[zlib ver ]. Compress::Zlib::ZLIB_VERSION.qq[\n]" + $VERSION = "1.05" ; - If not, look at the beginning of the file zlib.h. - 4. If you are having problems building Compress::Zlib, send me a - complete log of what happened. Start by unpacking the Compress:Zlib + 2. If you are having problems building Compress::Zlib, send me a + complete log of what happened. Start by unpacking the Compress::Zlib module into a fresh directory and keep a log of all the steps [edit config.in, if necessary] diff --git a/ext/Compress/Zlib/examples/filtdef b/ext/Compress/Zlib/examples/filtdef index 71e54daf93..57dfeb9068 100755 --- a/ext/Compress/Zlib/examples/filtdef +++ b/ext/Compress/Zlib/examples/filtdef @@ -1,27 +1,29 @@ #!/usr/local/bin/perl -use Compress::Zlib 2 ; - use strict ; use warnings ; +use Compress::Zlib ; + binmode STDIN; binmode STDOUT; - -my $x = new Compress::Zlib::Deflate() +my $x = deflateInit() or die "Cannot create a deflation stream\n" ; -my $output = '' ; - +my ($output, $status) ; while (<>) { - $x->deflate($_, $output) == Z_OK - or die "deflate failed\n" ; + ($output, $status) = $x->deflate($_) ; + + $status == Z_OK + or die "deflation failed\n" ; print $output ; } -$x->flush($output) == Z_OK - or die "flush failed\n" ; +($output, $status) = $x->flush() ; + +$status == Z_OK + or die "deflation failed\n" ; print $output ; diff --git a/ext/Compress/Zlib/examples/filtinf b/ext/Compress/Zlib/examples/filtinf index bbac2c269b..1df202b1d7 100755 --- a/ext/Compress/Zlib/examples/filtinf +++ b/ext/Compress/Zlib/examples/filtinf @@ -1,23 +1,21 @@ #!/usr/local/bin/perl -use Compress::Zlib 2 ; - use strict ; use warnings ; -binmode STDIN; -binmode STDOUT; +use Compress::Zlib ; -my $x = new Compress::Zlib::Inflate +my $x = inflateInit() or die "Cannot create a inflation stream\n" ; my $input = '' ; -my $output = '' ; -my $status ; +binmode STDIN; +binmode STDOUT; +my ($output, $status) ; while (read(STDIN, $input, 4096)) { - $status = $x->inflate($input, $output) ; + ($output, $status) = $x->inflate(\$input) ; 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 5572bae959..3bbd2972c9 100755 --- a/ext/Compress/Zlib/examples/gzcat +++ b/ext/Compress/Zlib/examples/gzcat @@ -1,29 +1,30 @@ #!/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 $file ; -my $buffer ; -my $s; +my $filename ; @ARGV = '-' unless @ARGV ; -foreach $file (@ARGV) { - - my $gz = new IO::Uncompress::Gunzip $file - or die "Cannot open $file: $GunzipError\n" ; +foreach my $filename (@ARGV) { + my $buffer ; + + my $file = $filename ; + $file = \*STDIN if $file eq '-' ; - print $buffer - while ($s = $gz->read($buffer)) > 0 ; + my $gz = gzopen($file, "rb") + or die "Cannot open $file: $gzerrno\n" ; - die "Error reading from $file: $GunzipError\n" - if $s < 0 ; + print $buffer while $gz->gzread($buffer) > 0 ; + + die "Error reading from $filename: $gzerrno" . ($gzerrno+0) . "\n" + if $gzerrno != Z_STREAM_END ; - $gz->close() ; + $gz->gzclose() ; } - diff --git a/ext/Compress/Zlib/examples/gzgrep b/ext/Compress/Zlib/examples/gzgrep index 33820ba064..324d3e615f 100755 --- a/ext/Compress/Zlib/examples/gzgrep +++ b/ext/Compress/Zlib/examples/gzgrep @@ -1,30 +1,17 @@ -#!/usr/bin/perl +#!/usr/local/bin/perl use strict ; use warnings ; -use IO::Uncompress::Gunzip qw($GunzipError); -die "Usage: gzgrep pattern [file...]\n" - unless @ARGV >= 1; +use Compress::Zlib ; -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" ; +die "Usage: gzgrep pattern file...\n" + unless @ARGV >= 2; - while (<$gz>) { - print if /$pattern/ ; - } +my $pattern = shift ; - die "Error reading from $file: $GunzipError\n" - if $GunzipError ; -} +my $file ; -__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 9d03bc5749..cb03a2c0fc 100755 --- a/ext/Compress/Zlib/examples/gzstream +++ b/ext/Compress/Zlib/examples/gzstream @@ -2,23 +2,17 @@ use strict ; use warnings ; -use IO::Compress::Gzip qw(gzip $GzipError); -gzip '-' => '-', Minimal => 1 - or die "gzstream: $GzipError\n" ; +use Compress::Zlib ; -#exit 0; +binmode STDOUT; # gzopen only sets it on the fd -__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" ; +my $gz = gzopen(\*STDOUT, "wb") + or die "Cannot open stdout: $gzerrno\n" ; while (<>) { - $gz->write($_) - or die "gzstream: Error writing gzip output stream: $GzipError\n" ; + $gz->gzwrite($_) + or die "error writing: $gzerrno\n" ; } -$gz->close - or die "gzstream: Error closing gzip output stream: $GzipError\n" ; +$gz->gzclose ; diff --git a/ext/Compress/Zlib/lib/Compress/Zlib.pm b/ext/Compress/Zlib/lib/Compress/Zlib.pm new file mode 100644 index 0000000000..9e65ecd3af --- /dev/null +++ b/ext/Compress/Zlib/lib/Compress/Zlib.pm @@ -0,0 +1,1462 @@ + +package Compress::Zlib; + +require 5.004 ; +require Exporter; +use AutoLoader; +use Carp ; +use IO::Handle ; +use Scalar::Util qw(dualvar); + +use IO::Compress::Base::Common ; +use Compress::Raw::Zlib; +use IO::Compress::Gzip; +use IO::Uncompress::Gunzip; + +use strict ; +use warnings ; +use bytes ; +our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); + +$VERSION = '2.000_08'; +$XS_VERSION = $VERSION; +$VERSION = eval $VERSION; + +@ISA = qw(Exporter); +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. +@EXPORT = qw( + deflateInit inflateInit + + compress uncompress + + gzopen $gzerrno + ); + +push @EXPORT, @Compress::Raw::Zlib::EXPORT ; + +BEGIN +{ + *zlib_version = \&Compress::Raw::Zlib::zlib_version; +} + +sub AUTOLOAD { + my($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + my ($error, $val) = Compress::Raw::Zlib::constant($constname); + Carp::croak $error if $error; + no strict 'refs'; + *{$AUTOLOAD} = sub { $val }; + goto &{$AUTOLOAD}; +} + +use constant FLAG_APPEND => 1 ; +use constant FLAG_CRC => 2 ; +use constant FLAG_ADLER => 4 ; +use constant FLAG_CONSUME_INPUT => 8 ; + +our (@my_z_errmsg); + +@my_z_errmsg = ( + "need dictionary", # Z_NEED_DICT 2 + "stream end", # Z_STREAM_END 1 + "", # Z_OK 0 + "file error", # Z_ERRNO (-1) + "stream error", # Z_STREAM_ERROR (-2) + "data error", # Z_DATA_ERROR (-3) + "insufficient memory", # Z_MEM_ERROR (-4) + "buffer error", # Z_BUF_ERROR (-5) + "incompatible version",# Z_VERSION_ERROR(-6) + ); + + +sub _set_gzerr +{ + my $value = shift ; + + if ($value == 0) { + $Compress::Zlib::gzerrno = 0 ; + } + elsif ($value == Z_ERRNO() || $value > 2) { + $Compress::Zlib::gzerrno = $! ; + } + else { + $Compress::Zlib::gzerrno = dualvar($value+0, $my_z_errmsg[2 - $value]); + } + + return $value ; +} + +sub _save_gzerr +{ + my $gz = shift ; + my $test_eof = shift ; + + my $value = $gz->errorNo() || 0 ; + + if ($test_eof) { + #my $gz = $self->[0] ; + # gzread uses Z_STREAM_END to denote a successful end + $value = Z_STREAM_END() if $gz->eof() && $value == 0 ; + } + + _set_gzerr($value) ; +} + +sub gzopen($$) +{ + my ($file, $mode) = @_ ; + + my $gz ; + my %defOpts = (Level => Z_DEFAULT_COMPRESSION(), + Strategy => Z_DEFAULT_STRATEGY(), + ); + + my $writing ; + $writing = ! ($mode =~ /r/i) ; + $writing = ($mode =~ /[wa]/i) ; + + $defOpts{Level} = $1 if $mode =~ /(\d)/; + $defOpts{Strategy} = Z_FILTERED() if $mode =~ /f/i; + $defOpts{Strategy} = Z_HUFFMAN_ONLY() if $mode =~ /h/i; + + my $infDef = $writing ? 'deflate' : 'inflate'; + my @params = () ; + + croak "gzopen: file parameter is not a filehandle or filename" + unless isaFilehandle $file || isaFilename $file ; + + return undef unless $mode =~ /[rwa]/i ; + + _set_gzerr(0) ; + + if ($writing) { + $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, + %defOpts) + or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; + } + else { + $gz = new IO::Uncompress::Gunzip($file, + Transparent => 1, + Append => 0, + AutoClose => 1, + Strict => 0) + or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; + } + + return undef + if ! defined $gz ; + + bless [$gz, $infDef], 'Compress::Zlib::gzFile'; +} + +sub Compress::Zlib::gzFile::gzread +{ + my $self = shift ; + + return _set_gzerr(Z_STREAM_ERROR()) + if $self->[1] ne 'inflate'; + + return 0 if $self->gzeof(); + + my $gz = $self->[0] ; + my $status = $gz->read($_[0], defined $_[1] ? $_[1] : 4096) ; + $_[0] = "" if ! defined $_[0] ; + _save_gzerr($gz, 1); + return $status ; +} + +sub Compress::Zlib::gzFile::gzreadline +{ + my $self = shift ; + + my $gz = $self->[0] ; + $_[0] = $gz->getline() ; + _save_gzerr($gz, 1); + return defined $_[0] ? length $_[0] : 0 ; +} + +sub Compress::Zlib::gzFile::gzwrite +{ + my $self = shift ; + my $gz = $self->[0] ; + + return _set_gzerr(Z_STREAM_ERROR()) + if $self->[1] ne 'deflate'; + + my $status = $gz->write($_[0]) ; + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gztell +{ + my $self = shift ; + my $gz = $self->[0] ; + my $status = $gz->tell() ; + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzseek +{ + my $self = shift ; + my $offset = shift ; + my $whence = shift ; + + my $gz = $self->[0] ; + my $status ; + eval { $status = $gz->seek($offset, $whence) ; }; + if ($@) + { + my $error = $@; + $error =~ s/^.*: /gzseek: /; + $error =~ s/ at .* line \d+\s*$//; + croak $error; + } + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzflush +{ + my $self = shift ; + my $f = shift ; + + my $gz = $self->[0] ; + my $status = $gz->flush($f) ; + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzclose +{ + my $self = shift ; + my $gz = $self->[0] ; + + my $status = $gz->close() ; + _save_gzerr($gz); + return ! $status ; +} + +sub Compress::Zlib::gzFile::gzeof +{ + my $self = shift ; + my $gz = $self->[0] ; + + return 0 + if $self->[1] ne 'inflate'; + + my $status = $gz->eof() ; + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzsetparams +{ + my $self = shift ; + croak "Usage: Compress::Zlib::gzFile::gzsetparams(file, level, strategy)" + unless @_ eq 2 ; + + my $gz = $self->[0] ; + my $level = shift ; + my $strategy = shift; + + return _set_gzerr(Z_STREAM_ERROR()) + if $self->[1] ne 'deflate'; + + my $status = *$gz->{Compress}->deflateParams(-Level => $level, + -Strategy => $strategy); + _save_gzerr($gz); + return $status ; +} + +sub Compress::Zlib::gzFile::gzerror +{ + my $self = shift ; + my $gz = $self->[0] ; + + return $Compress::Zlib::gzerrno ; +} + + +sub compress($;$) +{ + my ($x, $output, $err, $in) =('', '', '', '') ; + + if (ref $_[0] ) { + $in = $_[0] ; + croak "not a scalar reference" unless ref $in eq 'SCALAR' ; + } + else { + $in = \$_[0] ; + } + + my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); + + $x = new Compress::Raw::Zlib::Deflate -AppendOutput => 1, -Level => $level + or return undef ; + + $err = $x->deflate($in, $output) ; + return undef unless $err == Z_OK() ; + + $err = $x->flush($output) ; + return undef unless $err == Z_OK() ; + + return $output ; + +} + +sub uncompress($) +{ + my ($x, $output, $err, $in) =('', '', '', '') ; + + if (ref $_[0] ) { + $in = $_[0] ; + croak "not a scalar reference" unless ref $in eq 'SCALAR' ; + } + else { + $in = \$_[0] ; + } + + $x = new Compress::Raw::Zlib::Inflate -ConsumeInput => 0 or return undef ; + + $err = $x->inflate($in, $output) ; + return undef unless $err == Z_STREAM_END() ; + + return $output ; +} + + + +sub deflateInit(@) +{ + my ($got) = ParseParameters(0, + { + 'Bufsize' => [1, 1, Parse_unsigned, 4096], + 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], + 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], + 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], + 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], + 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'Dictionary' => [1, 1, Parse_any, ""], + }, @_ ) ; + + croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . + $got->value('Bufsize') + unless $got->value('Bufsize') >= 1; + + my $obj ; + + my $status = 0 ; + ($obj, $status) = + Compress::Raw::Zlib::_deflateInit(0, + $got->value('Level'), + $got->value('Method'), + $got->value('WindowBits'), + $got->value('MemLevel'), + $got->value('Strategy'), + $got->value('Bufsize'), + $got->value('Dictionary')) ; + + my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; + return wantarray ? ($x, $status) : $x ; +} + +sub inflateInit(@) +{ + my ($got) = ParseParameters(0, + { + 'Bufsize' => [1, 1, Parse_unsigned, 4096], + 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], + 'Dictionary' => [1, 1, Parse_any, ""], + }, @_) ; + + + croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . + $got->value('Bufsize') + unless $got->value('Bufsize') >= 1; + + my $status = 0 ; + my $obj ; + ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, + $got->value('WindowBits'), + $got->value('Bufsize'), + $got->value('Dictionary')) ; + + my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; + + wantarray ? ($x, $status) : $x ; +} + +package Zlib::OldDeflate ; + +our (@ISA); +@ISA = qw(Compress::Raw::Zlib::deflateStream); + + +sub deflate +{ + my $self = shift ; + my $output ; + + my $status = $self->SUPER::deflate($_[0], $output) ; + wantarray ? ($output, $status) : $output ; +} + +sub flush +{ + my $self = shift ; + my $output ; + my $flag = shift || Compress::Zlib::Z_FINISH(); + my $status = $self->SUPER::flush($output, $flag) ; + + wantarray ? ($output, $status) : $output ; +} + +package Zlib::OldInflate ; + +our (@ISA); +@ISA = qw(Compress::Raw::Zlib::inflateStream); + +sub inflate +{ + my $self = shift ; + my $output ; + my $status = $self->SUPER::inflate($_[0], $output) ; + wantarray ? ($output, $status) : $output ; +} + +package Compress::Zlib ; + +use IO::Compress::Gzip::Constants; + +sub memGzip($) +{ + my $x = new Compress::Raw::Zlib::Deflate( + -AppendOutput => 1, + -CRC32 => 1, + -ADLER32 => 0, + -Level => Z_BEST_COMPRESSION(), + -WindowBits => - MAX_WBITS(), + ) + or return undef ; + + # write a minimal gzip header + my $output = GZIP_MINIMUM_HEADER ; + + # if the deflation buffer isn't a reference, make it one + my $string = (ref $_[0] ? $_[0] : \$_[0]) ; + + my $status = $x->deflate($string, \$output) ; + $status == Z_OK() + or return undef ; + + $status = $x->flush(\$output) ; + $status == Z_OK() + or return undef ; + + return $output . pack("V V", $x->crc32(), $x->total_in()) ; + +} + + +sub _removeGzipHeader($) +{ + my $string = shift ; + + return Z_DATA_ERROR() + if length($$string) < GZIP_MIN_HEADER_SIZE ; + + my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = + unpack ('CCCCVCC', $$string); + + return Z_DATA_ERROR() + unless $magic1 == GZIP_ID1 and $magic2 == GZIP_ID2 and + $method == Z_DEFLATED() and !($flags & GZIP_FLG_RESERVED) ; + substr($$string, 0, GZIP_MIN_HEADER_SIZE) = '' ; + + # skip extra field + if ($flags & GZIP_FLG_FEXTRA) + { + return Z_DATA_ERROR() + if length($$string) < GZIP_FEXTRA_HEADER_SIZE ; + + my ($extra_len) = unpack ('v', $$string); + $extra_len += GZIP_FEXTRA_HEADER_SIZE; + return Z_DATA_ERROR() + if length($$string) < $extra_len ; + + substr($$string, 0, $extra_len) = ''; + } + + # skip orig name + if ($flags & GZIP_FLG_FNAME) + { + my $name_end = index ($$string, GZIP_NULL_BYTE); + return Z_DATA_ERROR() + if $name_end == -1 ; + substr($$string, 0, $name_end + 1) = ''; + } + + # skip comment + if ($flags & GZIP_FLG_FCOMMENT) + { + my $comment_end = index ($$string, GZIP_NULL_BYTE); + return Z_DATA_ERROR() + if $comment_end == -1 ; + substr($$string, 0, $comment_end + 1) = ''; + } + + # skip header crc + if ($flags & GZIP_FLG_FHCRC) + { + return Z_DATA_ERROR() + if length ($$string) < GZIP_FHCRC_SIZE ; + substr($$string, 0, GZIP_FHCRC_SIZE) = ''; + } + + return Z_OK(); +} + + +sub memGunzip($) +{ + # if the buffer isn't a reference, make it one + my $string = (ref $_[0] ? $_[0] : \$_[0]); + + _removeGzipHeader($string) == Z_OK() + or return undef; + + my $bufsize = length $$string > 4096 ? length $$string : 4096 ; + my $x = new Compress::Raw::Zlib::Inflate({-WindowBits => - MAX_WBITS(), + -Bufsize => $bufsize}) + + or return undef; + + my $output = "" ; + my $status = $x->inflate($string, $output); + return undef + unless $status == Z_STREAM_END(); + + if (length $$string >= 8) + { + my ($crc, $len) = unpack ("VV", substr($$string, 0, 8)); + substr($$string, 0, 8) = ''; + return undef + unless $len == length($output) and + $crc == crc32($output); + } + else + { + $$string = ''; + } + return $output; +} + +# Autoload methods go after __END__, and are processed by the autosplit program. + +1; +__END__ + + +=head1 NAME + +Compress::Zlib - Interface to zlib compression library + +=head1 SYNOPSIS + + use Compress::Zlib ; + + ($d, $status) = deflateInit( [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] ) ; + $status = $i->inflate($input, $output [, $eof]) ; + $status = $i->inflateSync($input) ; + $i->dict_adler() ; + $d->crc32() ; + $d->adler32() ; + $i->total_in() ; + $i->total_out() ; + $i->msg() ; + $d->get_BufSize(); + + $dest = compress($source) ; + $dest = uncompress($source) ; + + $gz = gzopen($filename or filehandle, $mode) ; + $bytesread = $gz->gzread($buffer [,$size]) ; + $bytesread = $gz->gzreadline($line) ; + $byteswritten = $gz->gzwrite($buffer) ; + $status = $gz->gzflush($flush) ; + $offset = $gz->gztell() ; + $status = $gz->gzseek($offset, $whence) ; + $status = $gz->gzclose() ; + $status = $gz->gzeof() ; + $status = $gz->gzsetparams($level, $strategy) ; + $errstring = $gz->gzerror() ; + $gzerrno + + $dest = Compress::Zlib::memGzip($buffer) ; + $dest = Compress::Zlib::memGunzip($buffer) ; + + $crc = adler32($buffer [,$crc]) ; + $crc = crc32($buffer [,$crc]) ; + + $crc = adler32_combine($crc1, $crc2, $len2)l + $crc = crc32_combine($adler1, $adler2, $len2) + + ZLIB_VERSION + ZLIB_VERNUM + + + +=head1 DESCRIPTION + +The I<Compress::Zlib> module provides a Perl interface to the I<zlib> +compression library (see L</AUTHOR> for details about where to get +I<zlib>). + +The C<Compress::Zlib> module can be split into two general areas of +functionality, namely a simple read/write interface to I<gzip> files +and a low-level in-memory compression/decompression interface. + +Each of these areas will be discussed separately below. + +=head2 Notes for users of Compress::Zlib version 1 + +Version 2 of this module is a total rewrite. The net result of this is that +C<Compress::Zlib> does not now access the zlib library directly. + +It now uses the C<IO::Compress::Gzip> and C<IO::Uncompress::Gunzip> modules +for reading/writing gzip files, and the C<Compress::Raw::Zlib> module for +low-level zlib access. + +If you are writing new code, your first port of call should be to use one +these new modules. + +=head1 GZIP INTERFACE + +A number of functions are supplied in I<zlib> for reading and writing +I<gzip> files that conform to RFC 1952. This module provides an interface +to most of them. + +If you are upgrading from C<Compress::Zlib> 1.x, the following +enhancements/changes have been made to the C<gzopen> interface: + +=over 5 + +=item 1 + +If you want to to open either STDIN or STDOUT with C<gzopen>, you can now +optionally use the special filename "C<->" as a synonym for C<\*STDIN> and +C<\*STDOUT>. + +=item 2 + +In C<Compress::Zlib> version 1.x, C<gzopen> used the zlib library to open +the underlying file. This made things especially tricky when a Perl +filehandle was passed to C<gzopen>. Behind the scenes the numeric C file +descriptor had to be extracted from the Perl filehandle and this passed to +the zlib library. + +Apart from being non-portable to some operating systems, this made it +difficult to use C<gzopen> 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. + +It also made it impossible to pass a perl filehandle that wasn't associated +with a real filesystem file, like, say, an C<IO::String>. + +In C<Compress::Zlib> version 2.x, the C<gzopen> interface has been +completely rewritten to use the L<IO::Compress::Gzip|IO::Compress::Gzip> +for writing gzip files and L<IO::Uncompress::Gunzip|IO::Uncompress::Gunzip> +for reading gzip files. None of the limitations mentioned above apply. + +=item 3 + +Addition of C<gzseek> to provide a restricted C<seek> interface. + +=item 4. + +Added C<gztell>. + +=back + +A more complete and flexible interface for reading/writing gzip +files/buffers is included with the module C<IO-Compress-ZLib>. See +L<IO::Compress::Gzip|IO::Compress::Gzip> and +L<IO::Uncompress::Gunzip|IO::Uncompress::Gunzip> for more details. + +=over 5 + +=item B<$gz = gzopen($filename, $mode)> + +=item B<$gz = gzopen($filehandle, $mode)> + +This function opens either the I<gzip> file C<$filename> for reading or +writing or attaches to the opened filehandle, C<$filehandle>. +It returns an object on success and C<undef> on failure. + +When writing a gzip file this interface will always create the smallest +possible gzip header (exactly 10 bytes). If you want greater control over +the information stored in the gzip header (like the original filename or a +comment) use L<IO::Compress::Gzip|IO::Compress::Gzip> instead. + +The second parameter, C<$mode>, is used to specify whether the file is +opened for reading or writing and to optionally specify a compression +level and compression strategy when writing. The format of the C<$mode> +parameter is similar to the mode parameter to the 'C' function C<fopen>, +so "rb" is used to open for reading and "wb" for writing. + +To specify a compression level when writing, append a digit between 0 +and 9 to the mode string -- 0 means no compression and 9 means maximum +compression. +If no compression level is specified Z_DEFAULT_COMPRESSION is used. + +To specify the compression strategy when writing, append 'f' for filtered +data, 'h' for Huffman only compression, or 'R' for run-length encoding. +If no strategy is specified Z_DEFAULT_STRATEGY is used. + +So, for example, "wb9" means open for writing with the maximum compression +using the default strategy and "wb4R" means open for writing with compression +level 4 and run-length encoding. + +Refer to the I<zlib> documentation for the exact format of the C<$mode> +parameter. + + +=item B<$bytesread = $gz-E<gt>gzread($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-E<gt>gzreadline($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<gzread> and C<gzreadline>. + +In addition, C<gzreadline> fully supports the use of of the variable C<$/> +(C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to +determine what constitutes an end of line. Both paragraph mode and file +slurp mode are supported. + + +=item B<$byteswritten = $gz-E<gt>gzwrite($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-E<gt>gzflush($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<Z_FINISH>. Other valid values for C<$flush_type> are +C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is +strongly recommended that you only set the C<flush_type> parameter if +you fully understand the implications of what it does - overuse of C<flush> +can seriously degrade the level of compression achieved. See the C<zlib> +documentation for details. + +Returns 1 on success, 0 on failure. + + +=item B<$offset = $gz-E<gt>gztell() ;> + +Returns the uncompressed file offset. + +=item B<$status = $gz-E<gt>gzseek($offset, $whence) ;> + +Provides a sub-set of the C<seek> 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-E<gt>gzclose> + +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-E<gt>gzsetparams($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<Z_NO_COMPRESSION>, C<Z_BEST_SPEED>, C<Z_BEST_COMPRESSION>, and +C<Z_DEFAULT_COMPRESSION>. + +=item B<$strategy> + +Defines the strategy used to tune the compression. The valid values are +C<Z_DEFAULT_STRATEGY>, C<Z_FILTERED> and C<Z_HUFFMAN_ONLY>. + +=back + +=item B<$gz-E<gt>gzerror> + +Returns the I<zlib> error message or number for the last operation +associated with C<$gz>. The return value will be the I<zlib> error +number when used in a numeric context and the I<zlib> error message +when used in a string context. The I<zlib> 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<gzip> routine. Note that unlike C<gzerror()>, the error is +I<not> associated with a particular file. + +As with C<gzerror()> it returns an error number in numeric context and +an error message in string context. Unlike C<gzerror()> though, the +error message will correspond to the I<zlib> message when the error is +associated with I<zlib> itself, or the UNIX error message when it is +not (i.e. I<zlib> returned C<Z_ERRORNO>). + +As there is an overlap between the error numbers used by I<zlib> and +UNIX, C<$gzerrno> should only be used to check for the presence of +I<an> error in numeric context. Use C<gzerror()> to check for specific +I<zlib> errors. The I<gzcat> 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<gzcat> 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<gzreadline>. It implements a +very simple I<grep> 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<gzstream>, does the opposite of the I<gzcat> 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<IO::Compress::Gzip|IO::Compress::Gzip> 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<IO::Uncompress::Gunzip|IO::Uncompress::Gunzip> 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<compress> and C<uncompress>. + +=over 5 + +=item B<$dest = compress($source [, $level] ) ;> + +Compresses C<$source>. If successful it returns the compressed +data. Otherwise it returns I<undef>. + +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<Z_NO_COMPRESSION>, C<Z_BEST_SPEED>, +C<Z_BEST_COMPRESSION>, and C<Z_DEFAULT_COMPRESSION>. +If C<$level> is not specified C<Z_DEFAULT_COMPRESSION> will be used. + + +=item B<$dest = uncompress($source) ;> + +Uncompresses C<$source>. If successful it returns the uncompressed +data. Otherwise it returns I<undef>. + +The source buffer can either be a scalar or a scalar reference. + +=back + +Please note: the two functions defined above are I<not> compatible with +the Unix commands of the same name. + +See L<IO::Deflate|IO::Deflate> and L<IO::Inflate|IO::Inflate> included with +this distribution for an alternative interface for reading/writing RFC 1950 +files/buffers. + + +=head1 Deflate Interface + +This section defines an interface that allows in-memory compression using +the I<deflate> interface provided by zlib. + +Here is a definition of the interface available: + + +=head2 B<($d, $status) = deflateInit( [OPT] )> + +Initialises a deflation stream. + +It combines the features of the I<zlib> functions C<deflateInit>, +C<deflateInit2> and C<deflateSetDictionary>. + +If successful, it will return the initialised deflation stream, C<$d> +and C<$status> of C<Z_OK> 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<undef> and C<$status> will hold the exact I<zlib> error code. + +The function optionally takes a number of named options specified as +C<-Name=E<gt>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. + +Here is a list of the valid options: + +=over 5 + +=item B<-Level> + +Defines the compression level. Valid values are 0 through 9, +C<Z_NO_COMPRESSION>, C<Z_BEST_SPEED>, C<Z_BEST_COMPRESSION>, and +C<Z_DEFAULT_COMPRESSION>. + +The default is C<-Level =E<gt>Z_DEFAULT_COMPRESSION>. + +=item B<-Method> + +Defines the compression method. The only valid value at present (and +the default) is C<-Method =E<gt>Z_DEFLATED>. + +=item B<-WindowBits> + +To create an RFC 1950 data stream, set C<WindowBits> to a positive number. + +To create an RFC 1951 data stream, set C<WindowBits> to C<-MAX_WBITS>. + +For a full definition of the meaning and valid values for C<WindowBits> refer +to the I<zlib> documentation for I<deflateInit2>. + +Defaults to C<-WindowBits =E<gt>MAX_WBITS>. + +=item B<-MemLevel> + +For a definition of the meaning and valid values for C<MemLevel> +refer to the I<zlib> documentation for I<deflateInit2>. + +Defaults to C<-MemLevel =E<gt>MAX_MEM_LEVEL>. + +=item B<-Strategy> + +Defines the strategy used to tune the compression. The valid values are +C<Z_DEFAULT_STRATEGY>, C<Z_FILTERED> and C<Z_HUFFMAN_ONLY>. + +The default is C<-Strategy =E<gt>Z_DEFAULT_STRATEGY>. + +=item B<-Dictionary> + +When a dictionary is specified I<Compress::Zlib> will automatically +call C<deflateSetDictionary> directly after calling C<deflateInit>. The +Adler32 value for the dictionary can be obtained by calling the method +C<$d->dict_adler()>. + +The default is no dictionary. + +=item B<-Bufsize> + +Sets the initial size for the deflation buffer. If the buffer has to be +reallocated to increase the size, it will grow in increments of +C<Bufsize>. + +The default is 4096. + +=back + +Here is an example of using the C<deflateInit> optional parameter list +to override the default buffer size and compression level. All other +options will take their default values. + + deflateInit( -Bufsize => 300, + -Level => Z_BEST_SPEED ) ; + + +=head2 B<($out, $status) = $d-E<gt>deflate($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<Z_OK>. + +On error, C<$out> will be I<undef> and C<$status> will contain the +I<zlib> error code. + +In a scalar context C<deflate> will return C<$out> only. + +As with the I<deflate> function in I<zlib>, it is not necessarily the +case that any output will be produced by this method. So don't rely on +the fact that C<$out> is empty for an error test. + + +=head2 B<($out, $status) = $d-E<gt>flush([flush_type])> + +Typically used to finish the deflation. Any pending output will be +returned via C<$out>. +C<$status> will have a value C<Z_OK> if successful. + +In a scalar context C<flush> will return C<$out> only. + +Note that flushing can seriously degrade the compression ratio, so it +should only be used to terminate a decompression (using C<Z_FINISH>) or +when you want to create a I<full flush point> (using C<Z_FULL_FLUSH>). + +By default the C<flush_type> used is C<Z_FINISH>. Other valid values +for C<flush_type> are C<Z_NO_FLUSH>, C<Z_PARTIAL_FLUSH>, C<Z_SYNC_FLUSH> +and C<Z_FULL_FLUSH>. It is strongly recommended that you only set the +C<flush_type> parameter if you fully understand the implications of +what it does. See the C<zlib> documentation for details. + +=head2 B<$status = $d-E<gt>deflateParams([OPT])> + +Change settings for the deflate stream C<$d>. + +The list of the valid options is shown below. Options not specified +will remain unchanged. + +=over 5 + +=item B<-Level> + +Defines the compression level. Valid values are 0 through 9, +C<Z_NO_COMPRESSION>, C<Z_BEST_SPEED>, C<Z_BEST_COMPRESSION>, and +C<Z_DEFAULT_COMPRESSION>. + +=item B<-Strategy> + +Defines the strategy used to tune the compression. The valid values are +C<Z_DEFAULT_STRATEGY>, C<Z_FILTERED> and C<Z_HUFFMAN_ONLY>. + +=back + +=head2 B<$d-E<gt>dict_adler()> + +Returns the adler32 value for the dictionary. + +=head2 B<$d-E<gt>msg()> + +Returns the last error message generated by zlib. + +=head2 B<$d-E<gt>total_in()> + +Returns the total number of bytes uncompressed bytes input to deflate. + +=head2 B<$d-E<gt>total_out()> + +Returns the total number of compressed bytes output from deflate. + +=head2 Example + + +Here is a trivial example of using C<deflate>. It simply reads standard +input, deflates it and writes it to standard output. + + use strict ; + use warnings ; + + use Compress::Zlib ; + + binmode STDIN; + binmode STDOUT; + my $x = deflateInit() + or die "Cannot create a deflation stream\n" ; + + my ($output, $status) ; + while (<>) + { + ($output, $status) = $x->deflate($_) ; + + $status == Z_OK + or die "deflation failed\n" ; + + print $output ; + } + + ($output, $status) = $x->flush() ; + + $status == Z_OK + or die "deflation failed\n" ; + + print $output ; + +=head1 Inflate Interface + +This section defines the interface available that allows in-memory +uncompression using the I<deflate> interface provided by zlib. + +Here is a definition of the interface: + + +=head2 B<($i, $status) = inflateInit()> + +Initialises an inflation stream. + +In a list context it returns the inflation stream, C<$i>, and the +I<zlib> status code in C<$status>. In a scalar context it returns the +inflation stream only. + +If successful, C<$i> will hold the inflation stream and C<$status> will +be C<Z_OK>. + +If not successful, C<$i> will be I<undef> and C<$status> will hold the +I<zlib> error code. + +The function optionally takes a number of named options specified as +C<-Name=E<gt>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. + +Here is a list of the valid options: + +=over 5 + +=item B<-WindowBits> + +To uncompress an RFC 1950 data stream, set C<WindowBits> to a positive number. + +To uncompress an RFC 1951 data stream, set C<WindowBits> to C<-MAX_WBITS>. + +For a full definition of the meaning and valid values for C<WindowBits> refer +to the I<zlib> documentation for I<inflateInit2>. + +Defaults to C<-WindowBits =E<gt>MAX_WBITS>. + +=item B<-Bufsize> + +Sets the initial size for the inflation buffer. If the buffer has to be +reallocated to increase the size, it will grow in increments of +C<Bufsize>. + +Default is 4096. + +=item B<-Dictionary> + +The default is no dictionary. + +=back + +Here is an example of using the C<inflateInit> optional parameter to +override the default buffer size. + + inflateInit( -Bufsize => 300 ) ; + +=head2 B<($out, $status) = $i-E<gt>inflate($buffer)> + +Inflates the complete contents of C<$buffer>. The buffer can either be +a scalar or a scalar reference. + +Returns C<Z_OK> if successful and C<Z_STREAM_END> if the end of the +compressed data has been successfully reached. +If not successful, C<$out> will be I<undef> and C<$status> will hold +the I<zlib> error code. + +The C<$buffer> parameter is modified by C<inflate>. 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<Z_OK>. When the return status is C<Z_STREAM_END> the C<$buffer> +parameter will contains what (if anything) was stored in the input +buffer after the deflated data stream. + +This feature is useful when processing a file format that encapsulates +a compressed data stream (e.g. gzip, zip). + +=head2 B<$status = $i-E<gt>inflateSync($buffer)> + +Scans C<$buffer> until it reaches either a I<full flush point> or the +end of the buffer. + +If a I<full flush point> is found, C<Z_OK> is returned and C<$buffer> +will be have all data up to the flush point removed. This can then be +passed to the C<deflate> method. + +Any other return code means that a flush point was not found. If more +data is available, C<inflateSync> can be called repeatedly with more +compressed data until the flush point is found. + + +=head2 B<$i-E<gt>dict_adler()> + +Returns the adler32 value for the dictionary. + +=head2 B<$i-E<gt>msg()> + +Returns the last error message generated by zlib. + +=head2 B<$i-E<gt>total_in()> + +Returns the total number of bytes compressed bytes input to inflate. + +=head2 B<$i-E<gt>total_out()> + +Returns the total number of uncompressed bytes output from inflate. + +=head2 Example + +Here is an example of using C<inflate>. + + use strict ; + use warnings ; + + use Compress::Zlib ; + + my $x = inflateInit() + or die "Cannot create a inflation stream\n" ; + + my $input = '' ; + binmode STDIN; + binmode STDOUT; + + my ($output, $status) ; + while (read(STDIN, $input, 4096)) + { + ($output, $status) = $x->inflate(\$input) ; + + print $output + if $status == Z_OK or $status == Z_STREAM_END ; + + last if $status != Z_OK ; + } + + die "inflation failed\n" + unless $status == Z_STREAM_END ; + +=head1 CHECKSUM FUNCTIONS + +Two functions are provided by I<zlib> 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<undef>, 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 ACCESSING ZIP FILES + +Although it is possible (with some effort on your part) to use this +module to access .zip files, there is a module on CPAN that will do all +the hard work for you. Check out the C<Archive::Zip> module on CPAN at + + http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz + + +=head1 CONSTANTS + +All the I<zlib> constants are automatically imported when you make use +of I<Compress::Zlib>. + + +=head1 SEE ALSO + +L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> + +L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> + +L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, +L<Archive::Tar|Archive::Tar>, +L<IO::Zlib|IO::Zlib> + + +For RFC 1950, 1951 and 1952 see +F<http://www.faqs.org/rfcs/rfc1950.html>, +F<http://www.faqs.org/rfcs/rfc1951.html> and +F<http://www.faqs.org/rfcs/rfc1952.html> + +The I<zlib> compression library was written by Jean-loup Gailly +F<gzip@prep.ai.mit.edu> and Mark Adler F<madler@alumni.caltech.edu>. + +The primary site for the I<zlib> compression library is +F<http://www.zlib.org>. + +The primary site for gzip is F<http://www.gzip.org>. + + + + + + + +=head1 AUTHOR + +The I<Compress::Zlib> module was written by Paul Marquess, +F<pmqs@cpan.org>. + + + +=head1 MODIFICATION HISTORY + +See the Changes file. + +=head1 COPYRIGHT AND LICENSE + + +Copyright (c) 1995-2006 Paul Marquess. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + + diff --git a/ext/Compress/Zlib/private/MakeUtil.pm b/ext/Compress/Zlib/private/MakeUtil.pm new file mode 100644 index 0000000000..a2cce29479 --- /dev/null +++ b/ext/Compress/Zlib/private/MakeUtil.pm @@ -0,0 +1,287 @@ +package MakeUtil ; +package main ; + +use strict ; + +use Config qw(%Config); +use File::Copy; + + +BEGIN +{ + eval { require File::Spec::Functions ; File::Spec::Functions->import() } ; + if ($@) + { + *catfile = sub { return "$_[0]/$_[1]" } + } +} + +require VMS::Filespec if $^O eq 'VMS'; + + +unless($ENV{PERL_CORE}) { + $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; +} + +$ENV{SKIP_FOR_CORE} = 1 if $ENV{PERL_CORE} || $ENV{MY_PERL_CORE} ; + + + +sub MY::libscan +{ + my $self = shift; + my $path = shift; + + return undef + if $path =~ /(~|\.bak|_bak)$/ || + $path =~ /\..*\.sw(o|p)$/ || + $path =~ /\B\.svn\b/; + + return $path; +} + +sub MY::postamble +{ + return '' + if $ENV{PERL_CORE} ; + + my @files = getPerlFiles('MANIFEST'); + + my $postamble = ' + +MyTrebleCheck: + @echo Checking for $$^W in files: '. "@files" . ' + @perl -ne \' \ + exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/; \ + \' ' . " @files || " . ' \ + (echo found unexpected $$^W ; exit 1) + @echo All is ok. + +'; + + return $postamble; +} + +sub getPerlFiles +{ + my @manifests = @_ ; + + my @files = (); + + for my $manifest (@manifests) + { + my $prefix = './'; + + $prefix = $1 + if $manifest =~ m#^(.*/)#; + + open M, "<$manifest" + or die "Cannot open '$manifest': $!\n"; + while (<M>) + { + chomp ; + next if /^\s*#/ || /^\s*$/ ; + + s/^\s+//; + s/\s+$//; + + /^(\S+)\s*(.*)$/; + + my ($file, $rest) = ($1, $2); + + if ($file =~ /\.(pm|pl|t)$/ and $file !~ /MakeUtil.pm/) + { + push @files, "$prefix$file"; + } + elsif ($rest =~ /perl/i) + { + push @files, "$prefix$file"; + } + + } + close M; + } + + return @files; +} + +sub UpDowngrade +{ + return if defined $ENV{TipTop}; + + my @files = @_ ; + + # our and use bytes/utf8 is stable from 5.6.0 onward + # warnings is stable from 5.6.1 onward + + # Note: this code assumes that each statement it modifies is not + # split across multiple lines. + + + my $warn_sub = ''; + my $our_sub = '' ; + + my $upgrade ; + my $downgrade ; + + my $caller = (caller(1))[3] || ''; + + if ($caller =~ /downgrade/) + { + $downgrade = 1; + } + elsif ($caller =~ /upgrade/) + { + $upgrade = 1; + } +# else +# { +# my $opt = shift @ARGV || '' ; +# $upgrade = ($opt =~ /^-upgrade/i); +# $downgrade = ($opt =~ /^-downgrade/i); +# push @ARGV, $opt unless $downgrade || $upgrade; +# } + + if ($downgrade) { + # From: use|no warnings "blah" + # To: local ($^W) = 1; # use|no warnings "blah" + $warn_sub = sub { + s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ; + s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; + }; + } + elsif ($] >= 5.006001 || $upgrade) { + # From: local ($^W) = 1; # use|no warnings "blah" + # To: use|no warnings "blah" + $warn_sub = sub { + s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ; + }; + } + + if ($downgrade) { + $our_sub = sub { + if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { + my $indent = $1; + my $vars = join ' ', split /\s*,\s*/, $2; + $_ = "${indent}use vars qw($vars);\n"; + } + elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/) + { + $_ = "$1# $2\n"; + } + }; + } + elsif ($] >= 5.006000 || $upgrade) { + $our_sub = sub { + if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { + my $indent = $1; + my $vars = join ', ', split ' ', $2; + $_ = "${indent}our ($vars);\n"; + } + elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/) + { + $_ = "$1$2\n"; + } + }; + } + + if (! $our_sub && ! $warn_sub) { + warn "Up/Downgrade not needed.\n"; + if ($upgrade || $downgrade) + { exit 0 } + else + { return } + } + + foreach (@files) { + #if (-l $_ ) + { doUpDown($our_sub, $warn_sub, $_) } + #else + #{ doUpDownViaCopy($our_sub, $warn_sub, $_) } + } + + warn "Up/Downgrade complete.\n" ; + exit 0 if $upgrade || $downgrade; + +} + + +sub doUpDown +{ + my $our_sub = shift; + my $warn_sub = shift; + + return if -d $_[0]; + + local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; + local (@ARGV) = shift; + + while (<>) + { + print, last if /^__(END|DATA)__/ ; + + &{ $our_sub }() if $our_sub ; + &{ $warn_sub }() if $warn_sub ; + print ; + } + + return if eof ; + + while (<>) + { print } +} + +sub doUpDownViaCopy +{ + my $our_sub = shift; + my $warn_sub = shift; + my $file = shift ; + + use File::Copy ; + + return if -d $file ; + + my $backup = $file . ($^O eq 'VMS') ? "_bak" : ".bak"; + + copy($file, $backup) + or die "Cannot copy $file to $backup: $!"; + + my @keep = (); + + { + open F, "<$file" + or die "Cannot open $file: $!\n" ; + while (<F>) + { + if (/^__(END|DATA)__/) + { + push @keep, $_; + last ; + } + + &{ $our_sub }() if $our_sub ; + &{ $warn_sub }() if $warn_sub ; + push @keep, $_; + } + + if (! eof F) + { + while (<F>) + { push @keep, $_ } + } + close F; + } + + { + open F, ">$file" + or die "Cannot open $file: $!\n"; + print F @keep ; + close F; + } +} + +package MakeUtil ; + +1; + + diff --git a/ext/Compress/Zlib/t/01version.t b/ext/Compress/Zlib/t/01version.t index b71291882e..9d6f283a52 100644 --- a/ext/Compress/Zlib/t/01version.t +++ b/ext/Compress/Zlib/t/01version.t @@ -5,7 +5,7 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict ; use warnings ; diff --git a/ext/Compress/Zlib/t/03zlib-v1.t b/ext/Compress/Zlib/t/03zlib-v1.t index cb88653402..c98de63b0d 100644 --- a/ext/Compress/Zlib/t/03zlib-v1.t +++ b/ext/Compress/Zlib/t/03zlib-v1.t @@ -5,13 +5,13 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict; use warnings; use bytes; use Test::More ; -use ZlibTestUtils; +use CompTestUtils; use Symbol; BEGIN @@ -33,7 +33,7 @@ BEGIN plan tests => $count + $extra ; use_ok('Compress::Zlib', 2) ; - use_ok('Compress::Gzip::Constants') ; + use_ok('IO::Compress::Gzip::Constants') ; use_ok('IO::Compress::Gzip', qw($GzipError)) ; } @@ -698,11 +698,14 @@ EOM # error cases eval { $x->deflateParams() }; - ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#; + #like $@, mkErr("^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy"); + like $@, "/^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy/"; eval { $x->deflateParams(-Joe => 3) }; - ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/ - or print "# $@\n" ; + like $@, "/^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value/"; + #like $@, mkErr("^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value(s) Joe"); + #ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/ + # or print "# $@\n" ; ok $x->get_Level() == Z_BEST_COMPRESSION; ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; diff --git a/ext/Compress/Zlib/t/05examples.t b/ext/Compress/Zlib/t/05examples.t index 368dab401a..d6dc12db70 100644 --- a/ext/Compress/Zlib/t/05examples.t +++ b/ext/Compress/Zlib/t/05examples.t @@ -5,14 +5,14 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict; use warnings; use bytes; use Test::More ; -use ZlibTestUtils; +use CompTestUtils; use Compress::Zlib; BEGIN @@ -25,7 +25,7 @@ BEGIN $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 30 + $extra ; + plan tests => 26 + $extra ; } @@ -112,9 +112,6 @@ sub check # gzcat # ##### -title "gzcat.zlib" ; -check "$Perl ${examples}/gzcat.zlib $file1 $file2 ", $hello1 . $hello2 ; - title "gzcat - command line" ; check "$Perl ${examples}/gzcat $file1 $file2", $hello1 . $hello2; diff --git a/ext/Compress/Zlib/t/06gzsetp.t b/ext/Compress/Zlib/t/06gzsetp.t index 41bb5c28dd..0f8d83d5ac 100644 --- a/ext/Compress/Zlib/t/06gzsetp.t +++ b/ext/Compress/Zlib/t/06gzsetp.t @@ -5,13 +5,13 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict; use warnings; use bytes; use Test::More ; -use ZlibTestUtils; +use CompTestUtils; use Compress::Zlib 2 ; diff --git a/ext/Compress/Zlib/t/08encoding.t b/ext/Compress/Zlib/t/08encoding.t index 56e37195f4..3ebbfbbca6 100644 --- a/ext/Compress/Zlib/t/08encoding.t +++ b/ext/Compress/Zlib/t/08encoding.t @@ -5,13 +5,13 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict; use warnings; use bytes; use Test::More ; -use ZlibTestUtils; +use CompTestUtils; BEGIN { diff --git a/ext/Compress/Zlib/t/14gzopen.t b/ext/Compress/Zlib/t/14gzopen.t index 5a90b39c23..97f0a1cb78 100644 --- a/ext/Compress/Zlib/t/14gzopen.t +++ b/ext/Compress/Zlib/t/14gzopen.t @@ -5,13 +5,13 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use strict; use warnings; use bytes; use Test::More ; -use ZlibTestUtils; +use CompTestUtils; use IO::File ; BEGIN { @@ -23,7 +23,7 @@ BEGIN { plan tests => 208 + $extra ; use_ok('Compress::Zlib', 2) ; - use_ok('Compress::Gzip::Constants') ; + use_ok('IO::Compress::Gzip::Constants') ; } diff --git a/ext/Compress/Zlib/t/99pod.t b/ext/Compress/Zlib/t/99pod.t index 5ffa0264f0..760f737716 100644 --- a/ext/Compress/Zlib/t/99pod.t +++ b/ext/Compress/Zlib/t/99pod.t @@ -5,7 +5,7 @@ BEGIN { } } -use lib 't'; +use lib qw(t t/compress); use Test::More; eval "use Test::Pod 1.00"; |