From: Paul Marquess Date: Wed, 17 May 2006 13:45:16 +0000 (+0100) Subject: IO::Compress* 2.000_12 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c70c17014268a520cc228ac35b4f4bb6b1372ee7;p=p5sagit%2Fp5-mst-13.2.git IO::Compress* 2.000_12 From: "Paul Marquess" Message-ID: <00c101c679af$c0305af0$2405140a@myopwv.com> p4raw-id: //depot/perl@28214 --- diff --git a/MANIFEST b/MANIFEST index 5fc8a5d..2c3fc2e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -154,6 +154,7 @@ ext/Compress/Raw/Zlib/typemap Compress::Raw::Zlib ext/Compress/Raw/Zlib/Makefile.PL Compress::Raw::Zlib ext/Compress/Raw/Zlib/ppport.h Compress::Raw::Zlib ext/Compress/Raw/Zlib/config.in Compress::Raw::Zlib +ext/Compress/Raw/Zlib/Changes Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/adler32.c Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/compress.c Compress::Raw::Zlib ext/Compress/Raw/Zlib/zlib-src/crc32.c Compress::Raw::Zlib @@ -283,6 +284,7 @@ ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm IO::Compress::Zlib ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm IO::Compress::Zlib ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm IO::Compress::Zlib ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm IO::Compress::Zlib +ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Extra.pm IO::Compress::Zlib ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm IO::Compress::Zlib ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm IO::Compress::Zlib ext/Compress/IO/Zlib/Makefile.PL IO::Compress::Zlib diff --git a/ext/Compress/IO/Base/README b/ext/Compress/IO/Base/README index cef3598..f6fea3d 100644 --- a/ext/Compress/IO/Base/README +++ b/ext/Compress/IO/Base/README @@ -1,9 +1,9 @@ IO::Compress::Base - Version 2.000_10 + Version 2.000_12 - 13 Mar 2006 + 17 May 2006 Copyright (c) 2005-2006 Paul Marquess. All rights reserved. diff --git a/ext/Compress/IO/Base/lib/IO/Compress/Base.pm b/ext/Compress/IO/Base/lib/IO/Compress/Base.pm index 14363bc..952fd6c 100644 --- a/ext/Compress/IO/Base/lib/IO/Compress/Base.pm +++ b/ext/Compress/IO/Base/lib/IO/Compress/Base.pm @@ -20,7 +20,7 @@ use bytes; our (@ISA, $VERSION, $got_encode); #@ISA = qw(Exporter IO::File); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; #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. diff --git a/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm b/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm index f17fe47..0e1ffa0 100644 --- a/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm +++ b/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm @@ -11,7 +11,7 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS); @ISA = qw(Exporter); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; @EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput isaFileGlobString cleanFileGlobString oneTarget diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm index b733965..54ec621 100644 --- a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm +++ b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm @@ -26,7 +26,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; $AnyUncompressError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -387,9 +387,13 @@ If the C<$output> parameter is any other type, C will be returned. =head2 Notes -When C<$input> maps to multiple files/buffers and C<$output> is a single -file/buffer the uncompressed input files/buffers will all be stored -in C<$output> as a single uncompressed stream. + +When C<$input> maps to multiple compressed files/buffers and C<$output> is +a single file/buffer, after uncompression C<$output> will contain a +concatenation of all the uncompressed data from each of the input +files/buffers. + + diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm index 2580191..157926d 100644 --- a/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm +++ b/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm @@ -10,7 +10,7 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(Exporter ); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; diff --git a/ext/Compress/IO/Base/t/01misc.t b/ext/Compress/IO/Base/t/01misc.t index dd8c1fb..6613fa3 100644 --- a/ext/Compress/IO/Base/t/01misc.t +++ b/ext/Compress/IO/Base/t/01misc.t @@ -19,7 +19,7 @@ BEGIN { $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 29 + $extra ; + plan tests => 33 + $extra ; use_ok('IO::Compress::Base::Common'); @@ -67,6 +67,16 @@ sub My::testParseParameters() $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ; is $got->value('Fred'), "abc", "other" ; + $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred => +undef) ; + ok $got->parsed('Fred'), "undef" ; + ok ! defined $got->value('Fred'), "undef" ; + + $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred => +undef) ; + ok $got->parsed('Fred'), "undef" ; + is $got->value('Fred'), "", "empty string" ; + } My::testParseParameters(); diff --git a/ext/Compress/IO/Zlib/Changes b/ext/Compress/IO/Zlib/Changes index cc27f44..fd928ca 100644 --- a/ext/Compress/IO/Zlib/Changes +++ b/ext/Compress/IO/Zlib/Changes @@ -1,6 +1,29 @@ CHANGES ------- + 2.000_12 3 May 2006 + + * Moved the code for creating and parsing the gzip extra field into + IO::Compress::Zlib::Extra.pm so that IO::Compress::Zip & + IO::Uncompress::Unzip can use it as well. + + * Added ExtraFieldLocal & ExtraFieldCentral options to IO::Compress::Zip. + These allow the creation of user-defined extra fields in the local + and central headers, just like the ExtraField option in + IO::Compress::Gzip. + + * Moved the zip constants into IO::Compress::Zip::Constants + + * Added exTime option to IO::Compress::Zip. + This allows creation of the extended timestamp extra field. + + * Added Minimal option to IO::Compress::Zip. + This disables the creation of all extended fields. + + * Added TextFlag option to IO::Compress::Zip. + + * Documented Comment and ZipComment options in IO::Compress::Zip. + 2.000_11 10 April 2006 * Updated Documentation for zip modules. diff --git a/ext/Compress/IO/Zlib/README b/ext/Compress/IO/Zlib/README index 6d323cb..fdeadaa 100644 --- a/ext/Compress/IO/Zlib/README +++ b/ext/Compress/IO/Zlib/README @@ -1,9 +1,9 @@ IO::Compress::Zlib - Version 2.000_11 + Version 2.000_12 - 10 April 2006 + 17 May 2006 Copyright (c) 2005-2006 Paul Marquess. All rights reserved. diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm index 454689e..07a84fa 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm @@ -9,7 +9,7 @@ use IO::Compress::Base::Common qw(:Status); use Compress::Raw::Zlib qw(Z_OK Z_FINISH MAX_WBITS) ; our ($VERSION); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; sub mkCompObject { diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm index 72f6efc..e253d43 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm @@ -7,7 +7,7 @@ use bytes; use IO::Compress::Base::Common qw(:Status); our ($VERSION); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; sub mkCompObject { diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm index df4af0c..9ef3ebc 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm @@ -15,7 +15,7 @@ use IO::Compress::Base::Common qw(createSelfTiedObject); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; $DeflateError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -378,9 +378,14 @@ If the C<$output> parameter is any other type, C will be returned. =head2 Notes + + When C<$input> maps to multiple files/buffers and C<$output> is a single -file/buffer the compressed input files/buffers will all be stored -in C<$output> as a single compressed stream. +file/buffer the input files/buffers will be stored +in C<$output> as a concatenated series of compressed data streams. + + + diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm index 4d4c2d2..ce3a903 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm @@ -13,6 +13,7 @@ use IO::Compress::RawDeflate; use Compress::Raw::Zlib ; use IO::Compress::Base::Common qw(:Status :Parse createSelfTiedObject); use IO::Compress::Gzip::Constants; +use IO::Compress::Zlib::Extra; BEGIN { @@ -26,7 +27,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; $GzipError = '' ; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -74,7 +75,7 @@ sub getExtraParams 'TextFlag' => [0, 1, Parse_boolean, 0], 'HeaderCRC' => [0, 1, Parse_boolean, 0], 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], - 'ExtraField'=> [0, 1, Parse_string, undef], + 'ExtraField'=> [0, 1, Parse_any, undef], 'ExtraFlags'=> [0, 1, Parse_any, undef], ); @@ -92,7 +93,7 @@ sub ckParams return 1 if $got->value('Merge') ; - my $lax = ! $got->value('Strict') ; + my $strict = $got->value('Strict') ; { @@ -108,11 +109,11 @@ sub ckParams return $self->saveErrorString(undef, "Null Character found in Name", Z_DATA_ERROR) - if ! $lax && $name =~ /\x00/ ; + if $strict && $name =~ /\x00/ ; return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name", Z_DATA_ERROR) - if ! $lax && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ; + if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ; } if ($got->parsed('Comment') && defined $got->value('Comment')) { @@ -120,11 +121,11 @@ sub ckParams return $self->saveErrorString(undef, "Null Character found in Comment", Z_DATA_ERROR) - if ! $lax && $comment =~ /\x00/ ; + if $strict && $comment =~ /\x00/ ; return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment", Z_DATA_ERROR) - if ! $lax && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o; + if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o; } if ($got->parsed('OS_Code') ) { @@ -145,16 +146,13 @@ sub ckParams if $got->value('Level') == Z_BEST_COMPRESSION ; } - if ($got->parsed('ExtraField')) { - - my $bad = $self->parseExtraField($got, $lax) ; - return $self->saveErrorString(undef, $bad, Z_DATA_ERROR) + my $data = $got->value('ExtraField') ; + if (defined $data) { + my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ; + return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR) if $bad ; - my $len = length $got->value('ExtraField') ; - return $self->saveErrorString(undef, ExtraFieldError("Too Large"), - Z_DATA_ERROR) - if $len > GZIP_FEXTRA_MAX_SIZE; + $got->value('ExtraField', $data) ; } } @@ -265,158 +263,6 @@ sub mkHeader return $out ; } -sub ExtraFieldError -{ - return "Error with ExtraField Parameter: $_[0]" ; -} - -sub validateExtraFieldPair -{ - my $pair = shift ; - my $lax = shift ; - - return ExtraFieldError("Not an array ref") - unless ref $pair && ref $pair eq 'ARRAY'; - - return ExtraFieldError("SubField must have two parts") - unless @$pair == 2 ; - - return ExtraFieldError("SubField ID is a reference") - if ref $pair->[0] ; - - return ExtraFieldError("SubField Data is a reference") - if ref $pair->[1] ; - - # ID is exactly two chars - return ExtraFieldError("SubField ID not two chars long") - unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; - - # Check that the 2nd byte of the ID isn't 0 - return ExtraFieldError("SubField ID 2nd byte is 0x00") - if ! $lax && substr($pair->[0], 1, 1) eq "\x00" ; - - return ExtraFieldError("SubField Data too long") - if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ; - - - return undef ; -} - -sub parseExtra -{ - my $data = shift ; - my $lax = shift ; - - return undef - if $lax ; - - my $XLEN = length $data ; - - return ExtraFieldError("Too Large") - if $XLEN > GZIP_FEXTRA_MAX_SIZE; - - my $offset = 0 ; - while ($offset < $XLEN) { - - return ExtraFieldError("FEXTRA Body") - if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); - $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; - - my $subLen = unpack("v", substr($data, $offset, - GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); - $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; - - return ExtraFieldError("FEXTRA Body") - if $offset + $subLen > $XLEN ; - - my $bad = validateExtraFieldPair( [$id, - substr($data, $offset, $subLen)], $lax ); - return $bad if $bad ; - - $offset += $subLen ; - } - - return undef ; -} - -sub parseExtraField -{ - my $self = shift ; - my $got = shift ; - my $lax = shift ; - - # ExtraField can be any of - # - # -ExtraField => $data - # -ExtraField => [$id1, $data1, - # $id2, $data2] - # ... - # ] - # -ExtraField => [ [$id1 => $data1], - # [$id2 => $data2], - # ... - # ] - # -ExtraField => { $id1 => $data1, - # $id2 => $data2, - # ... - # } - - - return undef - unless $got->parsed('ExtraField') ; - - return parseExtra($got->value('ExtraField'), $lax) - unless ref $got->value('ExtraField') ; - - my $data = $got->value('ExtraField'); - my $out = '' ; - - if (ref $data eq 'ARRAY') { - if (ref $data->[0]) { - - foreach my $pair (@$data) { - return ExtraFieldError("Not list of lists") - unless ref $pair eq 'ARRAY' ; - - my $bad = validateExtraFieldPair($pair, $lax) ; - return $bad if $bad ; - - $out .= $pair->[0] . pack("v", length $pair->[1]) . - $pair->[1] ; - } - } - else { - return ExtraFieldError("Not even number of elements") - unless @$data % 2 == 0; - - for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) { - my $bad = validateExtraFieldPair([$data->[$ix], $data->[$ix+1]], $lax) ; - return $bad if $bad ; - - $out .= $data->[$ix] . pack("v", length $data->[$ix+1]) . - $data->[$ix+1] ; - } - } - } - elsif (ref $data eq 'HASH') { - while (my ($id, $info) = each %$data) { - my $bad = validateExtraFieldPair([$id, $info], $lax); - return $bad if $bad ; - - $out .= $id . pack("v", length $info) . $info ; - } - } - else { - return ExtraFieldError("Not a scalar, array ref or hash ref") ; - } - - $got->value('ExtraField' => $out); - - return undef; -} - sub mkFinalTrailer { return ''; @@ -651,9 +497,14 @@ If the C<$output> parameter is any other type, C will be returned. =head2 Notes + + When C<$input> maps to multiple files/buffers and C<$output> is a single -file/buffer the compressed input files/buffers will all be stored -in C<$output> as a single compressed stream. +file/buffer the input files/buffers will be stored +in C<$output> as a concatenated series of compressed data streams. + + + diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm index 024c443..9c671b5 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; @ISA = qw(Exporter); diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm index fc195e7..0f917e2 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm @@ -16,7 +16,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; $RawDeflateError = ''; @ISA = qw(Exporter IO::Compress::Base); @@ -462,9 +462,14 @@ If the C<$output> parameter is any other type, C will be returned. =head2 Notes + + When C<$input> maps to multiple files/buffers and C<$output> is a single -file/buffer the compressed input files/buffers will all be stored -in C<$output> as a single compressed stream. +file/buffer the input files/buffers will be stored +in C<$output> as a concatenated series of compressed data streams. + + + diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm index 4441809..ea189b0 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm @@ -8,14 +8,16 @@ use IO::Compress::Base::Common qw(:Status createSelfTiedObject); use IO::Compress::RawDeflate; use IO::Compress::Adapter::Deflate; use IO::Compress::Adapter::Identity; +use IO::Compress::Zip::Constants; + use Compress::Raw::Zlib qw(crc32) ; BEGIN { eval { require IO::Compress::Adapter::Bzip2; - import IO::Compress::Adapter::Bzip2; + import IO::Compress::Adapter::Bzip2; require IO::Compress::Bzip2; - import IO::Compress::Bzip2; + import IO::Compress::Bzip2; } ; } @@ -24,7 +26,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError); -$VERSION = '2.000_11'; +$VERSION = '2.000_12'; $ZipError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -37,23 +39,6 @@ push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} }; Exporter::export_ok_tags('all'); -use constant ZIP_CM_STORE => 0 ; -use constant ZIP_CM_DEFLATE => 8 ; -use constant ZIP_CM_BZIP2 => 12 ; - -use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; -use constant ZIP_DATA_HDR_SIG => 0x08074b50; -use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; -use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; - - -our (%ZIP_CM_MIN_VERSIONS); -%ZIP_CM_MIN_VERSIONS = ( - ZIP_CM_STORE() => 20, - ZIP_CM_DEFLATE() => 20, - ZIP_CM_BZIP2() => 46, - ); - sub new { my $class = shift ; @@ -137,6 +122,8 @@ sub mkHeader my $self = shift; my $param = shift ; + *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} ; + my $filename = ''; $filename = $param->value('Name') || ''; @@ -146,52 +133,89 @@ sub mkHeader my $hdr = ''; my $time = _unixToDosTime($param->value('Time')); - *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} ; - my $strm = *$self->{ZipData}{Stream} ? 8 : 0 ; - # bzip2 is 12, deflate is 8 + my $extra = ''; + my $ctlExtra = ''; + + if (! $param->value('Minimal')) { + if (defined $param->value('exTime')) + { + $extra .= mkExtendedTime($param->value('MTime'), + $param->value('ATime'), + $param->value('CTime')); + + $ctlExtra .= mkExtendedTime($param->value('MTime')); + } + + # if ( $param->value('UID')) + # { + # $extra .= mkUnixExtra( $param->value('UID'), $param->value('GID')); + # $ctlExtra .= mkUnixExtra(); + # } + + $extra .= $param->value('ExtraFieldLocal') + if defined $param->value('ExtraFieldLocal'); + + $ctlExtra .= $param->value('ExtraFieldCentral') + if defined $param->value('ExtraFieldCentral'); + } + + my $extAttr = 0; + $extAttr = $param->value('Mode') << 16 + if defined $param->value('Mode') ; + + my $gpFlag = 0 ; + $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK + if *$self->{ZipData}{Stream} ; + my $method = *$self->{ZipData}{Method} ; # deflate is 20 # bzip2 is 46 - my $extract = $param->value('OS_Code') << 8 + + my $madeBy = ($param->value('OS_Code') << 8) + $ZIP_CM_MIN_VERSIONS{$method}; + my $extract = $ZIP_CM_MIN_VERSIONS{$method}; + + my $ifa = 0; + $ifa |= ZIP_IFA_TEXT_MASK + if $param->value('TextFlag'); $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature $hdr .= pack 'v', $extract ; # extract Version & OS - $hdr .= pack 'v', $strm ; # general purpose flag (set streaming mode) + $hdr .= pack 'v', $gpFlag ; # general purpose flag (set streaming mode) $hdr .= pack 'v', $method ; # compression method (deflate) $hdr .= pack 'V', $time ; # last mod date/time $hdr .= pack 'V', 0 ; # crc32 - 0 when streaming $hdr .= pack 'V', 0 ; # compressed length - 0 when streaming $hdr .= pack 'V', 0 ; # uncompressed length - 0 when streaming $hdr .= pack 'v', length $filename ; # filename length - $hdr .= pack 'v', 0 ; # extra length + $hdr .= pack 'v', length $extra ; # extra length $hdr .= $filename ; + $hdr .= $extra ; my $ctl = ''; $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature - $ctl .= pack 'v', $extract ; # version made by + $ctl .= pack 'v', $madeBy ; # version made by $ctl .= pack 'v', $extract ; # extract Version - $ctl .= pack 'v', $strm ; # general purpose flag (streaming mode) + $ctl .= pack 'v', $gpFlag ; # general purpose flag (streaming mode) $ctl .= pack 'v', $method ; # compression method (deflate) $ctl .= pack 'V', $time ; # last mod date/time $ctl .= pack 'V', 0 ; # crc32 $ctl .= pack 'V', 0 ; # compressed length $ctl .= pack 'V', 0 ; # uncompressed length $ctl .= pack 'v', length $filename ; # filename length - $ctl .= pack 'v', 0 ; # extra length + $ctl .= pack 'v', length $ctlExtra ; # extra length $ctl .= pack 'v', length $comment ; # file comment length $ctl .= pack 'v', 0 ; # disk number start - $ctl .= pack 'v', 0 ; # internal file attributes - $ctl .= pack 'V', 0 ; # external file attributes + $ctl .= pack 'v', $ifa ; # internal file attributes + $ctl .= pack 'V', $extAttr ; # external file attributes $ctl .= pack 'V', *$self->{ZipData}{Offset} ; # offset to local header $ctl .= $filename ; - #$ctl .= $extra ; + $ctl .= $ctlExtra ; $ctl .= $comment ; *$self->{ZipData}{Offset} += length $hdr ; @@ -234,9 +258,6 @@ sub mkTrailer my $ctl = *$self->{ZipData}{CentralHeader} ; substr($ctl, 16, 12) = $data ; - #substr($ctl, 16, 4) = pack "V", $crc32 ; # CRC32 - #substr($ctl, 20, 4) = pack "V", $compressedBytes ; # Compressed Size - #substr($ctl, 24, 4) = pack "V", $uncompressedBytes ; # Uncompressed Size *$self->{ZipData}{Offset} += length($hdr) + $compressedBytes; push @{ *$self->{ZipData}{CentralDir} }, $ctl ; @@ -280,11 +301,21 @@ sub ckParams $got->value('Time' => time) ; } + if (! $got->parsed('exTime') ) { + my $timeRef = $got->value('exTime'); + if ( defined $timeRef) { + return $self->saveErrorString(undef, "exTime not a 3-element array ref") + if ref $timeRef ne 'ARRAY' || @$timeRef != 3; + } + + $got->value("MTime", $timeRef->[1]); + $got->value("ATime", $timeRef->[0]); + $got->value("CTime", $timeRef->[2]); + } + *$self->{ZipData}{Stream} = $got->value('Stream'); - #*$self->{ZipData}{Store} = $got->value('Store'); my $method = $got->value('Method'); - #if ($method != 0 && $method != 8 && $method != 12) { return $self->saveErrorString(undef, "Unknown Method '$method'") if ! defined $ZIP_CM_MIN_VERSIONS{$method}; @@ -296,6 +327,18 @@ sub ckParams *$self->{ZipData}{ZipComment} = $got->value('ZipComment') ; + for my $name (qw( ExtraFieldLocal ExtraFieldCentral )) + { + my $data = $got->value($name) ; + if (defined $data) { + my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ; + return $self->saveErrorString(undef, "Error with $name Parameter: $bad") + if $bad ; + + $got->value($name, $data) ; + } + } + return undef if defined $IO::Compress::Bzip2::VERSION and ! IO::Compress::Bzip2::ckParams($self, $got); @@ -331,15 +374,17 @@ sub getExtraParams 'Method' => [0, 1, Parse_unsigned, ZIP_CM_DEFLATE], # # Zip header fields -# 'Minimal' => [0, 1, Parse_boolean, 0], + 'Minimal' => [0, 1, Parse_boolean, 0], 'Comment' => [0, 1, Parse_any, ''], 'ZipComment'=> [0, 1, Parse_any, ''], 'Name' => [0, 1, Parse_any, ''], 'Time' => [0, 1, Parse_any, undef], + 'exTime' => [0, 1, Parse_any, undef], 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], -# 'TextFlag' => [0, 1, Parse_boolean, 0], -# 'ExtraField'=> [0, 1, Parse_string, ''], + 'TextFlag' => [0, 1, Parse_boolean, 0], + 'ExtraFieldLocal' => [0, 1, Parse_any, undef], + 'ExtraFieldCentral'=> [0, 1, Parse_any, undef], @Bzip2, ); @@ -357,17 +402,66 @@ sub getFileInfo my $params = shift; my $filename = shift ; - my $defaultTime = (stat($filename))[9] ; + my ($mode, $uid, $gid, $atime, $mtime, $ctime) + = (stat($filename))[2, 4,5, 8,9,10] ; $params->value('Name' => $filename) if ! $params->parsed('Name') ; - $params->value('Time' => $defaultTime) + $params->value('Time' => $mtime) if ! $params->parsed('Time') ; + if ( ! $params->parsed('exTime')) + { + $params->value('MTime' => $mtime) ; + $params->value('ATime' => $atime) ; + $params->value('CTime' => $ctime) ; + } + + $params->value('Mode' => $mode) ; + + $params->value('UID' => $uid) ; + $params->value('GID' => $gid) ; } +sub mkExtendedTime +{ + # order expected is m, a, c + + my $times = ''; + my $bit = 1 ; + my $flags = 0; + + for my $time (@_) + { + if (defined $time) + { + $flags |= $bit; + $times .= pack("V", $time); + } + + $bit <<= 1 ; + } + + #return "UT" . pack("v C", length($times) + 1, $flags) . $times; + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP, + pack("C", $flags) . $times); +} + +sub mkUnixExtra +{ + my $ids = ''; + for my $id (@_) + { + $ids .= pack("v", $id); + } + + #return "Ux" . pack("v", length $ids) . $ids; + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX, $ids); +} + + # from Archive::Zip sub _unixToDosTime # Archive::Zip::Member { @@ -559,10 +653,10 @@ 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 -the C and C