| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package IO::Compress::Zip ; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 19 |  |  | 19 |  | 74279 | use strict ; | 
|  | 19 |  |  |  |  | 101 |  | 
|  | 19 |  |  |  |  | 600 |  | 
| 4 | 19 |  |  | 19 |  | 99 | use warnings; | 
|  | 19 |  |  |  |  | 46 |  | 
|  | 19 |  |  |  |  | 469 |  | 
| 5 | 19 |  |  | 19 |  | 5792 | use bytes; | 
|  | 19 |  |  |  |  | 161 |  | 
|  | 19 |  |  |  |  | 92 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 19 |  |  | 19 |  | 5412 | use IO::Compress::Base::Common  2.205 qw(:Status ); | 
|  | 19 |  |  |  |  | 433 |  | 
|  | 19 |  |  |  |  | 2473 |  | 
| 8 | 19 |  |  | 19 |  | 9565 | use IO::Compress::RawDeflate 2.205 (); | 
|  | 19 |  |  |  |  | 417 |  | 
|  | 19 |  |  |  |  | 806 |  | 
| 9 | 19 |  |  | 19 |  | 128 | use IO::Compress::Adapter::Deflate 2.205 ; | 
|  | 19 |  |  |  |  | 358 |  | 
|  | 19 |  |  |  |  | 3503 |  | 
| 10 | 19 |  |  | 19 |  | 8526 | use IO::Compress::Adapter::Identity 2.205 ; | 
|  | 19 |  |  |  |  | 399 |  | 
|  | 19 |  |  |  |  | 594 |  | 
| 11 | 19 |  |  | 19 |  | 4201 | use IO::Compress::Zlib::Extra 2.205 ; | 
|  | 19 |  |  |  |  | 295 |  | 
|  | 19 |  |  |  |  | 513 |  | 
| 12 | 19 |  |  | 19 |  | 4242 | use IO::Compress::Zip::Constants 2.205 ; | 
|  | 19 |  |  |  |  | 292 |  | 
|  | 19 |  |  |  |  | 3842 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 19 |  |  | 19 |  | 140 | use File::Spec(); | 
|  | 19 |  |  |  |  | 45 |  | 
|  | 19 |  |  |  |  | 372 |  | 
| 15 | 19 |  |  | 19 |  | 90 | use Config; | 
|  | 19 |  |  |  |  | 38 |  | 
|  | 19 |  |  |  |  | 1083 |  | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 19 |  |  | 19 |  | 124 | use Compress::Raw::Zlib  2.205 (); | 
|  | 19 |  |  |  |  | 338 |  | 
|  | 19 |  |  |  |  | 3184 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | BEGIN | 
| 20 |  |  |  |  |  |  | { | 
| 21 | 19 |  |  | 19 |  | 63 | eval { require IO::Compress::Adapter::Bzip2 ; | 
|  | 19 |  |  |  |  | 7728 |  | 
| 22 | 19 |  |  |  |  | 212 | IO::Compress::Adapter::Bzip2->import( 2.205 ); | 
| 23 | 19 |  |  |  |  | 8584 | require IO::Compress::Bzip2 ; | 
| 24 | 19 |  |  |  |  | 1863 | IO::Compress::Bzip2->import( 2.205 ); | 
| 25 |  |  |  |  |  |  | } ; | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 19 |  |  |  |  | 57 | eval { require IO::Compress::Adapter::Lzma ; | 
|  | 19 |  |  |  |  | 3345 |  | 
| 28 | 0 |  |  |  |  | 0 | IO::Compress::Adapter::Lzma->import( 2.205 ); | 
| 29 | 0 |  |  |  |  | 0 | require IO::Compress::Lzma ; | 
| 30 | 0 |  |  |  |  | 0 | IO::Compress::Lzma->import( 2.205 ); | 
| 31 |  |  |  |  |  |  | } ; | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 19 |  |  |  |  | 502 | eval { require IO::Compress::Adapter::Xz ; | 
|  | 19 |  |  |  |  | 2628 |  | 
| 34 | 0 |  |  |  |  | 0 | IO::Compress::Adapter::Xz->import( 2.205 ); | 
| 35 | 0 |  |  |  |  | 0 | require IO::Compress::Xz ; | 
| 36 | 0 |  |  |  |  | 0 | IO::Compress::Xz->import( 2.205 ); | 
| 37 |  |  |  |  |  |  | } ; | 
| 38 | 19 |  |  |  |  | 401 | eval { require IO::Compress::Adapter::Zstd ; | 
|  | 19 |  |  |  |  | 48691 |  | 
| 39 | 0 |  |  |  |  | 0 | IO::Compress::Adapter::Zstd->import( 2.205 ); | 
| 40 | 0 |  |  |  |  | 0 | require IO::Compress::Zstd ; | 
| 41 | 0 |  |  |  |  | 0 | IO::Compress::Zstd->import( 2.205 ); | 
| 42 |  |  |  |  |  |  | } ; | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | require Exporter ; | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | $VERSION = '2.205'; | 
| 51 |  |  |  |  |  |  | $ZipError = ''; | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | @ISA = qw(IO::Compress::RawDeflate Exporter); | 
| 54 |  |  |  |  |  |  | @EXPORT_OK = qw( $ZipError zip ) ; | 
| 55 |  |  |  |  |  |  | %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | $EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_XZ ZIP_CM_ZSTD)]; | 
| 60 |  |  |  |  |  |  | push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} }; | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | Exporter::export_ok_tags('all'); | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | sub new | 
| 65 |  |  |  |  |  |  | { | 
| 66 | 151 |  |  | 151 | 1 | 155194 | my $class = shift ; | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 151 |  |  |  |  | 619 | my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError); | 
| 69 | 151 |  |  |  |  | 683 | $obj->_create(undef, @_); | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | sub zip | 
| 74 |  |  |  |  |  |  | { | 
| 75 | 197 |  |  | 197 | 1 | 9177665 | my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError); | 
| 76 | 197 |  |  |  |  | 685 | return $obj->_def(@_); | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub isMethodAvailable | 
| 80 |  |  |  |  |  |  | { | 
| 81 | 3 |  |  | 3 | 0 | 329 | my $method = shift; | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | # Store & Deflate are always available | 
| 84 | 3 | 100 | 100 |  |  | 23 | return 1 | 
| 85 |  |  |  |  |  |  | if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ; | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | return 1 | 
| 88 |  |  |  |  |  |  | if $method == ZIP_CM_BZIP2 && | 
| 89 |  |  |  |  |  |  | defined $IO::Compress::Adapter::Bzip2::VERSION && | 
| 90 | 1 | 0 | 33 |  |  | 8 | defined &{ "IO::Compress::Adapter::Bzip2::mkRawZipCompObject" }; | 
|  | 0 |  | 33 |  |  | 0 |  | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | return 1 | 
| 93 |  |  |  |  |  |  | if $method == ZIP_CM_LZMA && | 
| 94 |  |  |  |  |  |  | defined $IO::Compress::Adapter::Lzma::VERSION && | 
| 95 | 1 | 0 | 33 |  |  | 4 | defined &{ "IO::Compress::Adapter::Lzma::mkRawZipCompObject" }; | 
|  | 0 |  | 33 |  |  | 0 |  | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | return 1 | 
| 98 |  |  |  |  |  |  | if $method == ZIP_CM_XZ && | 
| 99 |  |  |  |  |  |  | defined $IO::Compress::Adapter::Xz::VERSION && | 
| 100 | 1 | 0 | 33 |  |  | 6 | defined &{ "IO::Compress::Adapter::Xz::mkRawZipCompObject" }; | 
|  | 0 |  | 33 |  |  | 0 |  | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | return 1 | 
| 103 |  |  |  |  |  |  | if $method == ZIP_CM_ZSTD && | 
| 104 |  |  |  |  |  |  | defined $IO::Compress::Adapter::ZSTD::VERSION && | 
| 105 | 1 | 0 | 33 |  |  | 5 | defined &{ "IO::Compress::Adapter::ZSTD::mkRawZipCompObject" }; | 
|  | 0 |  | 33 |  |  | 0 |  | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 1 |  |  |  |  | 5 | return 0; | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | sub beforePayload | 
| 111 |  |  |  |  |  |  | { | 
| 112 | 383 |  |  | 383 | 0 | 639 | my $self = shift ; | 
| 113 |  |  |  |  |  |  |  | 
| 114 | 383 | 50 |  |  |  | 1208 | if (*$self->{ZipData}{Sparse} ) { | 
| 115 | 0 |  |  |  |  | 0 | my $inc = 1024 * 100 ; | 
| 116 | 0 |  |  |  |  | 0 | my $NULLS = ("\x00" x $inc) ; | 
| 117 | 0 |  |  |  |  | 0 | my $sparse = *$self->{ZipData}{Sparse} ; | 
| 118 | 0 |  |  |  |  | 0 | *$self->{CompSize}->add( $sparse ); | 
| 119 | 0 |  |  |  |  | 0 | *$self->{UnCompSize}->add( $sparse ); | 
| 120 |  |  |  |  |  |  |  | 
| 121 | 0 |  |  |  |  | 0 | *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR); | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32}) | 
| 124 | 0 |  |  |  |  | 0 | for 1 .. int $sparse / $inc; | 
| 125 |  |  |  |  |  |  | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0,  $sparse % $inc), | 
| 126 |  |  |  |  |  |  | *$self->{ZipData}{CRC32}) | 
| 127 | 0 | 0 |  |  |  | 0 | if $sparse % $inc; | 
| 128 |  |  |  |  |  |  | } | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | sub mkComp | 
| 132 |  |  |  |  |  |  | { | 
| 133 | 385 |  |  | 385 | 0 | 596 | my $self = shift ; | 
| 134 | 385 |  |  |  |  | 547 | my $got = shift ; | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 385 |  |  |  |  | 630 | my ($obj, $errstr, $errno) ; | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 385 | 100 |  |  |  | 1288 | if (*$self->{ZipData}{Method} == ZIP_CM_STORE) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 139 | 34 |  |  |  |  | 81 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject( | 
| 140 |  |  |  |  |  |  | $got->getValue('level'), | 
| 141 |  |  |  |  |  |  | $got->getValue('strategy') | 
| 142 |  |  |  |  |  |  | ); | 
| 143 | 34 |  |  |  |  | 156 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); | 
| 144 |  |  |  |  |  |  | } | 
| 145 |  |  |  |  |  |  | elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { | 
| 146 | 332 |  |  |  |  | 766 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject( | 
| 147 |  |  |  |  |  |  | $got->getValue('crc32'), | 
| 148 |  |  |  |  |  |  | $got->getValue('adler32'), | 
| 149 |  |  |  |  |  |  | $got->getValue('level'), | 
| 150 |  |  |  |  |  |  | $got->getValue('strategy') | 
| 151 |  |  |  |  |  |  | ); | 
| 152 |  |  |  |  |  |  | } | 
| 153 |  |  |  |  |  |  | elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) { | 
| 154 | 19 |  |  |  |  | 58 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject( | 
| 155 |  |  |  |  |  |  | $got->getValue('blocksize100k'), | 
| 156 |  |  |  |  |  |  | $got->getValue('workfactor'), | 
| 157 |  |  |  |  |  |  | $got->getValue('verbosity') | 
| 158 |  |  |  |  |  |  | ); | 
| 159 | 19 |  |  |  |  | 108 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  | elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { | 
| 162 | 0 |  |  |  |  | 0 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'), | 
| 163 |  |  |  |  |  |  | $got->getValue('extreme'), | 
| 164 |  |  |  |  |  |  | ); | 
| 165 | 0 |  |  |  |  | 0 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); | 
| 166 |  |  |  |  |  |  | } | 
| 167 |  |  |  |  |  |  | elsif (*$self->{ZipData}{Method} == ZIP_CM_XZ) { | 
| 168 | 0 |  |  |  |  | 0 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Xz::mkCompObject($got->getValue('preset'), | 
| 169 |  |  |  |  |  |  | $got->getValue('extreme'), | 
| 170 |  |  |  |  |  |  | 0 | 
| 171 |  |  |  |  |  |  | ); | 
| 172 | 0 |  |  |  |  | 0 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); | 
| 173 |  |  |  |  |  |  | } | 
| 174 |  |  |  |  |  |  | elsif (*$self->{ZipData}{Method} == ZIP_CM_ZSTD) { | 
| 175 | 0 | 0 |  |  |  | 0 | ($obj, $errstr, $errno) = IO::Compress::Adapter::Zstd::mkCompObject(defined $got->getValue('level') ? $got->getValue('level') : 3, | 
| 176 |  |  |  |  |  |  | ); | 
| 177 | 0 |  |  |  |  | 0 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); | 
| 178 |  |  |  |  |  |  | } | 
| 179 |  |  |  |  |  |  |  | 
| 180 | 385 | 50 |  |  |  | 1160 | return $self->saveErrorString(undef, $errstr, $errno) | 
| 181 |  |  |  |  |  |  | if ! defined $obj; | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 385 | 100 |  |  |  | 1230 | if (! defined *$self->{ZipData}{SizesOffset}) { | 
| 184 | 314 |  |  |  |  | 685 | *$self->{ZipData}{SizesOffset} = 0; | 
| 185 | 314 |  |  |  |  | 1614 | *$self->{ZipData}{Offset} = U64->new(); | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | *$self->{ZipData}{AnyZip64} = 0 | 
| 189 | 385 | 100 |  |  |  | 1351 | if ! defined  *$self->{ZipData}{AnyZip64} ; | 
| 190 |  |  |  |  |  |  |  | 
| 191 | 385 |  |  |  |  | 2652 | return $obj; | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | sub reset | 
| 195 |  |  |  |  |  |  | { | 
| 196 | 0 |  |  | 0 | 0 | 0 | my $self = shift ; | 
| 197 |  |  |  |  |  |  |  | 
| 198 | 0 |  |  |  |  | 0 | *$self->{Compress}->reset(); | 
| 199 | 0 |  |  |  |  | 0 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(''); | 
| 200 |  |  |  |  |  |  |  | 
| 201 | 0 |  |  |  |  | 0 | return STATUS_OK; | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | sub filterUncompressed | 
| 205 |  |  |  |  |  |  | { | 
| 206 | 365 |  |  | 365 | 0 | 632 | my $self = shift ; | 
| 207 |  |  |  |  |  |  |  | 
| 208 | 365 | 100 |  |  |  | 930 | if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { | 
| 209 | 317 |  |  |  |  | 1126 | *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32(); | 
| 210 |  |  |  |  |  |  | } | 
| 211 |  |  |  |  |  |  | else { | 
| 212 | 48 |  |  |  |  | 75 | *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}); | 
|  | 48 |  |  |  |  | 304 |  | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  | } | 
| 216 |  |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  | sub canonicalName | 
| 218 |  |  |  |  |  |  | { | 
| 219 |  |  |  |  |  |  | # This sub is derived from Archive::Zip::_asZipDirName | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | # Return the normalized name as used in a zip file (path | 
| 222 |  |  |  |  |  |  | # separators become slashes, etc.). | 
| 223 |  |  |  |  |  |  | # Will translate internal slashes in path components (i.e. on Macs) to | 
| 224 |  |  |  |  |  |  | # underscores.  Discards volume names. | 
| 225 |  |  |  |  |  |  | # When $forceDir is set, returns paths with trailing slashes | 
| 226 |  |  |  |  |  |  | # | 
| 227 |  |  |  |  |  |  | # input         output | 
| 228 |  |  |  |  |  |  | # .             '.' | 
| 229 |  |  |  |  |  |  | # ./a           a | 
| 230 |  |  |  |  |  |  | # ./a/b         a/b | 
| 231 |  |  |  |  |  |  | # ./a/b/        a/b | 
| 232 |  |  |  |  |  |  | # a/b/          a/b | 
| 233 |  |  |  |  |  |  | # /a/b/         a/b | 
| 234 |  |  |  |  |  |  | # c:\a\b\c.doc  a/b/c.doc      # on Windows | 
| 235 |  |  |  |  |  |  | # "i/o maps:whatever"   i_o maps/whatever   # on Macs | 
| 236 |  |  |  |  |  |  |  | 
| 237 | 2 |  |  | 2 | 0 | 5 | my $name      = shift; | 
| 238 | 2 |  |  |  |  | 3 | my $forceDir  = shift ; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 2 |  |  |  |  | 44 | my ( $volume, $directories, $file ) = | 
| 241 |  |  |  |  |  |  | File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); | 
| 242 |  |  |  |  |  |  |  | 
| 243 | 2 |  |  |  |  | 17 | my @dirs = map { $_ =~ s{/}{_}g; $_ } | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 14 |  | 
| 244 |  |  |  |  |  |  | File::Spec->splitdir($directories); | 
| 245 |  |  |  |  |  |  |  | 
| 246 | 2 | 50 |  |  |  | 9 | if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' }   # remove empty component | 
|  | 2 | 50 |  |  |  | 6 |  | 
| 247 | 2 | 50 |  |  |  | 9 | push @dirs, defined($file) ? $file : '' ; | 
| 248 |  |  |  |  |  |  |  | 
| 249 | 2 |  |  |  |  | 6 | my $normalised_path = join '/', @dirs; | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | # Leading directory separators should not be stored in zip archives. | 
| 252 |  |  |  |  |  |  | # Example: | 
| 253 |  |  |  |  |  |  | #   C:\a\b\c\      a/b/c | 
| 254 |  |  |  |  |  |  | #   C:\a\b\c.txt   a/b/c.txt | 
| 255 |  |  |  |  |  |  | #   /a/b/c/        a/b/c | 
| 256 |  |  |  |  |  |  | #   /a/b/c.txt     a/b/c.txt | 
| 257 | 2 |  |  |  |  | 6 | $normalised_path =~ s{^/}{};  # remove leading separator | 
| 258 |  |  |  |  |  |  |  | 
| 259 | 2 |  |  |  |  | 7 | return $normalised_path; | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | sub mkHeader | 
| 264 |  |  |  |  |  |  | { | 
| 265 | 384 |  |  | 384 | 0 | 736 | my $self  = shift; | 
| 266 | 384 |  |  |  |  | 587 | my $param = shift ; | 
| 267 |  |  |  |  |  |  |  | 
| 268 | 384 |  |  |  |  | 1174 | *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset}); | 
| 269 |  |  |  |  |  |  |  | 
| 270 | 384 |  |  |  |  | 754 | my $comment = ''; | 
| 271 | 384 |  |  |  |  | 1032 | $comment = $param->valueOrDefault('comment') ; | 
| 272 |  |  |  |  |  |  |  | 
| 273 | 384 |  |  |  |  | 770 | my $filename = ''; | 
| 274 | 384 |  |  |  |  | 859 | $filename = $param->valueOrDefault('name') ; | 
| 275 |  |  |  |  |  |  |  | 
| 276 | 384 | 100 | 100 |  |  | 1372 | $filename = canonicalName($filename) | 
| 277 |  |  |  |  |  |  | if length $filename && $param->getValue('canonicalname') ; | 
| 278 |  |  |  |  |  |  |  | 
| 279 | 384 | 100 |  |  |  | 1060 | if (defined *$self->{ZipData}{FilterName} ) { | 
| 280 | 3 |  |  |  |  | 17 | local *_ = \$filename ; | 
| 281 | 3 |  |  |  |  | 6 | &{ *$self->{ZipData}{FilterName} }() ; | 
|  | 3 |  |  |  |  | 13 |  | 
| 282 |  |  |  |  |  |  | } | 
| 283 |  |  |  |  |  |  |  | 
| 284 | 384 | 100 | 66 |  |  | 986 | if ( $param->getValue('efs') && $] >= 5.008004) { | 
| 285 | 5 | 50 |  |  |  | 39 | if (length $filename) { | 
| 286 | 5 | 100 |  |  |  | 274 | utf8::downgrade($filename, 1) | 
| 287 |  |  |  |  |  |  | or Carp::croak "Wide character in zip filename"; | 
| 288 |  |  |  |  |  |  | } | 
| 289 |  |  |  |  |  |  |  | 
| 290 | 4 | 50 |  |  |  | 9 | if (length $comment) { | 
| 291 | 0 | 0 |  |  |  | 0 | utf8::downgrade($comment, 1) | 
| 292 |  |  |  |  |  |  | or Carp::croak "Wide character in zip comment"; | 
| 293 |  |  |  |  |  |  | } | 
| 294 |  |  |  |  |  |  | } | 
| 295 |  |  |  |  |  |  |  | 
| 296 | 383 |  |  |  |  | 699 | my $hdr = ''; | 
| 297 |  |  |  |  |  |  |  | 
| 298 | 383 |  |  |  |  | 828 | my $time = _unixToDosTime($param->getValue('time')); | 
| 299 |  |  |  |  |  |  |  | 
| 300 | 383 |  |  |  |  | 713 | my $extra = ''; | 
| 301 | 383 |  |  |  |  | 599 | my $ctlExtra = ''; | 
| 302 | 383 |  |  |  |  | 527 | my $empty = 0; | 
| 303 | 383 |  |  |  |  | 1203 | my $osCode = $param->getValue('os_code') ; | 
| 304 | 383 |  |  |  |  | 622 | my $extFileAttr = 0 ; | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | # This code assumes Unix. | 
| 307 |  |  |  |  |  |  | # TODO - revisit this | 
| 308 | 383 | 50 |  |  |  | 1029 | $extFileAttr = 0100644 << 16 | 
| 309 |  |  |  |  |  |  | if $osCode == ZIP_OS_CODE_UNIX ; | 
| 310 |  |  |  |  |  |  |  | 
| 311 | 383 | 100 |  |  |  | 1310 | if (*$self->{ZipData}{Zip64}) { | 
| 312 | 26 |  |  |  |  | 51 | $empty = IO::Compress::Base::Common::MAX32; | 
| 313 |  |  |  |  |  |  |  | 
| 314 | 26 |  |  |  |  | 60 | my $x = ''; | 
| 315 | 26 |  |  |  |  | 48 | $x .= pack "V V", 0, 0 ; # uncompressedLength | 
| 316 | 26 |  |  |  |  | 43 | $x .= pack "V V", 0, 0 ; # compressedLength | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug | 
| 319 |  |  |  |  |  |  | # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details | 
| 320 | 26 |  |  |  |  | 83 | $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x); | 
| 321 |  |  |  |  |  |  | } | 
| 322 |  |  |  |  |  |  |  | 
| 323 | 383 | 50 |  |  |  | 891 | if (! $param->getValue('minimal')) { | 
| 324 | 383 | 100 |  |  |  | 906 | if ($param->parsed('mtime')) | 
| 325 |  |  |  |  |  |  | { | 
| 326 | 113 |  |  |  |  | 256 | $extra .= mkExtendedTime($param->getValue('mtime'), | 
| 327 |  |  |  |  |  |  | $param->getValue('atime'), | 
| 328 |  |  |  |  |  |  | $param->getValue('ctime')); | 
| 329 |  |  |  |  |  |  |  | 
| 330 | 113 |  |  |  |  | 315 | $ctlExtra .= mkExtendedTime($param->getValue('mtime')); | 
| 331 |  |  |  |  |  |  | } | 
| 332 |  |  |  |  |  |  |  | 
| 333 | 383 | 50 |  |  |  | 930 | if ( $osCode == ZIP_OS_CODE_UNIX ) | 
| 334 |  |  |  |  |  |  | { | 
| 335 | 383 | 100 |  |  |  | 860 | if ( $param->getValue('want_exunixn') ) | 
| 336 |  |  |  |  |  |  | { | 
| 337 | 113 |  |  |  |  | 159 | my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') }); | 
|  | 113 |  |  |  |  | 227 |  | 
| 338 | 113 |  |  |  |  | 210 | $extra    .= $ux3; | 
| 339 | 113 |  |  |  |  | 217 | $ctlExtra .= $ux3; | 
| 340 |  |  |  |  |  |  | } | 
| 341 |  |  |  |  |  |  |  | 
| 342 | 383 | 50 |  |  |  | 941 | if ( $param->getValue('exunix2') ) | 
| 343 |  |  |  |  |  |  | { | 
| 344 | 0 |  |  |  |  | 0 | $extra    .= mkUnix2Extra( @{ $param->getValue('exunix2') }); | 
|  | 0 |  |  |  |  | 0 |  | 
| 345 | 0 |  |  |  |  | 0 | $ctlExtra .= mkUnix2Extra(); | 
| 346 |  |  |  |  |  |  | } | 
| 347 |  |  |  |  |  |  | } | 
| 348 |  |  |  |  |  |  |  | 
| 349 | 383 | 50 |  |  |  | 893 | $extFileAttr = $param->getValue('extattr') | 
| 350 |  |  |  |  |  |  | if defined $param->getValue('extattr') ; | 
| 351 |  |  |  |  |  |  |  | 
| 352 | 383 | 50 |  |  |  | 802 | $extra .= $param->getValue('extrafieldlocal') | 
| 353 |  |  |  |  |  |  | if defined $param->getValue('extrafieldlocal'); | 
| 354 |  |  |  |  |  |  |  | 
| 355 | 383 | 50 |  |  |  | 885 | $ctlExtra .= $param->getValue('extrafieldcentral') | 
| 356 |  |  |  |  |  |  | if defined $param->getValue('extrafieldcentral'); | 
| 357 |  |  |  |  |  |  | } | 
| 358 |  |  |  |  |  |  |  | 
| 359 | 383 |  |  |  |  | 858 | my $method = *$self->{ZipData}{Method} ; | 
| 360 | 383 |  |  |  |  | 601 | my $gpFlag = 0 ; | 
| 361 |  |  |  |  |  |  | $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK | 
| 362 | 383 | 100 |  |  |  | 955 | if *$self->{ZipData}{Stream} ; | 
| 363 |  |  |  |  |  |  |  | 
| 364 | 383 | 50 |  |  |  | 921 | $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT | 
| 365 |  |  |  |  |  |  | if $method == ZIP_CM_LZMA ; | 
| 366 |  |  |  |  |  |  |  | 
| 367 | 383 | 50 | 33 |  |  | 834 | $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING | 
|  |  |  | 66 |  |  |  |  | 
| 368 |  |  |  |  |  |  | if  $param->getValue('efs') && (length($filename) || length($comment)); | 
| 369 |  |  |  |  |  |  |  | 
| 370 | 383 |  |  |  |  | 788 | my $version = $ZIP_CM_MIN_VERSIONS{$method}; | 
| 371 |  |  |  |  |  |  | $version = ZIP64_MIN_VERSION | 
| 372 | 383 | 100 | 100 |  |  | 1823 | if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64}; | 
| 373 |  |  |  |  |  |  |  | 
| 374 | 383 |  |  |  |  | 888 | my $madeBy = ($param->getValue('os_code') << 8) + $version; | 
| 375 | 383 |  |  |  |  | 641 | my $extract = $version; | 
| 376 |  |  |  |  |  |  |  | 
| 377 | 383 |  |  |  |  | 767 | *$self->{ZipData}{Version} = $version; | 
| 378 | 383 |  |  |  |  | 734 | *$self->{ZipData}{MadeBy} = $madeBy; | 
| 379 |  |  |  |  |  |  |  | 
| 380 | 383 |  |  |  |  | 527 | my $ifa = 0; | 
| 381 | 383 | 100 |  |  |  | 784 | $ifa |= ZIP_IFA_TEXT_MASK | 
| 382 |  |  |  |  |  |  | if $param->getValue('textflag'); | 
| 383 |  |  |  |  |  |  |  | 
| 384 | 383 |  |  |  |  | 868 | $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature | 
| 385 | 383 |  |  |  |  | 1165 | $hdr .= pack 'v', $extract   ; # extract Version & OS | 
| 386 | 383 |  |  |  |  | 789 | $hdr .= pack 'v', $gpFlag    ; # general purpose flag (set streaming mode) | 
| 387 | 383 |  |  |  |  | 706 | $hdr .= pack 'v', $method    ; # compression method (deflate) | 
| 388 | 383 |  |  |  |  | 804 | $hdr .= pack 'V', $time      ; # last mod date/time | 
| 389 | 383 |  |  |  |  | 565 | $hdr .= pack 'V', 0          ; # crc32               - 0 when streaming | 
| 390 | 383 |  |  |  |  | 755 | $hdr .= pack 'V', $empty     ; # compressed length   - 0 when streaming | 
| 391 | 383 |  |  |  |  | 615 | $hdr .= pack 'V', $empty     ; # uncompressed length - 0 when streaming | 
| 392 | 383 |  |  |  |  | 752 | $hdr .= pack 'v', length $filename ; # filename length | 
| 393 | 383 |  |  |  |  | 721 | $hdr .= pack 'v', length $extra ; # extra length | 
| 394 |  |  |  |  |  |  |  | 
| 395 | 383 |  |  |  |  | 586 | $hdr .= $filename ; | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | # Remember the offset for the compressed & uncompressed lengths in the | 
| 398 |  |  |  |  |  |  | # local header. | 
| 399 | 383 | 100 |  |  |  | 923 | if (*$self->{ZipData}{Zip64}) { | 
| 400 |  |  |  |  |  |  | *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit() | 
| 401 | 26 |  |  |  |  | 87 | + length($hdr) + 4 ; | 
| 402 |  |  |  |  |  |  | } | 
| 403 |  |  |  |  |  |  | else { | 
| 404 |  |  |  |  |  |  | *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit() | 
| 405 | 357 |  |  |  |  | 1152 | + 18; | 
| 406 |  |  |  |  |  |  | } | 
| 407 |  |  |  |  |  |  |  | 
| 408 | 383 |  |  |  |  | 681 | $hdr .= $extra ; | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  |  | 
| 411 | 383 |  |  |  |  | 608 | my $ctl = ''; | 
| 412 |  |  |  |  |  |  |  | 
| 413 | 383 |  |  |  |  | 622 | $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature | 
| 414 | 383 |  |  |  |  | 692 | $ctl .= pack 'v', $madeBy    ; # version made by | 
| 415 | 383 |  |  |  |  | 713 | $ctl .= pack 'v', $extract   ; # extract Version | 
| 416 | 383 |  |  |  |  | 645 | $ctl .= pack 'v', $gpFlag    ; # general purpose flag (streaming mode) | 
| 417 | 383 |  |  |  |  | 633 | $ctl .= pack 'v', $method    ; # compression method (deflate) | 
| 418 | 383 |  |  |  |  | 607 | $ctl .= pack 'V', $time      ; # last mod date/time | 
| 419 | 383 |  |  |  |  | 512 | $ctl .= pack 'V', 0          ; # crc32 | 
| 420 | 383 |  |  |  |  | 673 | $ctl .= pack 'V', $empty     ; # compressed length | 
| 421 | 383 |  |  |  |  | 659 | $ctl .= pack 'V', $empty     ; # uncompressed length | 
| 422 | 383 |  |  |  |  | 642 | $ctl .= pack 'v', length $filename ; # filename length | 
| 423 |  |  |  |  |  |  |  | 
| 424 | 383 |  |  |  |  | 736 | *$self->{ZipData}{ExtraOffset} = length $ctl; | 
| 425 | 383 |  |  |  |  | 697 | *$self->{ZipData}{ExtraSize} = length $ctlExtra ; | 
| 426 |  |  |  |  |  |  |  | 
| 427 | 383 |  |  |  |  | 679 | $ctl .= pack 'v', length $ctlExtra ; # extra length | 
| 428 | 383 |  |  |  |  | 680 | $ctl .= pack 'v', length $comment ;  # file comment length | 
| 429 | 383 |  |  |  |  | 587 | $ctl .= pack 'v', 0          ; # disk number start | 
| 430 | 383 |  |  |  |  | 645 | $ctl .= pack 'v', $ifa       ; # internal file attributes | 
| 431 | 383 |  |  |  |  | 652 | $ctl .= pack 'V', $extFileAttr   ; # external file attributes | 
| 432 |  |  |  |  |  |  |  | 
| 433 |  |  |  |  |  |  | # offset to local hdr | 
| 434 | 383 | 50 |  |  |  | 1113 | if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { | 
| 435 | 0 |  |  |  |  | 0 | $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ; | 
| 436 |  |  |  |  |  |  | } | 
| 437 |  |  |  |  |  |  | else { | 
| 438 | 383 |  |  |  |  | 1037 | $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; | 
| 439 |  |  |  |  |  |  | } | 
| 440 |  |  |  |  |  |  |  | 
| 441 | 383 |  |  |  |  | 809 | $ctl .= $filename ; | 
| 442 |  |  |  |  |  |  |  | 
| 443 | 383 |  |  |  |  | 1384 | *$self->{ZipData}{Offset}->add32(length $hdr) ; | 
| 444 |  |  |  |  |  |  |  | 
| 445 | 383 |  |  |  |  | 1230 | *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment]; | 
| 446 |  |  |  |  |  |  |  | 
| 447 | 383 |  |  |  |  | 1475 | return $hdr; | 
| 448 |  |  |  |  |  |  | } | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | sub mkTrailer | 
| 451 |  |  |  |  |  |  | { | 
| 452 | 383 |  |  | 383 | 0 | 660 | my $self = shift ; | 
| 453 |  |  |  |  |  |  |  | 
| 454 | 383 |  |  |  |  | 544 | my $crc32 ; | 
| 455 | 383 | 100 |  |  |  | 998 | if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { | 
| 456 | 330 |  |  |  |  | 998 | $crc32 = pack "V", *$self->{Compress}->crc32(); | 
| 457 |  |  |  |  |  |  | } | 
| 458 |  |  |  |  |  |  | else { | 
| 459 | 53 |  |  |  |  | 182 | $crc32 = pack "V", *$self->{ZipData}{CRC32}; | 
| 460 |  |  |  |  |  |  | } | 
| 461 |  |  |  |  |  |  |  | 
| 462 | 383 |  |  |  |  | 682 | my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} }; | 
|  | 383 |  |  |  |  | 1165 |  | 
| 463 |  |  |  |  |  |  |  | 
| 464 | 383 |  |  |  |  | 594 | my $sizes ; | 
| 465 | 383 | 100 |  |  |  | 1786 | if (! *$self->{ZipData}{Zip64}) { | 
| 466 | 357 |  |  |  |  | 931 | $sizes .= *$self->{CompSize}->getPacked_V32() ;   # Compressed size | 
| 467 | 357 |  |  |  |  | 998 | $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size | 
| 468 |  |  |  |  |  |  | } | 
| 469 |  |  |  |  |  |  | else { | 
| 470 | 26 |  |  |  |  | 70 | $sizes .= *$self->{CompSize}->getPacked_V64() ;   # Compressed size | 
| 471 | 26 |  |  |  |  | 68 | $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size | 
| 472 |  |  |  |  |  |  | } | 
| 473 |  |  |  |  |  |  |  | 
| 474 | 383 |  |  |  |  | 906 | my $data = $crc32 . $sizes ; | 
| 475 |  |  |  |  |  |  |  | 
| 476 | 383 |  |  |  |  | 1040 | my $xtrasize  = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size | 
| 477 | 383 |  |  |  |  | 913 | $xtrasize .= *$self->{CompSize}->getPacked_V64() ;   # Compressed size | 
| 478 |  |  |  |  |  |  |  | 
| 479 | 383 |  |  |  |  | 644 | my $hdr = ''; | 
| 480 |  |  |  |  |  |  |  | 
| 481 | 383 | 100 |  |  |  | 945 | if (*$self->{ZipData}{Stream}) { | 
| 482 | 332 |  |  |  |  | 581 | $hdr  = pack "V", ZIP_DATA_HDR_SIG ;                       # signature | 
| 483 | 332 |  |  |  |  | 674 | $hdr .= $data ; | 
| 484 |  |  |  |  |  |  | } | 
| 485 |  |  |  |  |  |  | else { | 
| 486 | 51 | 50 |  |  |  | 148 | $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14,  $crc32) | 
| 487 |  |  |  |  |  |  | or return undef; | 
| 488 |  |  |  |  |  |  | $self->writeAt(*$self->{ZipData}{SizesOffset}, | 
| 489 | 51 | 100 |  |  |  | 304 | *$self->{ZipData}{Zip64} ? $xtrasize : $sizes) | 
|  |  | 50 |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | or return undef; | 
| 491 |  |  |  |  |  |  | } | 
| 492 |  |  |  |  |  |  |  | 
| 493 |  |  |  |  |  |  | # Central Header Record/Zip64 extended field | 
| 494 |  |  |  |  |  |  |  | 
| 495 | 383 |  |  |  |  | 1113 | substr($ctl, 16, length $crc32) = $crc32 ; | 
| 496 |  |  |  |  |  |  |  | 
| 497 | 383 |  |  |  |  | 664 | my $zip64Payload = ''; | 
| 498 |  |  |  |  |  |  |  | 
| 499 |  |  |  |  |  |  | # uncompressed length - only set zip64 if needed | 
| 500 | 383 | 50 |  |  |  | 1074 | if (*$self->{UnCompSize}->isAlmost64bit()) { #  || *$self->{ZipData}{Zip64}) { | 
| 501 | 0 |  |  |  |  | 0 | $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ; | 
| 502 |  |  |  |  |  |  | } else { | 
| 503 | 383 |  |  |  |  | 980 | substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ; | 
| 504 |  |  |  |  |  |  | } | 
| 505 |  |  |  |  |  |  |  | 
| 506 |  |  |  |  |  |  | # compressed length - only set zip64 if needed | 
| 507 | 383 | 50 |  |  |  | 1099 | if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) { | 
| 508 | 0 |  |  |  |  | 0 | $zip64Payload .= *$self->{CompSize}->getPacked_V64() ; | 
| 509 |  |  |  |  |  |  | } else { | 
| 510 | 383 |  |  |  |  | 903 | substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ; | 
| 511 |  |  |  |  |  |  | } | 
| 512 |  |  |  |  |  |  |  | 
| 513 |  |  |  |  |  |  | # Local Header offset | 
| 514 |  |  |  |  |  |  | $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64() | 
| 515 | 383 | 50 |  |  |  | 1100 | if *$self->{ZipData}{LocalHdrOffset}->is64bit() ; | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | # disk no - always zero, so don't need to include it. | 
| 518 |  |  |  |  |  |  | #$zip64Payload .= pack "V", 0    ; | 
| 519 |  |  |  |  |  |  |  | 
| 520 | 383 |  |  |  |  | 743 | my $zip64Xtra = ''; | 
| 521 |  |  |  |  |  |  |  | 
| 522 | 383 | 50 |  |  |  | 1699 | if (length $zip64Payload) { | 
| 523 | 0 |  |  |  |  | 0 | $zip64Xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $zip64Payload); | 
| 524 |  |  |  |  |  |  |  | 
| 525 |  |  |  |  |  |  | substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) = | 
| 526 | 0 |  |  |  |  | 0 | pack 'v', *$self->{ZipData}{ExtraSize} + length $zip64Xtra; | 
| 527 |  |  |  |  |  |  |  | 
| 528 | 0 |  |  |  |  | 0 | *$self->{ZipData}{AnyZip64} = 1; | 
| 529 |  |  |  |  |  |  | } | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug | 
| 532 |  |  |  |  |  |  | # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details | 
| 533 | 383 |  |  |  |  | 955 | $ctl .= $zip64Xtra . $ctlExtra . $comment; | 
| 534 |  |  |  |  |  |  |  | 
| 535 | 383 |  |  |  |  | 1266 | *$self->{ZipData}{Offset}->add32(length($hdr)); | 
| 536 | 383 |  |  |  |  | 1235 | *$self->{ZipData}{Offset}->add( *$self->{CompSize} ); | 
| 537 | 383 |  |  |  |  | 594 | push @{ *$self->{ZipData}{CentralDir} }, $ctl ; | 
|  | 383 |  |  |  |  | 1420 |  | 
| 538 |  |  |  |  |  |  |  | 
| 539 | 383 |  |  |  |  | 1175 | return $hdr; | 
| 540 |  |  |  |  |  |  | } | 
| 541 |  |  |  |  |  |  |  | 
| 542 |  |  |  |  |  |  | sub mkFinalTrailer | 
| 543 |  |  |  |  |  |  | { | 
| 544 | 317 |  |  | 317 | 0 | 530 | my $self = shift ; | 
| 545 |  |  |  |  |  |  |  | 
| 546 | 317 |  |  |  |  | 507 | my $comment = ''; | 
| 547 | 317 |  |  |  |  | 695 | $comment = *$self->{ZipData}{ZipComment} ; | 
| 548 |  |  |  |  |  |  |  | 
| 549 | 317 |  |  |  |  | 926 | my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir | 
| 550 |  |  |  |  |  |  |  | 
| 551 | 317 |  |  |  |  | 473 | my $entries = @{ *$self->{ZipData}{CentralDir} }; | 
|  | 317 |  |  |  |  | 645 |  | 
| 552 |  |  |  |  |  |  |  | 
| 553 |  |  |  |  |  |  | *$self->{ZipData}{AnyZip64} = 1 | 
| 554 | 317 | 50 | 33 |  |  | 771 | if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ; | 
| 555 |  |  |  |  |  |  |  | 
| 556 | 317 |  |  |  |  | 578 | my $cd = join '', @{ *$self->{ZipData}{CentralDir} }; | 
|  | 317 |  |  |  |  | 916 |  | 
| 557 | 317 |  |  |  |  | 510 | my $cd_len = length $cd ; | 
| 558 |  |  |  |  |  |  |  | 
| 559 | 317 |  |  |  |  | 500 | my $z64e = ''; | 
| 560 |  |  |  |  |  |  |  | 
| 561 | 317 | 100 |  |  |  | 796 | if ( *$self->{ZipData}{AnyZip64} ) { | 
| 562 |  |  |  |  |  |  |  | 
| 563 | 21 |  |  |  |  | 86 | my $v  = *$self->{ZipData}{Version} ; | 
| 564 | 21 |  |  |  |  | 43 | my $mb = *$self->{ZipData}{MadeBy} ; | 
| 565 | 21 |  |  |  |  | 66 | $z64e .= pack 'v', $mb            ; # Version made by | 
| 566 | 21 |  |  |  |  | 59 | $z64e .= pack 'v', $v             ; # Version to extract | 
| 567 | 21 |  |  |  |  | 37 | $z64e .= pack 'V', 0              ; # number of disk | 
| 568 | 21 |  |  |  |  | 31 | $z64e .= pack 'V', 0              ; # number of disk with central dir | 
| 569 | 21 |  |  |  |  | 52 | $z64e .= U64::pack_V64 $entries   ; # entries in central dir on this disk | 
| 570 | 21 |  |  |  |  | 52 | $z64e .= U64::pack_V64 $entries   ; # entries in central dir | 
| 571 | 21 |  |  |  |  | 44 | $z64e .= U64::pack_V64 $cd_len    ; # size of central dir | 
| 572 | 21 |  |  |  |  | 61 | $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to start central dir | 
| 573 |  |  |  |  |  |  | $z64e .= *$self->{ZipData}{extrafieldzip64}  # otional extra field | 
| 574 | 21 | 50 |  |  |  | 64 | if defined *$self->{ZipData}{extrafieldzip64} ; | 
| 575 |  |  |  |  |  |  |  | 
| 576 | 21 |  |  |  |  | 96 | $z64e  = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) # signature | 
| 577 |  |  |  |  |  |  | .  U64::pack_V64(length $z64e) | 
| 578 |  |  |  |  |  |  | .  $z64e ; | 
| 579 |  |  |  |  |  |  |  | 
| 580 | 21 |  |  |  |  | 73 | *$self->{ZipData}{Offset}->add32(length $cd) ; | 
| 581 |  |  |  |  |  |  |  | 
| 582 | 21 |  |  |  |  | 37 | $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature | 
| 583 | 21 |  |  |  |  | 37 | $z64e .= pack 'V', 0              ; # number of disk with central dir | 
| 584 | 21 |  |  |  |  | 59 | $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir | 
| 585 | 21 |  |  |  |  | 31 | $z64e .= pack 'V', 1              ; # Total number of disks | 
| 586 |  |  |  |  |  |  |  | 
| 587 | 21 |  |  |  |  | 32 | $cd_offset = IO::Compress::Base::Common::MAX32 ; | 
| 588 | 21 | 50 |  |  |  | 42 | $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ; | 
| 589 | 21 | 50 |  |  |  | 60 | $entries = 0xFFFF if $entries >= 0xFFFF ; | 
| 590 |  |  |  |  |  |  | } | 
| 591 |  |  |  |  |  |  |  | 
| 592 | 317 |  |  |  |  | 512 | my $ecd = ''; | 
| 593 | 317 |  |  |  |  | 532 | $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature | 
| 594 | 317 |  |  |  |  | 435 | $ecd .= pack 'v', 0          ; # number of disk | 
| 595 | 317 |  |  |  |  | 446 | $ecd .= pack 'v', 0          ; # number of disk with central dir | 
| 596 | 317 |  |  |  |  | 683 | $ecd .= pack 'v', $entries   ; # entries in central dir on this disk | 
| 597 | 317 |  |  |  |  | 587 | $ecd .= pack 'v', $entries   ; # entries in central dir | 
| 598 | 317 |  |  |  |  | 513 | $ecd .= pack 'V', $cd_len    ; # size of central dir | 
| 599 | 317 |  |  |  |  | 528 | $ecd .= pack 'V', $cd_offset ; # offset to start central dir | 
| 600 | 317 |  |  |  |  | 542 | $ecd .= pack 'v', length $comment ; # zipfile comment length | 
| 601 | 317 |  |  |  |  | 505 | $ecd .= $comment; | 
| 602 |  |  |  |  |  |  |  | 
| 603 | 317 |  |  |  |  | 1157 | return $cd . $z64e . $ecd ; | 
| 604 |  |  |  |  |  |  | } | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | sub ckParams | 
| 607 |  |  |  |  |  |  | { | 
| 608 | 386 |  |  | 386 | 0 | 644 | my $self = shift ; | 
| 609 | 386 |  |  |  |  | 539 | my $got = shift; | 
| 610 |  |  |  |  |  |  |  | 
| 611 | 386 |  |  |  |  | 1113 | $got->setValue('crc32' => 1); | 
| 612 |  |  |  |  |  |  |  | 
| 613 | 386 | 100 |  |  |  | 874 | if (! $got->parsed('time') ) { | 
| 614 |  |  |  |  |  |  | # Modification time defaults to now. | 
| 615 | 297 |  |  |  |  | 841 | $got->setValue('time' => time) ; | 
| 616 |  |  |  |  |  |  | } | 
| 617 |  |  |  |  |  |  |  | 
| 618 | 386 | 50 |  |  |  | 897 | if ($got->parsed('extime') ) { | 
| 619 | 0 |  |  |  |  | 0 | my $timeRef = $got->getValue('extime'); | 
| 620 | 0 | 0 |  |  |  | 0 | if ( defined $timeRef) { | 
| 621 | 0 | 0 | 0 |  |  | 0 | return $self->saveErrorString(undef, "exTime not a 3-element array ref") | 
| 622 |  |  |  |  |  |  | if ref $timeRef ne 'ARRAY' || @$timeRef != 3; | 
| 623 |  |  |  |  |  |  | } | 
| 624 |  |  |  |  |  |  |  | 
| 625 | 0 |  |  |  |  | 0 | $got->setValue("mtime", $timeRef->[1]); | 
| 626 | 0 |  |  |  |  | 0 | $got->setValue("atime", $timeRef->[0]); | 
| 627 | 0 |  |  |  |  | 0 | $got->setValue("ctime", $timeRef->[2]); | 
| 628 |  |  |  |  |  |  | } | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | # Unix2/3 Extended Attribute | 
| 631 | 386 |  |  |  |  | 913 | for my $name (qw(exunix2 exunixn)) | 
| 632 |  |  |  |  |  |  | { | 
| 633 | 772 | 50 |  |  |  | 1530 | if ($got->parsed($name) ) { | 
| 634 | 0 |  |  |  |  | 0 | my $idRef = $got->getValue($name); | 
| 635 | 0 | 0 |  |  |  | 0 | if ( defined $idRef) { | 
| 636 | 0 | 0 | 0 |  |  | 0 | return $self->saveErrorString(undef, "$name not a 2-element array ref") | 
| 637 |  |  |  |  |  |  | if ref $idRef ne 'ARRAY' || @$idRef != 2; | 
| 638 |  |  |  |  |  |  | } | 
| 639 |  |  |  |  |  |  |  | 
| 640 | 0 |  |  |  |  | 0 | $got->setValue("uid", $idRef->[0]); | 
| 641 | 0 |  |  |  |  | 0 | $got->setValue("gid", $idRef->[1]); | 
| 642 | 0 |  |  |  |  | 0 | $got->setValue("want_$name", $idRef); | 
| 643 |  |  |  |  |  |  | } | 
| 644 |  |  |  |  |  |  | } | 
| 645 |  |  |  |  |  |  |  | 
| 646 | 386 | 100 | 66 |  |  | 953 | *$self->{ZipData}{AnyZip64} = 1 | 
| 647 |  |  |  |  |  |  | if $got->getValue('zip64') || $got->getValue('extrafieldzip64') ; | 
| 648 | 386 |  |  |  |  | 940 | *$self->{ZipData}{Zip64} = $got->getValue('zip64'); | 
| 649 | 386 |  |  |  |  | 922 | *$self->{ZipData}{Stream} = $got->getValue('stream'); | 
| 650 |  |  |  |  |  |  |  | 
| 651 | 386 |  |  |  |  | 844 | my $method = $got->getValue('method'); | 
| 652 |  |  |  |  |  |  | return $self->saveErrorString(undef, "Unknown Method '$method'") | 
| 653 | 386 | 50 |  |  |  | 1261 | if ! defined $ZIP_CM_MIN_VERSIONS{$method}; | 
| 654 |  |  |  |  |  |  |  | 
| 655 | 386 | 50 | 66 |  |  | 1084 | return $self->saveErrorString(undef, "Bzip2 not available") | 
| 656 |  |  |  |  |  |  | if $method == ZIP_CM_BZIP2 and | 
| 657 |  |  |  |  |  |  | ! defined $IO::Compress::Adapter::Bzip2::VERSION; | 
| 658 |  |  |  |  |  |  |  | 
| 659 | 386 | 50 | 33 |  |  | 936 | return $self->saveErrorString(undef, "Lzma not available") | 
| 660 |  |  |  |  |  |  | if $method == ZIP_CM_LZMA | 
| 661 |  |  |  |  |  |  | and ! defined $IO::Compress::Adapter::Lzma::VERSION; | 
| 662 |  |  |  |  |  |  |  | 
| 663 | 386 |  |  |  |  | 821 | *$self->{ZipData}{Method} = $method; | 
| 664 |  |  |  |  |  |  |  | 
| 665 | 386 |  |  |  |  | 802 | *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ; | 
| 666 |  |  |  |  |  |  |  | 
| 667 | 386 |  |  |  |  | 800 | for my $name (qw( extrafieldlocal extrafieldcentral extrafieldzip64)) | 
| 668 |  |  |  |  |  |  | { | 
| 669 | 1158 |  |  |  |  | 2157 | my $data = $got->getValue($name) ; | 
| 670 | 1158 | 50 |  |  |  | 2508 | if (defined $data) { | 
| 671 | 0 |  |  |  |  | 0 | my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ; | 
| 672 | 0 | 0 |  |  |  | 0 | return $self->saveErrorString(undef, "Error with $name Parameter: $bad") | 
| 673 |  |  |  |  |  |  | if $bad ; | 
| 674 |  |  |  |  |  |  |  | 
| 675 | 0 |  |  |  |  | 0 | $got->setValue($name, $data) ; | 
| 676 | 0 |  |  |  |  | 0 | *$self->{ZipData}{$name} = $data; | 
| 677 |  |  |  |  |  |  | } | 
| 678 |  |  |  |  |  |  | } | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | return undef | 
| 681 | 386 | 50 | 33 |  |  | 1765 | if defined $IO::Compress::Bzip2::VERSION | 
| 682 |  |  |  |  |  |  | and ! IO::Compress::Bzip2::ckParams($self, $got); | 
| 683 |  |  |  |  |  |  |  | 
| 684 | 386 | 50 |  |  |  | 866 | if ($got->parsed('sparse') ) { | 
| 685 | 0 |  |  |  |  | 0 | *$self->{ZipData}{Sparse} = $got->getValue('sparse') ; | 
| 686 | 0 |  |  |  |  | 0 | *$self->{ZipData}{Method} = ZIP_CM_STORE; | 
| 687 |  |  |  |  |  |  | } | 
| 688 |  |  |  |  |  |  |  | 
| 689 | 386 | 100 |  |  |  | 880 | if ($got->parsed('filtername')) { | 
| 690 | 3 |  |  |  |  | 7 | my $v = $got->getValue('filtername') ; | 
| 691 | 3 | 50 |  |  |  | 12 | *$self->{ZipData}{FilterName} = $v | 
| 692 |  |  |  |  |  |  | if ref $v eq 'CODE' ; | 
| 693 |  |  |  |  |  |  | } | 
| 694 |  |  |  |  |  |  |  | 
| 695 | 386 |  |  |  |  | 1071 | return 1 ; | 
| 696 |  |  |  |  |  |  | } | 
| 697 |  |  |  |  |  |  |  | 
| 698 |  |  |  |  |  |  | sub outputPayload | 
| 699 |  |  |  |  |  |  | { | 
| 700 | 371 |  |  | 371 | 0 | 637 | my $self = shift ; | 
| 701 | 371 | 50 |  |  |  | 910 | return 1 if *$self->{ZipData}{Sparse} ; | 
| 702 | 371 |  |  |  |  | 1777 | return $self->output(@_); | 
| 703 |  |  |  |  |  |  | } | 
| 704 |  |  |  |  |  |  |  | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | #sub newHeader | 
| 707 |  |  |  |  |  |  | #{ | 
| 708 |  |  |  |  |  |  | #    my $self = shift ; | 
| 709 |  |  |  |  |  |  | # | 
| 710 |  |  |  |  |  |  | #    return $self->mkHeader(*$self->{Got}); | 
| 711 |  |  |  |  |  |  | #} | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  |  | 
| 714 |  |  |  |  |  |  | our %PARAMS = ( | 
| 715 |  |  |  |  |  |  | 'stream'    => [IO::Compress::Base::Common::Parse_boolean,   1], | 
| 716 |  |  |  |  |  |  | #'store'     => [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 717 |  |  |  |  |  |  | 'method'    => [IO::Compress::Base::Common::Parse_unsigned,  ZIP_CM_DEFLATE], | 
| 718 |  |  |  |  |  |  |  | 
| 719 |  |  |  |  |  |  | #            # Zip header fields | 
| 720 |  |  |  |  |  |  | 'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 721 |  |  |  |  |  |  | 'zip64'     => [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 722 |  |  |  |  |  |  | 'comment'   => [IO::Compress::Base::Common::Parse_any,       ''], | 
| 723 |  |  |  |  |  |  | 'zipcomment'=> [IO::Compress::Base::Common::Parse_any,       ''], | 
| 724 |  |  |  |  |  |  | 'name'      => [IO::Compress::Base::Common::Parse_any,       ''], | 
| 725 |  |  |  |  |  |  | 'filtername'=> [IO::Compress::Base::Common::Parse_code,      undef], | 
| 726 |  |  |  |  |  |  | 'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 727 |  |  |  |  |  |  | 'efs'       => [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 728 |  |  |  |  |  |  | 'time'      => [IO::Compress::Base::Common::Parse_any,       undef], | 
| 729 |  |  |  |  |  |  | 'extime'    => [IO::Compress::Base::Common::Parse_any,       undef], | 
| 730 |  |  |  |  |  |  | 'exunix2'   => [IO::Compress::Base::Common::Parse_any,       undef], | 
| 731 |  |  |  |  |  |  | 'exunixn'   => [IO::Compress::Base::Common::Parse_any,       undef], | 
| 732 |  |  |  |  |  |  | 'extattr'   => [IO::Compress::Base::Common::Parse_any, | 
| 733 |  |  |  |  |  |  | $Compress::Raw::Zlib::gzip_os_code == 3 | 
| 734 |  |  |  |  |  |  | ? 0100644 << 16 | 
| 735 |  |  |  |  |  |  | : 0], | 
| 736 |  |  |  |  |  |  | 'os_code'   => [IO::Compress::Base::Common::Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code], | 
| 737 |  |  |  |  |  |  |  | 
| 738 |  |  |  |  |  |  | 'textflag'  => [IO::Compress::Base::Common::Parse_boolean,   0], | 
| 739 |  |  |  |  |  |  | 'extrafieldlocal'  => [IO::Compress::Base::Common::Parse_any,    undef], | 
| 740 |  |  |  |  |  |  | 'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any,    undef], | 
| 741 |  |  |  |  |  |  | 'extrafieldzip64'  => [IO::Compress::Base::Common::Parse_any,    undef], | 
| 742 |  |  |  |  |  |  |  | 
| 743 |  |  |  |  |  |  | # Lzma | 
| 744 |  |  |  |  |  |  | 'preset'   => [IO::Compress::Base::Common::Parse_unsigned, 6], | 
| 745 |  |  |  |  |  |  | 'extreme'  => [IO::Compress::Base::Common::Parse_boolean,  0], | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | # For internal use only | 
| 748 |  |  |  |  |  |  | 'sparse'    => [IO::Compress::Base::Common::Parse_unsigned,  0], | 
| 749 |  |  |  |  |  |  |  | 
| 750 |  |  |  |  |  |  | IO::Compress::RawDeflate::getZlibParams(), | 
| 751 |  |  |  |  |  |  | defined $IO::Compress::Bzip2::VERSION | 
| 752 |  |  |  |  |  |  | ? IO::Compress::Bzip2::getExtraParams() | 
| 753 |  |  |  |  |  |  | : () | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  |  | 
| 756 |  |  |  |  |  |  | ); | 
| 757 |  |  |  |  |  |  |  | 
| 758 |  |  |  |  |  |  | sub getExtraParams | 
| 759 |  |  |  |  |  |  | { | 
| 760 | 386 |  |  | 386 | 0 | 6274 | return %PARAMS ; | 
| 761 |  |  |  |  |  |  | } | 
| 762 |  |  |  |  |  |  |  | 
| 763 |  |  |  |  |  |  | sub getInverseClass | 
| 764 |  |  |  |  |  |  | { | 
| 765 | 19 |  |  | 19 |  | 35211 | no warnings 'once'; | 
|  | 19 |  |  |  |  | 43 |  | 
|  | 19 |  |  |  |  | 5433 |  | 
| 766 | 0 |  |  | 0 | 0 | 0 | return ('IO::Uncompress::Unzip', | 
| 767 |  |  |  |  |  |  | \$IO::Uncompress::Unzip::UnzipError); | 
| 768 |  |  |  |  |  |  | } | 
| 769 |  |  |  |  |  |  |  | 
| 770 |  |  |  |  |  |  | sub getFileInfo | 
| 771 |  |  |  |  |  |  | { | 
| 772 | 163 |  |  | 163 | 0 | 286 | my $self = shift ; | 
| 773 | 163 |  |  |  |  | 242 | my $params = shift; | 
| 774 | 163 |  |  |  |  | 277 | my $filename = shift ; | 
| 775 |  |  |  |  |  |  |  | 
| 776 | 163 | 100 |  |  |  | 342 | if (IO::Compress::Base::Common::isaScalar($filename)) | 
| 777 |  |  |  |  |  |  | { | 
| 778 |  |  |  |  |  |  | $params->setValue(zip64 => 1) | 
| 779 | 50 | 50 |  |  |  | 101 | if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ; | 
|  | 50 |  |  |  |  | 157 |  | 
| 780 |  |  |  |  |  |  |  | 
| 781 | 50 |  |  |  |  | 130 | return ; | 
| 782 |  |  |  |  |  |  | } | 
| 783 |  |  |  |  |  |  |  | 
| 784 | 113 |  |  |  |  | 301 | my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ; | 
| 785 | 113 | 50 |  |  |  | 304 | if ( $params->parsed('storelinks') ) | 
| 786 |  |  |  |  |  |  | { | 
| 787 | 0 |  |  |  |  | 0 | ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) | 
| 788 |  |  |  |  |  |  | = (lstat($filename))[2, 4,5,7, 8,9,10] ; | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  | else | 
| 791 |  |  |  |  |  |  | { | 
| 792 | 113 |  |  |  |  | 1939 | ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) | 
| 793 |  |  |  |  |  |  | = (stat($filename))[2, 4,5,7, 8,9,10] ; | 
| 794 |  |  |  |  |  |  | } | 
| 795 |  |  |  |  |  |  |  | 
| 796 | 113 | 100 |  |  |  | 600 | $params->setValue(textflag => -T $filename ) | 
| 797 |  |  |  |  |  |  | if ! $params->parsed('textflag'); | 
| 798 |  |  |  |  |  |  |  | 
| 799 | 113 | 50 |  |  |  | 355 | $params->setValue(zip64 => 1) | 
| 800 |  |  |  |  |  |  | if IO::Compress::Base::Common::isGeMax32 $size ; | 
| 801 |  |  |  |  |  |  |  | 
| 802 | 113 | 100 |  |  |  | 306 | $params->setValue('name' => $filename) | 
| 803 |  |  |  |  |  |  | if ! $params->parsed('name') ; | 
| 804 |  |  |  |  |  |  |  | 
| 805 | 113 | 100 |  |  |  | 350 | $params->setValue('time' => $mtime) | 
| 806 |  |  |  |  |  |  | if ! $params->parsed('time') ; | 
| 807 |  |  |  |  |  |  |  | 
| 808 | 113 | 50 |  |  |  | 301 | if ( ! $params->parsed('extime')) | 
| 809 |  |  |  |  |  |  | { | 
| 810 | 113 |  |  |  |  | 295 | $params->setValue('mtime' => $mtime) ; | 
| 811 | 113 |  |  |  |  | 279 | $params->setValue('atime' => $atime) ; | 
| 812 | 113 |  |  |  |  | 286 | $params->setValue('ctime' => undef) ; # No Creation time | 
| 813 |  |  |  |  |  |  | # TODO - see if can fillout creation time on non-Unix | 
| 814 |  |  |  |  |  |  | } | 
| 815 |  |  |  |  |  |  |  | 
| 816 |  |  |  |  |  |  | # NOTE - Unix specific code alert | 
| 817 | 113 | 100 |  |  |  | 309 | if (! $params->parsed('extattr')) | 
| 818 |  |  |  |  |  |  | { | 
| 819 | 19 |  |  | 19 |  | 145 | use Fcntl qw(:mode) ; | 
|  | 19 |  |  |  |  | 55 |  | 
|  | 19 |  |  |  |  | 15388 |  | 
| 820 | 108 |  |  |  |  | 217 | my $attr = $mode << 16; | 
| 821 | 108 | 50 |  |  |  | 295 | $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ; | 
| 822 | 108 | 50 |  |  |  | 482 | $attr |= ZIP_A_DIR   if ($mode & S_IFMT  ) == S_IFDIR ; | 
| 823 |  |  |  |  |  |  |  | 
| 824 | 108 |  |  |  |  | 228 | $params->setValue('extattr' => $attr); | 
| 825 |  |  |  |  |  |  | } | 
| 826 |  |  |  |  |  |  |  | 
| 827 | 113 |  |  |  |  | 408 | $params->setValue('want_exunixn', [$uid, $gid]); | 
| 828 | 113 |  |  |  |  | 298 | $params->setValue('uid' => $uid) ; | 
| 829 | 113 |  |  |  |  | 321 | $params->setValue('gid' => $gid) ; | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | } | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | sub mkExtendedTime | 
| 834 |  |  |  |  |  |  | { | 
| 835 |  |  |  |  |  |  | # order expected is m, a, c | 
| 836 |  |  |  |  |  |  |  | 
| 837 | 226 |  |  | 226 | 0 | 341 | my $times = ''; | 
| 838 | 226 |  |  |  |  | 289 | my $bit = 1 ; | 
| 839 | 226 |  |  |  |  | 315 | my $flags = 0; | 
| 840 |  |  |  |  |  |  |  | 
| 841 | 226 |  |  |  |  | 380 | for my $time (@_) | 
| 842 |  |  |  |  |  |  | { | 
| 843 | 452 | 100 |  |  |  | 793 | if (defined $time) | 
| 844 |  |  |  |  |  |  | { | 
| 845 | 339 |  |  |  |  | 433 | $flags |= $bit; | 
| 846 | 339 |  |  |  |  | 732 | $times .= pack("V", $time); | 
| 847 |  |  |  |  |  |  | } | 
| 848 |  |  |  |  |  |  |  | 
| 849 | 452 |  |  |  |  | 654 | $bit <<= 1 ; | 
| 850 |  |  |  |  |  |  | } | 
| 851 |  |  |  |  |  |  |  | 
| 852 | 226 |  |  |  |  | 833 | return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP, | 
| 853 |  |  |  |  |  |  | pack("C", $flags) .  $times); | 
| 854 |  |  |  |  |  |  | } | 
| 855 |  |  |  |  |  |  |  | 
| 856 |  |  |  |  |  |  | sub mkUnix2Extra | 
| 857 |  |  |  |  |  |  | { | 
| 858 | 0 |  |  | 0 | 0 | 0 | my $ids = ''; | 
| 859 | 0 |  |  |  |  | 0 | for my $id (@_) | 
| 860 |  |  |  |  |  |  | { | 
| 861 | 0 |  |  |  |  | 0 | $ids .= pack("v", $id); | 
| 862 |  |  |  |  |  |  | } | 
| 863 |  |  |  |  |  |  |  | 
| 864 | 0 |  |  |  |  | 0 | return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2, | 
| 865 |  |  |  |  |  |  | $ids); | 
| 866 |  |  |  |  |  |  | } | 
| 867 |  |  |  |  |  |  |  | 
| 868 |  |  |  |  |  |  | sub mkUnixNExtra | 
| 869 |  |  |  |  |  |  | { | 
| 870 | 113 |  |  | 113 | 0 | 201 | my $uid = shift; | 
| 871 | 113 |  |  |  |  | 145 | my $gid = shift; | 
| 872 |  |  |  |  |  |  |  | 
| 873 |  |  |  |  |  |  | # Assumes UID/GID are 32-bit | 
| 874 | 113 |  |  |  |  | 153 | my $ids ; | 
| 875 | 113 |  |  |  |  | 193 | $ids .= pack "C", 1; # version | 
| 876 | 113 |  |  |  |  | 1401 | $ids .= pack "C", $Config{uidsize}; | 
| 877 | 113 |  |  |  |  | 365 | $ids .= pack "V", $uid; | 
| 878 | 113 |  |  |  |  | 668 | $ids .= pack "C", $Config{gidsize}; | 
| 879 | 113 |  |  |  |  | 262 | $ids .= pack "V", $gid; | 
| 880 |  |  |  |  |  |  |  | 
| 881 | 113 |  |  |  |  | 282 | return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, | 
| 882 |  |  |  |  |  |  | $ids); | 
| 883 |  |  |  |  |  |  | } | 
| 884 |  |  |  |  |  |  |  | 
| 885 |  |  |  |  |  |  |  | 
| 886 |  |  |  |  |  |  | # from Archive::Zip | 
| 887 |  |  |  |  |  |  | sub _unixToDosTime    # Archive::Zip::Member | 
| 888 |  |  |  |  |  |  | { | 
| 889 | 383 |  |  | 383 |  | 634 | my $time_t = shift; | 
| 890 |  |  |  |  |  |  |  | 
| 891 |  |  |  |  |  |  | # TODO - add something to cope with unix time < 1980 | 
| 892 | 383 |  |  |  |  | 10275 | my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); | 
| 893 | 383 |  |  |  |  | 1336 | my $dt = 0; | 
| 894 | 383 |  |  |  |  | 824 | $dt += ( $sec >> 1 ); | 
| 895 | 383 |  |  |  |  | 720 | $dt += ( $min << 5 ); | 
| 896 | 383 |  |  |  |  | 567 | $dt += ( $hour << 11 ); | 
| 897 | 383 |  |  |  |  | 675 | $dt += ( $mday << 16 ); | 
| 898 | 383 |  |  |  |  | 644 | $dt += ( ( $mon + 1 ) << 21 ); | 
| 899 | 383 |  |  |  |  | 870 | $dt += ( ( $year - 80 ) << 25 ); | 
| 900 | 383 |  |  |  |  | 854 | return $dt; | 
| 901 |  |  |  |  |  |  | } | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | 1; | 
| 904 |  |  |  |  |  |  |  | 
| 905 |  |  |  |  |  |  | __END__ |