← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Archive/Zip/Member.pm
StatementsExecuted 5597 statements in 22.9ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
7114.16ms19.1msArchive::Zip::Member::::contentsArchive::Zip::Member::contents
111838µs942µsArchive::Zip::Member::::BEGIN@27Archive::Zip::Member::BEGIN@27
128021398µs398µsArchive::Zip::Member::::_revbeArchive::Zip::Member::_revbe
711136µs912µsArchive::Zip::Member::::rewindDataArchive::Zip::Member::rewindData
111117µs119µsArchive::Zip::Member::::BEGIN@1517Archive::Zip::Member::BEGIN@1517
71190µs13.0msArchive::Zip::Member::::readChunkArchive::Zip::Member::readChunk
111185µs210µsArchive::Zip::Member::::newArchive::Zip::Member::new
71178µs12.3msArchive::Zip::Member::::_inflateChunkArchive::Zip::Member::_inflateChunk
314271µs75µsArchive::Zip::Member::::desiredCompressionMethodArchive::Zip::Member::desiredCompressionMethod
1013257µs57µsArchive::Zip::Member::::fileNameArchive::Zip::Member::fileName
111151µs122µsArchive::Zip::Member::::unixFileAttributesArchive::Zip::Member::unixFileAttributes
311147µs72µsArchive::Zip::Member::::endReadArchive::Zip::Member::endRead
111131µs41µsArchive::Zip::Member::::_mapPermissionsToUnixArchive::Zip::Member::_mapPermissionsToUnix
142129µs37µsArchive::Zip::Member::::readIsDoneArchive::Zip::Member::readIsDone
111119µs266µsArchive::Zip::Member::::_newFromZipFileArchive::Zip::Member::_newFromZipFile
455215µs15µsArchive::Zip::Member::::compressionMethodArchive::Zip::Member::compressionMethod
11110µs11µsArchive::Zip::Member::::BEGIN@578Archive::Zip::Member::BEGIN@578
11110µs11µsArchive::Zip::Member::::BEGIN@5Archive::Zip::Member::BEGIN@5
111110µs10µsArchive::Zip::Member::::localExtraFieldArchive::Zip::Member::localExtraField
21319µs9µsArchive::Zip::Member::::uncompressedSizeArchive::Zip::Member::uncompressedSize
11119µs9µsArchive::Zip::Member::::_mapPermissionsFromUnixArchive::Zip::Member::_mapPermissionsFromUnix
1118µs8µsArchive::Zip::Member::::BEGIN@8Archive::Zip::Member::BEGIN@8
1117µs26µsArchive::Zip::Member::::BEGIN@37Archive::Zip::Member::BEGIN@37
14117µs7µsArchive::Zip::Member::::_dataEndedArchive::Zip::Member::_dataEnded
1117µs70µsArchive::Zip::Member::::BEGIN@28Archive::Zip::Member::BEGIN@28
21316µs6µsArchive::Zip::Member::::_readDataRemainingArchive::Zip::Member::_readDataRemaining
7115µs5µsArchive::Zip::Member::::isEncryptedArchive::Zip::Member::isEncrypted
1114µs18µsArchive::Zip::Member::::BEGIN@29Archive::Zip::Member::BEGIN@29
1114µs19µsArchive::Zip::Member::::BEGIN@30Archive::Zip::Member::BEGIN@30
1114µs240µsArchive::Zip::Member::::BEGIN@19Archive::Zip::Member::BEGIN@19
7114µs4µsArchive::Zip::Member::::compressedSizeArchive::Zip::Member::compressedSize
1113µs24µsArchive::Zip::Member::::BEGIN@33Archive::Zip::Member::BEGIN@33
1113µs21µsArchive::Zip::Member::::BEGIN@6Archive::Zip::Member::BEGIN@6
7113µs3µsArchive::Zip::Member::::_inflaterArchive::Zip::Member::_inflater
11113µs3µsArchive::Zip::Member::::DEFAULT_FILE_PERMISSIONSArchive::Zip::Member::DEFAULT_FILE_PERMISSIONS (xsub)
1112µs19µsArchive::Zip::Member::::BEGIN@34Archive::Zip::Member::BEGIN@34
1112µs16µsArchive::Zip::Member::::BEGIN@35Archive::Zip::Member::BEGIN@35
1112µs16µsArchive::Zip::Member::::BEGIN@36Archive::Zip::Member::BEGIN@36
111400ns400nsArchive::Zip::Member::::__ANON__Archive::Zip::Member::__ANON__ (xsub)
0000s0sArchive::Zip::Member::::_becomeArchive::Zip::Member::_become
0000s0sArchive::Zip::Member::::_copyChunkArchive::Zip::Member::_copyChunk
0000s0sArchive::Zip::Member::::_crc32Archive::Zip::Member::_crc32
0000s0sArchive::Zip::Member::::_decodeArchive::Zip::Member::_decode
0000s0sArchive::Zip::Member::::_deflateChunkArchive::Zip::Member::_deflateChunk
0000s0sArchive::Zip::Member::::_deflaterArchive::Zip::Member::_deflater
0000s0sArchive::Zip::Member::::_dosToUnixTimeArchive::Zip::Member::_dosToUnixTime
0000s0sArchive::Zip::Member::::_extractZip64ExtraFieldArchive::Zip::Member::_extractZip64ExtraField
0000s0sArchive::Zip::Member::::_noChunkArchive::Zip::Member::_noChunk
0000s0sArchive::Zip::Member::::_readOffsetArchive::Zip::Member::_readOffset
0000s0sArchive::Zip::Member::::_readRawChunkArchive::Zip::Member::_readRawChunk
0000s0sArchive::Zip::Member::::_refreshLocalFileHeaderArchive::Zip::Member::_refreshLocalFileHeader
0000s0sArchive::Zip::Member::::_unixToDosTimeArchive::Zip::Member::_unixToDosTime
0000s0sArchive::Zip::Member::::_update_keysArchive::Zip::Member::_update_keys
0000s0sArchive::Zip::Member::::_usesFileNamedArchive::Zip::Member::_usesFileNamed
0000s0sArchive::Zip::Member::::_writeCentralDirectoryFileHeaderArchive::Zip::Member::_writeCentralDirectoryFileHeader
0000s0sArchive::Zip::Member::::_writeDataArchive::Zip::Member::_writeData
0000s0sArchive::Zip::Member::::_writeDataDescriptorArchive::Zip::Member::_writeDataDescriptor
0000s0sArchive::Zip::Member::::_writeLocalFileHeaderArchive::Zip::Member::_writeLocalFileHeader
0000s0sArchive::Zip::Member::::_writeOffsetArchive::Zip::Member::_writeOffset
0000s0sArchive::Zip::Member::::_writeToFileHandleArchive::Zip::Member::_writeToFileHandle
0000s0sArchive::Zip::Member::::_zdecodeArchive::Zip::Member::_zdecode
0000s0sArchive::Zip::Member::::bitFlagArchive::Zip::Member::bitFlag
0000s0sArchive::Zip::Member::::cdExtraFieldArchive::Zip::Member::cdExtraField
0000s0sArchive::Zip::Member::::crc32Archive::Zip::Member::crc32
0000s0sArchive::Zip::Member::::crc32StringArchive::Zip::Member::crc32String
0000s0sArchive::Zip::Member::::desiredCompressionLevelArchive::Zip::Member::desiredCompressionLevel
0000s0sArchive::Zip::Member::::desiredZip64ModeArchive::Zip::Member::desiredZip64Mode
0000s0sArchive::Zip::Member::::externalFileAttributesArchive::Zip::Member::externalFileAttributes
0000s0sArchive::Zip::Member::::externalFileNameArchive::Zip::Member::externalFileName
0000s0sArchive::Zip::Member::::extraFieldsArchive::Zip::Member::extraFields
0000s0sArchive::Zip::Member::::extractToFileHandleArchive::Zip::Member::extractToFileHandle
0000s0sArchive::Zip::Member::::extractToFileNamedArchive::Zip::Member::extractToFileNamed
0000s0sArchive::Zip::Member::::fileAttributeFormatArchive::Zip::Member::fileAttributeFormat
0000s0sArchive::Zip::Member::::fileCommentArchive::Zip::Member::fileComment
0000s0sArchive::Zip::Member::::fileNameAsBytesArchive::Zip::Member::fileNameAsBytes
0000s0sArchive::Zip::Member::::hasDataDescriptorArchive::Zip::Member::hasDataDescriptor
0000s0sArchive::Zip::Member::::internalFileAttributesArchive::Zip::Member::internalFileAttributes
0000s0sArchive::Zip::Member::::isBinaryFileArchive::Zip::Member::isBinaryFile
0000s0sArchive::Zip::Member::::isDirectoryArchive::Zip::Member::isDirectory
0000s0sArchive::Zip::Member::::isSymbolicLinkArchive::Zip::Member::isSymbolicLink
0000s0sArchive::Zip::Member::::isTextFileArchive::Zip::Member::isTextFile
0000s0sArchive::Zip::Member::::lastModFileDateTimeArchive::Zip::Member::lastModFileDateTime
0000s0sArchive::Zip::Member::::lastModTimeArchive::Zip::Member::lastModTime
0000s0sArchive::Zip::Member::::mkpath_win32Archive::Zip::Member::mkpath_win32
0000s0sArchive::Zip::Member::::newDirectoryNamedArchive::Zip::Member::newDirectoryNamed
0000s0sArchive::Zip::Member::::newFromFileArchive::Zip::Member::newFromFile
0000s0sArchive::Zip::Member::::newFromStringArchive::Zip::Member::newFromString
0000s0sArchive::Zip::Member::::passwordArchive::Zip::Member::password
0000s0sArchive::Zip::Member::::setLastModFileDateTimeFromUnixArchive::Zip::Member::setLastModFileDateTimeFromUnix
0000s0sArchive::Zip::Member::::versionMadeByArchive::Zip::Member::versionMadeBy
0000s0sArchive::Zip::Member::::versionNeededToExtractArchive::Zip::Member::versionNeededToExtract
0000s0sArchive::Zip::Member::::wasWrittenArchive::Zip::Member::wasWritten
0000s0sArchive::Zip::Member::::writeLocalHeaderRelativeOffsetArchive::Zip::Member::writeLocalHeaderRelativeOffset
0000s0sArchive::Zip::Member::::zip64Archive::Zip::Member::zip64
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Archive::Zip::Member;
2
3# A generic member of an archive
4
5222µs213µs
# spent 11µs (10+2) within Archive::Zip::Member::BEGIN@5 which was called: # once (10µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 5
use strict;
# spent 11µs making 1 call to Archive::Zip::Member::BEGIN@5 # spent 2µs making 1 call to strict::import
6242µs238µs
# spent 21µs (3+18) within Archive::Zip::Member::BEGIN@6 which was called: # once (3µs+18µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 6
use vars qw( $VERSION @ISA );
# spent 21µs making 1 call to Archive::Zip::Member::BEGIN@6 # spent 18µs making 1 call to vars::import
7
8
# spent 8µs within Archive::Zip::Member::BEGIN@8 which was called: # once (8µs+0s) by Spreadsheet::ParseXLSX::BEGIN@11 at line 17
BEGIN {
91200ns $VERSION = '1.68';
1016µs @ISA = qw( Archive::Zip );
11
1213µs if ($^O eq 'MSWin32') {
13 require Win32;
14 require Encode;
15 Encode->import(qw{ decode_utf8 });
16 }
17121µs18µs}
# spent 8µs making 1 call to Archive::Zip::Member::BEGIN@8
18
1912µs1237µs
# spent 240µs (4+237) within Archive::Zip::Member::BEGIN@19 which was called: # once (4µs+237µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 25
use Archive::Zip qw(
# spent 237µs making 1 call to Exporter::import
20 :CONSTANTS
21 :MISC_CONSTANTS
22 :ERROR_CODES
23 :PKZIP_CONSTANTS
24 :UTILITY_METHODS
25117µs1240µs);
# spent 240µs making 1 call to Archive::Zip::Member::BEGIN@19
26
27280µs1942µs
# spent 942µs (838+105) within Archive::Zip::Member::BEGIN@27 which was called: # once (838µs+105µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 27
use Time::Local ();
# spent 942µs making 1 call to Archive::Zip::Member::BEGIN@27
28220µs2134µs
# spent 70µs (7+63) within Archive::Zip::Member::BEGIN@28 which was called: # once (7µs+63µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 28
use Compress::Raw::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
# spent 70µs making 1 call to Archive::Zip::Member::BEGIN@28 # spent 63µs making 1 call to Exporter::import
29214µs231µs
# spent 18µs (4+14) within Archive::Zip::Member::BEGIN@29 which was called: # once (4µs+14µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 29
use File::Path;
# spent 18µs making 1 call to Archive::Zip::Member::BEGIN@29 # spent 14µs making 1 call to Exporter::import
30216µs234µs
# spent 19µs (4+15) within Archive::Zip::Member::BEGIN@30 which was called: # once (4µs+15µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 30
use File::Basename;
# spent 19µs making 1 call to Archive::Zip::Member::BEGIN@30 # spent 15µs making 1 call to Exporter::import
31
32# Unix perms for default creation of files/dirs.
33214µs245µs
# spent 24µs (3+21) within Archive::Zip::Member::BEGIN@33 which was called: # once (3µs+21µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 33
use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
# spent 24µs making 1 call to Archive::Zip::Member::BEGIN@33 # spent 21µs making 1 call to constant::import
34212µs236µs
# spent 19µs (2+16) within Archive::Zip::Member::BEGIN@34 which was called: # once (2µs+16µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 34
use constant DEFAULT_FILE_PERMISSIONS => 0100666;
# spent 19µs making 1 call to Archive::Zip::Member::BEGIN@34 # spent 16µs making 1 call to constant::import
35212µs230µs
# spent 16µs (2+14) within Archive::Zip::Member::BEGIN@35 which was called: # once (2µs+14µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 35
use constant DIRECTORY_ATTRIB => 040000;
# spent 16µs making 1 call to Archive::Zip::Member::BEGIN@35 # spent 14µs making 1 call to constant::import
36226µs229µs
# spent 16µs (2+13) within Archive::Zip::Member::BEGIN@36 which was called: # once (2µs+13µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 36
use constant FILE_ATTRIB => 0100000;
# spent 16µs making 1 call to Archive::Zip::Member::BEGIN@36 # spent 13µs making 1 call to constant::import
3712µs116µs
# spent 26µs (7+19) within Archive::Zip::Member::BEGIN@37 which was called: # once (7µs+19µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 40
use constant OS_SUPPORTS_SYMLINK => do {
# spent 16µs making 1 call to constant::import
381100ns local $@;
3937µs13µs !!eval { symlink("",""); 1 };
# spent 3µs making 1 call to CORE::symlink
4011.36ms126µs};
# spent 26µs making 1 call to Archive::Zip::Member::BEGIN@37
41
42# Returns self if successful, else undef
43# Assumes that fh is positioned at beginning of central directory file header.
44# Leaves fh positioned immediately after file header or EOCD signature.
45
# spent 266µs (19+247) within Archive::Zip::Member::_newFromZipFile which was called 11 times, avg 24µs/call: # 11 times (19µs+247µs) by Archive::Zip::Archive::readFromFileHandle at line 780 of Archive/Zip/Archive.pm, avg 24µs/call
sub _newFromZipFile {
46111µs my $class = shift;
47118µs11247µs my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_);
# spent 247µs making 11 calls to Archive::Zip::ZipFileMember::_newFromZipFile, avg 22µs/call
48118µs return $self;
49}
50
51sub newFromString {
52 my $class = shift;
53
54 my ($stringOrStringRef, $fileName);
55 if (ref($_[0]) eq 'HASH') {
56 $stringOrStringRef = $_[0]->{string};
57 $fileName = $_[0]->{zipName};
58 } else {
59 ($stringOrStringRef, $fileName) = @_;
60 }
61
62 my $self =
63 Archive::Zip::StringMember->_newFromString($stringOrStringRef, $fileName);
64 return $self;
65}
66
67sub newFromFile {
68 my $class = shift;
69
70 my ($fileName, $zipName);
71 if (ref($_[0]) eq 'HASH') {
72 $fileName = $_[0]->{fileName};
73 $zipName = $_[0]->{zipName};
74 } else {
75 ($fileName, $zipName) = @_;
76 }
77
78 my $self =
79 Archive::Zip::NewFileMember->_newFromFileNamed($fileName, $zipName);
80 return $self;
81}
82
83sub newDirectoryNamed {
84 my $class = shift;
85
86 my ($directoryName, $newName);
87 if (ref($_[0]) eq 'HASH') {
88 $directoryName = $_[0]->{directoryName};
89 $newName = $_[0]->{zipName};
90 } else {
91 ($directoryName, $newName) = @_;
92 }
93
94 my $self =
95 Archive::Zip::DirectoryMember->_newNamed($directoryName, $newName);
96 return $self;
97}
98
99
# spent 210µs (85+125) within Archive::Zip::Member::new which was called 11 times, avg 19µs/call: # 11 times (85µs+125µs) by Archive::Zip::ZipFileMember::_newFromZipFile at line 28 of Archive/Zip/ZipFileMember.pm, avg 19µs/call
sub new {
100111µs my $class = shift;
101 # Info-Zip 3.0 (I guess) seems to use the following values
102 # for the version fields in local and central directory
103 # headers, regardless of whether the member has an zip64
104 # extended information extra field or not:
105 #
106 # version made by:
107 # 30
108 #
109 # version needed to extract:
110 # 10 for directory and stored entries
111 # 20 for anything else
1121149µs my $self = {
113 'lastModFileDateTime' => 0,
114 'fileAttributeFormat' => FA_UNIX,
115 'zip64' => 0,
116 'desiredZip64Mode' => ZIP64_AS_NEEDED,
117 'versionMadeBy' => 20,
118 'versionNeededToExtract' => 20,
119 'bitFlag' => ($Archive::Zip::UNICODE ? 0x0800 : 0),
120 'compressionMethod' => COMPRESSION_STORED,
121 'desiredCompressionMethod' => COMPRESSION_STORED,
122 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE,
123 'internalFileAttributes' => 0,
124 'externalFileAttributes' => 0, # set later
125 'fileName' => '',
126 'cdExtraField' => '',
127 'localExtraField' => '',
128 'fileComment' => '',
129 'crc32' => 0,
130 'compressedSize' => 0,
131 'uncompressedSize' => 0,
132 'password' => undef, # password for encrypted data
133 'crc32c' => -1, # crc for decrypted data
134 @_
135 };
136113µs bless($self, $class);
1371126µs22125µs $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS);
# spent 122µs making 11 calls to Archive::Zip::Member::unixFileAttributes, avg 11µs/call # spent 3µs making 11 calls to Archive::Zip::Member::DEFAULT_FILE_PERMISSIONS, avg 236ns/call
1381113µs return $self;
139}
140
141# Morph into given class (do whatever cleanup I need to do)
142sub _become {
143 return bless($_[0], $_[1]);
144}
145
146sub fileAttributeFormat {
147 my $self = shift;
148
149 if (@_) {
150 $self->{fileAttributeFormat} =
151 (ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0];
152 } else {
153 return $self->{fileAttributeFormat};
154 }
155}
156
157sub zip64 {
158 shift->{'zip64'};
159}
160
161sub desiredZip64Mode {
162 my $self = shift;
163 my $desiredZip64Mode = $self->{'desiredZip64Mode'};
164 if (@_) {
165 $self->{'desiredZip64Mode'} =
166 ref($_[0]) eq 'HASH' ? shift->{desiredZip64Mode} : shift;
167 }
168 return $desiredZip64Mode;
169}
170
171sub versionMadeBy {
172 shift->{'versionMadeBy'};
173}
174
175sub versionNeededToExtract {
176 shift->{'versionNeededToExtract'};
177}
178
179sub bitFlag {
180 my $self = shift;
181
182# Set General Purpose Bit Flags according to the desiredCompressionLevel setting
183 if ( $self->desiredCompressionLevel == 1
184 || $self->desiredCompressionLevel == 2) {
185 $self->{'bitFlag'} |= DEFLATING_COMPRESSION_FAST;
186 } elsif ($self->desiredCompressionLevel == 3
187 || $self->desiredCompressionLevel == 4
188 || $self->desiredCompressionLevel == 5
189 || $self->desiredCompressionLevel == 6
190 || $self->desiredCompressionLevel == 7) {
191 $self->{'bitFlag'} |= DEFLATING_COMPRESSION_NORMAL;
192 } elsif ($self->desiredCompressionLevel == 8
193 || $self->desiredCompressionLevel == 9) {
194 $self->{'bitFlag'} |= DEFLATING_COMPRESSION_MAXIMUM;
195 }
196
197 if ($Archive::Zip::UNICODE) {
198 $self->{'bitFlag'} |= 0x0800;
199 }
200 $self->{'bitFlag'};
201}
202
203sub password {
204 my $self = shift;
205 $self->{'password'} = shift if @_;
206 $self->{'password'};
207}
208
209
# spent 15µs within Archive::Zip::Member::compressionMethod which was called 45 times, avg 329ns/call: # 14 times (2µs+0s) by Archive::Zip::Member::rewindData at line 1212, avg 150ns/call # 10 times (5µs+0s) by Archive::Zip::ZipFileMember::_readCentralDirectoryFileHeader at line 432 of Archive/Zip/ZipFileMember.pm, avg 470ns/call # 7 times (3µs+0s) by Archive::Zip::Member::rewindData at line 1243, avg 457ns/call # 7 times (3µs+0s) by Archive::Zip::Member::rewindData at line 1208, avg 371ns/call # 7 times (2µs+0s) by Archive::Zip::Member::readChunk at line 1125, avg 314ns/call
sub compressionMethod {
2104534µs shift->{'compressionMethod'};
211}
212
213
# spent 75µs (71+4) within Archive::Zip::Member::desiredCompressionMethod which was called 31 times, avg 2µs/call: # 10 times (24µs+0s) by Archive::Zip::ZipFileMember::_readCentralDirectoryFileHeader at line 432 of Archive/Zip/ZipFileMember.pm, avg 2µs/call # 7 times (26µs+4µs) by Archive::Zip::Member::contents at line 1288, avg 4µs/call # 7 times (15µs+0s) by Archive::Zip::Member::contents at line 1307, avg 2µs/call # 7 times (6µs+0s) by Archive::Zip::Member::rewindData at line 1212, avg 843ns/call
sub desiredCompressionMethod {
214314µs my $self = shift;
215 my $newDesiredCompressionMethod =
2163110µs (ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift;
217316µs my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
218317µs if (defined($newDesiredCompressionMethod)) {
219244µs $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
2202417µs if ($newDesiredCompressionMethod == COMPRESSION_STORED) {
22172µs $self->{'desiredCompressionLevel'} = 0;
22277µs74µs $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
# spent 4µs making 7 calls to Archive::Zip::Member::uncompressedSize, avg 629ns/call
223 if $self->uncompressedSize() == 0;
224 } elsif ($oldDesiredCompressionMethod == COMPRESSION_STORED) {
225 $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
226 }
227 }
2283138µs return $oldDesiredCompressionMethod;
229}
230
231sub desiredCompressionLevel {
232 my $self = shift;
233 my $newDesiredCompressionLevel =
234 (ref($_[0]) eq 'HASH') ? shift->{compressionLevel} : shift;
235 my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
236 if (defined($newDesiredCompressionLevel)) {
237 $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
238 $self->{'desiredCompressionMethod'} = (
239 $newDesiredCompressionLevel
240 ? COMPRESSION_DEFLATED
241 : COMPRESSION_STORED
242 );
243 }
244 return $oldDesiredCompressionLevel;
245}
246
247
# spent 57µs within Archive::Zip::Member::fileName which was called 101 times, avg 563ns/call: # 70 times (37µs+0s) by Archive::Zip::Archive::membersMatching at line 106 of Archive/Zip/Archive.pm, avg 530ns/call # 21 times (13µs+0s) by Archive::Zip::ZipFileMember::isDirectory at line 44 of Archive/Zip/ZipFileMember.pm, avg 633ns/call # 10 times (6µs+0s) by Archive::Zip::Archive::memberNamed at line 98 of Archive/Zip/Archive.pm, avg 650ns/call
sub fileName {
2481016µs my $self = shift;
2491019µs my $newName = shift;
2501017µs if (defined $newName) {
251 $newName =~ y{\\/}{/}s; # deal with dos/windoze problems
252 $self->{'fileName'} = $newName;
253 }
25410174µs return $self->{'fileName'};
255}
256
257sub fileNameAsBytes {
258 my $self = shift;
259 my $bytes = $self->{'fileName'};
260 if($self->{'bitFlag'} & 0x800){
261 $bytes = Encode::encode_utf8($bytes);
262 }
263 return $bytes;
264}
265
266sub lastModFileDateTime {
267 my $modTime = shift->{'lastModFileDateTime'};
268 $modTime =~ m/^(\d+)$/; # untaint
269 return $1;
270}
271
272sub lastModTime {
273 my $self = shift;
274 return _dosToUnixTime($self->lastModFileDateTime());
275}
276
277sub setLastModFileDateTimeFromUnix {
278 my $self = shift;
279 my $time_t = shift;
280 $self->{'lastModFileDateTime'} = _unixToDosTime($time_t);
281}
282
283sub internalFileAttributes {
284 shift->{'internalFileAttributes'};
285}
286
287sub externalFileAttributes {
288 shift->{'externalFileAttributes'};
289}
290
291# Convert UNIX permissions into proper value for zip file
292# Usable as a function or a method
293
# spent 9µs within Archive::Zip::Member::_mapPermissionsFromUnix which was called 11 times, avg 800ns/call: # 11 times (9µs+0s) by Archive::Zip::Member::unixFileAttributes at line 407, avg 800ns/call
sub _mapPermissionsFromUnix {
29411900ns my $self = shift;
295111µs my $mode = shift;
296112µs my $attribs = $mode << 16;
297
298 # Microsoft Windows Explorer needs this bit set for directories
299112µs if ($mode & DIRECTORY_ATTRIB) {
300 $attribs |= 16;
301 }
302
303118µs return $attribs;
304
305 # TODO: map more MS-DOS perms
306}
307
308# Convert ZIP permissions into Unix ones
309#
310# This was taken from Info-ZIP group's portable UnZip
311# zipfile-extraction program, version 5.50.
312# http://www.info-zip.org/pub/infozip/
313#
314# See the mapattr() function in unix/unix.c
315# See the attribute format constants in unzpriv.h
316#
317# XXX Note that there's one situation that is not implemented
318# yet that depends on the "extra field."
319
# spent 41µs (31+10) within Archive::Zip::Member::_mapPermissionsToUnix which was called 11 times, avg 4µs/call: # 11 times (31µs+10µs) by Archive::Zip::Member::unixFileAttributes at line 393, avg 4µs/call
sub _mapPermissionsToUnix {
32011900ns my $self = shift;
321
322113µs my $format = $self->{'fileAttributeFormat'};
323111µs my $attribs = $self->{'externalFileAttributes'};
324
325111µs my $mode = 0;
326
327111µs if ($format == FA_AMIGA) {
328 $attribs = $attribs >> 17 & 7; # Amiga RWE bits
329 $mode = $attribs << 6 | $attribs << 3 | $attribs;
330 return $mode;
331 }
332
333111µs if ($format == FA_THEOS) {
334 $attribs &= 0xF1FFFFFF;
335 if (($attribs & 0xF0000000) != 0x40000000) {
336 $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits
337 } else {
338 $attribs &= 0x41FFFFFF; # leave directory bit as set
339 }
340 }
341
342111µs if ( $format == FA_UNIX
343 || $format == FA_VAX_VMS
344 || $format == FA_ACORN
345 || $format == FA_ATARI_ST
346 || $format == FA_BEOS
347 || $format == FA_QDOS
348 || $format == FA_TANDEM) {
349111µs $mode = $attribs >> 16;
3501117µs1110µs return $mode if $mode != 0 or not $self->localExtraField;
# spent 10µs making 11 calls to Archive::Zip::Member::localExtraField, avg 873ns/call
351
352 # warn("local extra field is: ", $self->localExtraField, "\n");
353
354 # XXX This condition is not implemented
355 # I'm just including the comments from the info-zip section for now.
356
357 # Some (non-Info-ZIP) implementations of Zip for Unix and
358 # VMS (and probably others ??) leave 0 in the upper 16-bit
359 # part of the external_file_attributes field. Instead, they
360 # store file permission attributes in some extra field.
361 # As a work-around, we search for the presence of one of
362 # these extra fields and fall back to the MSDOS compatible
363 # part of external_file_attributes if one of the known
364 # e.f. types has been detected.
365 # Later, we might implement extraction of the permission
366 # bits from the VMS extra field. But for now, the work-around
367 # should be sufficient to provide "readable" extracted files.
368 # (For ASI Unix e.f., an experimental remap from the e.f.
369 # mode value IS already provided!)
370 }
371
372 # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the
373 # Unix attributes in the upper 16 bits of the external attributes
374 # field, just like Info-ZIP's Zip for Unix. We try to use that
375 # value, after a check for consistency with the MSDOS attribute
376 # bits (see below).
377 if ($format == FA_MSDOS) {
378 $mode = $attribs >> 16;
379 }
380
381 # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20
382 $attribs = !($attribs & 1) << 1 | ($attribs & 0x10) >> 4;
383
384 # keep previous $mode setting when its "owner"
385 # part appears to be consistent with DOS attribute flags!
386 return $mode if ($mode & 0700) == (0400 | $attribs << 6);
387 $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
388 return $mode;
389}
390
391
# spent 122µs (51+72) within Archive::Zip::Member::unixFileAttributes which was called 11 times, avg 11µs/call: # 11 times (51µs+72µs) by Archive::Zip::Member::new at line 137, avg 11µs/call
sub unixFileAttributes {
392111µs my $self = shift;
393118µs1141µs my $oldPerms = $self->_mapPermissionsToUnix;
# spent 41µs making 11 calls to Archive::Zip::Member::_mapPermissionsToUnix, avg 4µs/call
394
39511800ns my $perms;
396113µs if (@_) {
397112µs $perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0];
398
399117µs1122µs if ($self->isDirectory) {
# spent 22µs making 11 calls to Archive::Zip::ZipFileMember::isDirectory, avg 2µs/call
400 $perms &= ~FILE_ATTRIB;
401 $perms |= DIRECTORY_ATTRIB;
402 } else {
403111µs $perms &= ~DIRECTORY_ATTRIB;
404112µs $perms |= FILE_ATTRIB;
405 }
406 $self->{externalFileAttributes} =
407119µs119µs $self->_mapPermissionsFromUnix($perms);
# spent 9µs making 11 calls to Archive::Zip::Member::_mapPermissionsFromUnix, avg 800ns/call
408 }
409
410118µs return $oldPerms;
411}
412
413
# spent 10µs within Archive::Zip::Member::localExtraField which was called 11 times, avg 873ns/call: # 11 times (10µs+0s) by Archive::Zip::Member::_mapPermissionsToUnix at line 350, avg 873ns/call
sub localExtraField {
414111µs my $self = shift;
415
416112µs if (@_) {
417 my $localExtraField =
418 (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0];
419 my ($status, $zip64) =
420 $self->_extractZip64ExtraField($localExtraField, undef, undef);
421 if ($status != AZ_OK) {
422 return $status;
423 }
424 elsif ($zip64) {
425 return _formatError('invalid extra field (contains zip64 information)');
426 }
427 else {
428 $self->{localExtraField} = $localExtraField;
429 return AZ_OK;
430 }
431 } else {
4321112µs return $self->{localExtraField};
433 }
434}
435
436sub cdExtraField {
437 my $self = shift;
438
439 if (@_) {
440 my $cdExtraField =
441 (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0];
442 my ($status, $zip64) =
443 $self->_extractZip64ExtraField($cdExtraField, undef, undef);
444 if ($status != AZ_OK) {
445 return $status;
446 }
447 elsif ($zip64) {
448 return _formatError('invalid extra field (contains zip64 information)');
449 }
450 else {
451 $self->{cdExtraField} = $cdExtraField;
452 return AZ_OK;
453 }
454 } else {
455 return $self->{cdExtraField};
456 }
457}
458
459sub extraFields {
460 my $self = shift;
461 return $self->localExtraField() . $self->cdExtraField();
462}
463
464sub fileComment {
465 my $self = shift;
466
467 if (@_) {
468 $self->{fileComment} =
469 (ref($_[0]) eq 'HASH')
470 ? pack('C0a*', $_[0]->{comment})
471 : pack('C0a*', $_[0]);
472 } else {
473 return $self->{fileComment};
474 }
475}
476
477sub hasDataDescriptor {
478 my $self = shift;
479 if (@_) {
480 my $shouldHave = shift;
481 if ($shouldHave) {
482 $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK;
483 } else {
484 $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
485 }
486 }
487 return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK;
488}
489
490sub crc32 {
491 shift->{'crc32'};
492}
493
494sub crc32String {
495 sprintf("%08x", shift->{'crc32'});
496}
497
498
# spent 4µs within Archive::Zip::Member::compressedSize which was called 7 times, avg 514ns/call: # 7 times (4µs+0s) by Archive::Zip::Member::rewindData at line 1243, avg 514ns/call
sub compressedSize {
49976µs shift->{'compressedSize'};
500}
501
502
# spent 9µs within Archive::Zip::Member::uncompressedSize which was called 21 times, avg 433ns/call: # 7 times (4µs+0s) by Archive::Zip::Member::desiredCompressionMethod at line 222, avg 629ns/call # 7 times (3µs+0s) by Archive::Zip::Member::contents at line 1301, avg 429ns/call # 7 times (2µs+0s) by Archive::Zip::Member::rewindData at line 1204, avg 243ns/call
sub uncompressedSize {
5032124µs shift->{'uncompressedSize'};
504}
505
506
# spent 5µs within Archive::Zip::Member::isEncrypted which was called 7 times, avg 686ns/call: # 7 times (5µs+0s) by Archive::Zip::Member::readChunk at line 1121, avg 686ns/call
sub isEncrypted {
50777µs shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK;
508}
509
510sub isTextFile {
511 my $self = shift;
512 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
513 if (@_) {
514 my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift;
515 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
516 $self->{'internalFileAttributes'} |=
517 ($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE);
518 }
519 return $bit == IFA_TEXT_FILE;
520}
521
522sub isBinaryFile {
523 my $self = shift;
524 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
525 if (@_) {
526 my $flag = shift;
527 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
528 $self->{'internalFileAttributes'} |=
529 ($flag ? IFA_BINARY_FILE : IFA_TEXT_FILE);
530 }
531 return $bit == IFA_BINARY_FILE;
532}
533
534sub extractToFileNamed {
535 my $self = shift;
536
537 # local FS name
538 my $name = (ref($_[0]) eq 'HASH') ? $_[0]->{name} : $_[0];
539
540 # Create directory for regular files as well as for symbolic
541 # links
542 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
543 $name = decode_utf8(Win32::GetFullPathName($name));
544 mkpath_win32($name);
545 } else {
546 mkpath(dirname($name)); # croaks on error
547 }
548
549 # Check if the file / directory is a symbolic link *and* if
550 # the operating system supports these. Only in that case
551 # call method extractToFileHandle with the name of the
552 # symbolic link. If the operating system does not support
553 # symbolic links, process the member using the usual
554 # extraction routines, which creates a file containing the
555 # link target.
556 if ($self->isSymbolicLink() && OS_SUPPORTS_SYMLINK) {
557 return $self->extractToFileHandle($name);
558 } else {
559 my ($status, $fh);
560 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
561 Win32::CreateFile($name);
562 ($status, $fh) = _newFileHandle(Win32::GetANSIPathName($name), 'w');
563 } else {
564 ($status, $fh) = _newFileHandle($name, 'w');
565 }
566 return _ioError("Can't open file $name for write") unless $status;
567 $status = $self->extractToFileHandle($fh);
568 $fh->close();
569 chmod($self->unixFileAttributes(), $name)
570 or return _error("Can't chmod() ${name}: $!");
571 utime($self->lastModTime(), $self->lastModTime(), $name);
572 return $status;
573 }
574}
575
576sub mkpath_win32 {
577 my $path = shift;
57822.02ms211µs
# spent 11µs (10+400ns) within Archive::Zip::Member::BEGIN@578 which was called: # once (10µs+400ns) by Spreadsheet::ParseXLSX::BEGIN@11 at line 578
use File::Spec;
# spent 11µs making 1 call to Archive::Zip::Member::BEGIN@578 # spent 400ns making 1 call to Archive::Zip::Member::__ANON__
579
580 my ($volume, @path) = File::Spec->splitdir($path);
581 $path = File::Spec->catfile($volume, shift @path);
582 pop @path;
583 while (@path) {
584 $path = File::Spec->catfile($path, shift @path);
585 Win32::CreateDirectory($path);
586 }
587}
588
589sub isSymbolicLink {
590 return shift->{'externalFileAttributes'} == 0xA1FF0000;
591}
592
593sub isDirectory {
594 return 0;
595}
596
597sub externalFileName {
598 return undef;
599}
600
601# Search the given extra field string for a zip64 extended
602# information extra field and "correct" the header fields given
603# in the remaining parameters with the information from that
604# extra field, if required. Writes back the extra field string
605# sans the zip64 information. The extra field string and all
606# header fields must be passed as lvalues or the undefined value.
607#
608# This method returns a pair ($status, $zip64) in list context,
609# where the latter flag specifies whether a zip64 extended
610# information extra field was found.
611#
612# This method must be called with two header fields for local
613# file headers and with four header fields for Central Directory
614# headers.
615sub _extractZip64ExtraField
616{
617 my $classOrSelf = shift;
618
619 my $extraField = $_[0];
620
621 my ($zip64Data, $newExtraField) = (undef, '');
622 while (length($extraField) >= 4) {
623 my ($headerId, $dataSize) = unpack('v v', $extraField);
624 if (length($extraField) < 4 + $dataSize) {
625 return _formatError('invalid extra field (bad data)');
626 }
627 elsif ($headerId != 0x0001) {
628 $newExtraField .= substr($extraField, 0, 4 + $dataSize);
629 $extraField = substr($extraField, 4 + $dataSize);
630 }
631 else {
632 $zip64Data = substr($extraField, 4, $dataSize);
633 $extraField = substr($extraField, 4 + $dataSize);
634 }
635 }
636 if (length($extraField) != 0) {
637 return _formatError('invalid extra field (bad header ID or data size)');
638 }
639
640 my $zip64 = 0;
641 if (defined($zip64Data)) {
642 return _zip64NotSupported() unless ZIP64_SUPPORTED;
643
644 my $dataLength = length($zip64Data);
645
646 # Try to be tolerant with respect to the fields to be
647 # extracted from the zip64 extended information extra
648 # field and derive that information from the data itself,
649 # if possible. This works around, for example, incorrect
650 # extra fields written by certain versions of package
651 # IO::Compress::Zip. That package provides the disk
652 # number start in the extra field without setting the
653 # corresponding regular field to 0xffff. Plus it
654 # provides the full set of fields even for the local file
655 # header.
656 #
657 # Field zero is the extra field string which we must keep
658 # in @_ for future modification, so account for that.
659 my @fields;
660 if (@_ == 3 && $dataLength == 16) {
661 @fields = (undef, 0xffffffff, 0xffffffff);
662 }
663 elsif (@_ == 3 && $dataLength == 24) {
664 push(@_, undef);
665 @fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff);
666 }
667 elsif (@_ == 3 && $dataLength == 28) {
668 push(@_, undef, undef);
669 @fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff, 0xffff);
670 }
671 elsif (@_ == 5 && $dataLength == 24) {
672 @fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff);
673 }
674 elsif (@_ == 5 && $dataLength == 28) {
675 @fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff, 0xffff);
676 }
677 else {
678 @fields = map { defined $_ ? $_ : 0 } @_;
679 }
680
681 my @fieldIndexes = (0);
682 my $fieldFormat = '';
683 my $expDataLength = 0;
684 if ($fields[1] == 0xffffffff) {
685 push(@fieldIndexes, 1);
686 $fieldFormat .= 'Q< ';
687 $expDataLength += 8;
688 }
689 if ($fields[2] == 0xffffffff) {
690 push(@fieldIndexes, 2);
691 $fieldFormat .= 'Q< ';
692 $expDataLength += 8;
693 }
694 if (@fields > 3 && $fields[3] == 0xffffffff) {
695 push(@fieldIndexes, 3);
696 $fieldFormat .= 'Q< ';
697 $expDataLength += 8;
698 }
699 if (@fields > 3 && $fields[4] == 0xffff) {
700 push(@fieldIndexes, 4);
701 $fieldFormat .= 'L< ';
702 $expDataLength += 4;
703 }
704
705 if ($dataLength == $expDataLength) {
706 @_[@fieldIndexes] = ($newExtraField, unpack($fieldFormat, $zip64Data));
707 $zip64 = 1;
708 }
709 else {
710 return _formatError('invalid zip64 extended information extra field');
711 }
712 }
713
714 return (AZ_OK, $zip64);
715}
716
717# The following are used when copying data
718sub _writeOffset {
719 shift->{'writeOffset'};
720}
721
722sub _readOffset {
723 shift->{'readOffset'};
724}
725
726sub writeLocalHeaderRelativeOffset {
727 shift->{'writeLocalHeaderRelativeOffset'};
728}
729
730# Maintained in method Archive::Zip::Archive::writeToFileHandle
731sub wasWritten {
732 shift->{'wasWritten'}
733}
734
735
# spent 7µs within Archive::Zip::Member::_dataEnded which was called 14 times, avg 493ns/call: # 14 times (7µs+0s) by Archive::Zip::Member::readIsDone at line 1264, avg 493ns/call
sub _dataEnded {
7361414µs shift->{'dataEnded'};
737}
738
739
# spent 6µs within Archive::Zip::Member::_readDataRemaining which was called 21 times, avg 305ns/call: # 7 times (4µs+0s) by Archive::Zip::Member::contents at line 1298, avg 543ns/call # 7 times (1µs+0s) by Archive::Zip::Member::readIsDone at line 1264, avg 186ns/call # 7 times (1µs+0s) by Archive::Zip::Member::readChunk at line 1113, avg 186ns/call
sub _readDataRemaining {
7402115µs shift->{'readDataRemaining'};
741}
742
743
# spent 3µs within Archive::Zip::Member::_inflater which was called 7 times, avg 457ns/call: # 7 times (3µs+0s) by Archive::Zip::Member::_inflateChunk at line 1183, avg 457ns/call
sub _inflater {
74476µs shift->{'inflater'};
745}
746
747sub _deflater {
748 shift->{'deflater'};
749}
750
751# DOS date/time format
752# 0-4 (5) Second divided by 2
753# 5-10 (6) Minute (0-59)
754# 11-15 (5) Hour (0-23 on a 24-hour clock)
755# 16-20 (5) Day of the month (1-31)
756# 21-24 (4) Month (1 = January, 2 = February, etc.)
757# 25-31 (7) Year offset from 1980 (add 1980 to get actual year)
758
759# Convert DOS date/time format to unix time_t format
760# NOT AN OBJECT METHOD!
761sub _dosToUnixTime {
762 my $dt = shift;
763 return time() unless defined($dt);
764
765 my $year = (($dt >> 25) & 0x7f) + 1980;
766 my $mon = (($dt >> 21) & 0x0f) - 1;
767 my $mday = (($dt >> 16) & 0x1f);
768
769 my $hour = (($dt >> 11) & 0x1f);
770 my $min = (($dt >> 5) & 0x3f);
771 my $sec = (($dt << 1) & 0x3e);
772
773 # catch errors
774 my $time_t =
775 eval { Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year); };
776 return time() if ($@);
777 return $time_t;
778}
779
780# Note, this is not exactly UTC 1980, it's 1980 + 12 hours and 1
781# minute so that nothing timezoney can muck us up.
7821200nsmy $safe_epoch = 31.686060;
783
784# convert a unix time to DOS date/time
785# NOT AN OBJECT METHOD!
786sub _unixToDosTime {
787 my $time_t = shift;
788 unless ($time_t) {
789 _error("Tried to add member with zero or undef value for time");
790 $time_t = $safe_epoch;
791 }
792 if ($time_t < $safe_epoch) {
793 _ioError("Unsupported date before 1980 encountered, moving to 1980");
794 $time_t = $safe_epoch;
795 }
796 my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time_t);
797 my $dt = 0;
798 $dt += ($sec >> 1);
799 $dt += ($min << 5);
800 $dt += ($hour << 11);
801 $dt += ($mday << 16);
802 $dt += (($mon + 1) << 21);
803 $dt += (($year - 80) << 25);
804 return $dt;
805}
806
807# Write my local header to a file handle.
808# Returns a pair (AZ_OK, $headerSize) on success.
809sub _writeLocalFileHeader {
810 my $self = shift;
811 my $fh = shift;
812 my $refresh = @_ ? shift : 0;
813
814 my $zip64 = $self->zip64();
815 my $hasDataDescriptor = $self->hasDataDescriptor();
816
817 my $versionNeededToExtract = $self->versionNeededToExtract();
818 my $crc32;
819 my $compressedSize;
820 my $uncompressedSize;
821 my $localExtraField = $self->localExtraField();
822
823 if (! $zip64) {
824 if ($refresh) {
825 $crc32 = $self->crc32();
826 $compressedSize = $self->_writeOffset();
827 $uncompressedSize = $self->uncompressedSize();
828
829 # Handle a brain-dead corner case gracefully.
830 # Otherwise we a) would always need to write zip64
831 # format or b) re-write the complete member data on
832 # refresh (which might not always be possible).
833 if ($compressedSize > 0xffffffff) {
834 return _formatError('compressed size too large for refresh');
835 }
836 }
837 elsif ($hasDataDescriptor) {
838 $crc32 = 0;
839 $compressedSize = 0;
840 $uncompressedSize = 0;
841 }
842 else {
843 $crc32 = $self->crc32();
844 $compressedSize = $self->_writeOffset();
845 $uncompressedSize = $self->uncompressedSize();
846 }
847 }
848 else {
849 return _zip64NotSupported() unless ZIP64_SUPPORTED;
850
851 $versionNeededToExtract = 45 if ($versionNeededToExtract < 45);
852
853 my $zip64CompressedSize;
854 my $zip64UncompressedSize;
855 if ($refresh) {
856 $crc32 = $self->crc32();
857 $compressedSize = 0xffffffff;
858 $uncompressedSize = 0xffffffff;
859 $zip64CompressedSize = $self->_writeOffset();
860 $zip64UncompressedSize = $self->uncompressedSize();
861 }
862 elsif ($hasDataDescriptor) {
863 $crc32 = 0;
864 $compressedSize = 0xffffffff;
865 $uncompressedSize = 0xffffffff;
866 $zip64CompressedSize = 0;
867 $zip64UncompressedSize = 0;
868 }
869 else {
870 $crc32 = $self->crc32();
871 $compressedSize = 0xffffffff;
872 $uncompressedSize = 0xffffffff;
873 $zip64CompressedSize = $self->_writeOffset();
874 $zip64UncompressedSize = $self->uncompressedSize();
875 }
876
877 $localExtraField .= pack('S< S< Q< Q<',
878 0x0001, 16,
879 $zip64UncompressedSize,
880 $zip64CompressedSize);
881 }
882
883 my $fileNameLength = length($self->fileNameAsBytes());
884 my $localFieldLength = length($localExtraField);
885
88611µs my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE);
# spent 1µs making 1 call to CORE::pack
887 $self->_print($fh, $signatureData)
888 or return _ioError("writing local header signature");
889
890 my $header =
891 pack(LOCAL_FILE_HEADER_FORMAT,
892 $versionNeededToExtract,
893 $self->{'bitFlag'},
894 $self->desiredCompressionMethod(),
895 $self->lastModFileDateTime(),
896 $crc32,
897 $compressedSize,
898 $uncompressedSize,
899 $fileNameLength,
900 $localFieldLength);
901 $self->_print($fh, $header)
902 or return _ioError("writing local header");
903
904 # Write these only if required
905 if (! $refresh || $zip64) {
906 if ($fileNameLength) {
907 $self->_print($fh, $self->fileNameAsBytes())
908 or return _ioError("writing local header filename");
909 }
910 if ($localFieldLength) {
911 $self->_print($fh, $localExtraField)
912 or return _ioError("writing local extra field");
913 }
914 }
915
916 return
917 (AZ_OK,
918 LOCAL_FILE_HEADER_LENGTH +
919 SIGNATURE_LENGTH +
920 $fileNameLength +
921 $localFieldLength);
922}
923
924# Re-writes the local file header with new crc32 and compressedSize fields.
925# To be called after writing the data stream.
926# Assumes that filename and extraField sizes didn't change since last written.
927sub _refreshLocalFileHeader {
928 my $self = shift;
929 my $fh = shift;
930
931 my $here = $fh->tell();
932 $fh->seek($self->writeLocalHeaderRelativeOffset(), IO::Seekable::SEEK_SET)
933 or return _ioError("seeking to rewrite local header");
934
935 my ($status, undef) = $self->_writeLocalFileHeader($fh, 1);
936 return $status if $status != AZ_OK;
937
938 $fh->seek($here, IO::Seekable::SEEK_SET)
939 or return _ioError("seeking after rewrite of local header");
940
941 return AZ_OK;
942}
943
944# Write central directory file header.
945# Returns a pair (AZ_OK, $headerSize) on success.
946sub _writeCentralDirectoryFileHeader {
947 my $self = shift;
948 my $fh = shift;
949 my $adz64m = shift; # $archiveDesiredZip64Mode
950
951 # (Re-)Determine whether to write zip64 format. Assume
952 # {'diskNumberStart'} is always zero.
953 my $zip64 = $adz64m == ZIP64_HEADERS
954 || $self->desiredZip64Mode() == ZIP64_HEADERS
955 || $self->_writeOffset() > 0xffffffff
956 || $self->uncompressedSize() > 0xffffffff
957 || $self->writeLocalHeaderRelativeOffset() > 0xffffffff;
958
959 $self->{'zip64'} ||= $zip64;
960
961 my $versionMadeBy = $self->versionMadeBy();
962 my $versionNeededToExtract = $self->versionNeededToExtract();
963 my $compressedSize = $self->_writeOffset();
964 my $uncompressedSize = $self->uncompressedSize();
965 my $localHeaderRelativeOffset = $self->writeLocalHeaderRelativeOffset();
966 my $cdExtraField = $self->cdExtraField();
967
968 if (!$zip64) {
969 # no-op
970 }
971 else {
972 return _zip64NotSupported() unless ZIP64_SUPPORTED;
973
974 $versionNeededToExtract = 45 if ($versionNeededToExtract < 45);
975
976 my $extraFieldFormat = '';
977 my @extraFieldValues = ();
978 my $extraFieldSize = 0;
979 if ($uncompressedSize > 0xffffffff) {
980 $extraFieldFormat .= 'Q< ';
981 push(@extraFieldValues, $uncompressedSize);
982 $extraFieldSize += 8;
983 $uncompressedSize = 0xffffffff;
984 }
985 if ($compressedSize > 0xffffffff) {
986 $extraFieldFormat .= 'Q< ';
987 push(@extraFieldValues, $compressedSize);
988 $extraFieldSize += 8;
989 $compressedSize = 0xffffffff;
990 }
991 # Avoid empty zip64 extended information extra fields
992 if ( $localHeaderRelativeOffset > 0xffffffff
993 || @extraFieldValues == 0) {
994 $extraFieldFormat .= 'Q< ';
995 push(@extraFieldValues, $localHeaderRelativeOffset);
996 $extraFieldSize += 8;
997 $localHeaderRelativeOffset = 0xffffffff;
998 }
999
1000 $cdExtraField .=
1001 pack("S< S< $extraFieldFormat",
1002 0x0001, $extraFieldSize,
1003 @extraFieldValues);
1004 }
1005
1006 my $fileNameLength = length($self->fileNameAsBytes());
1007 my $extraFieldLength = length($cdExtraField);
1008 my $fileCommentLength = length($self->fileComment());
1009
1010 my $sigData =
10111900ns pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE);
# spent 900ns making 1 call to CORE::pack
1012 $self->_print($fh, $sigData)
1013 or return _ioError("writing central directory header signature");
1014
1015 my $header = pack(
1016 CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
1017 $versionMadeBy,
1018 $self->fileAttributeFormat(),
1019 $versionNeededToExtract,
1020 $self->bitFlag(),
1021 $self->desiredCompressionMethod(),
1022 $self->lastModFileDateTime(),
1023 $self->crc32(), # these three fields should have been updated
1024 $compressedSize, # by writing the data stream out
1025 $uncompressedSize, #
1026 $fileNameLength,
1027 $extraFieldLength,
1028 $fileCommentLength,
1029 0, # {'diskNumberStart'},
1030 $self->internalFileAttributes(),
1031 $self->externalFileAttributes(),
1032 $localHeaderRelativeOffset);
1033
1034 $self->_print($fh, $header)
1035 or return _ioError("writing central directory header");
1036
1037 if ($fileNameLength) {
1038 $self->_print($fh, $self->fileNameAsBytes())
1039 or return _ioError("writing central directory header signature");
1040 }
1041 if ($extraFieldLength) {
1042 $self->_print($fh, $cdExtraField)
1043 or return _ioError("writing central directory extra field");
1044 }
1045 if ($fileCommentLength) {
1046 $self->_print($fh, $self->fileComment())
1047 or return _ioError("writing central directory file comment");
1048 }
1049
1050 # Update object members with information which might have
1051 # changed while writing this member. We already did the
1052 # zip64 flag. We must not update the extra fields with any
1053 # zip64 information, since we consider that internal.
1054 $self->{'versionNeededToExtract'} = $versionNeededToExtract;
1055 $self->{'compressedSize'} = $self->_writeOffset();
1056
1057 return
1058 (AZ_OK,
1059 CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
1060 SIGNATURE_LENGTH +
1061 $fileNameLength +
1062 $extraFieldLength +
1063 $fileCommentLength)
1064}
1065
1066# This writes a data descriptor to the given file handle.
1067# Assumes that crc32, writeOffset, and uncompressedSize are
1068# set correctly (they should be after a write).
1069# Returns a pair (AZ_OK, $dataDescriptorSize) on success.
1070# Further, the local file header should have the
1071# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
1072sub _writeDataDescriptor {
1073 my $self = shift;
1074 my $fh = shift;
1075
1076 my $descriptor;
1077 if (! $self->zip64()) {
1078 $descriptor =
1079 pack(SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT,
1080 DATA_DESCRIPTOR_SIGNATURE,
1081 $self->crc32(),
1082 $self->_writeOffset(), # compressed size
1083 $self->uncompressedSize());
1084 }
1085 else {
1086 return _zip64NotSupported() unless ZIP64_SUPPORTED;
1087
1088 $descriptor =
1089 pack(SIGNATURE_FORMAT . DATA_DESCRIPTOR_ZIP64_FORMAT,
1090 DATA_DESCRIPTOR_SIGNATURE,
1091 $self->crc32(),
1092 $self->_writeOffset(), # compressed size
1093 $self->uncompressedSize());
1094 }
1095
1096 $self->_print($fh, $descriptor)
1097 or return _ioError("writing data descriptor");
1098
1099 return (AZ_OK, length($descriptor));
1100}
1101
1102
# spent 13.0ms (90µs+13.0) within Archive::Zip::Member::readChunk which was called 7 times, avg 1.86ms/call: # 7 times (90µs+13.0ms) by Archive::Zip::Member::contents at line 1298, avg 1.86ms/call
sub readChunk {
110371µs my $self = shift;
110473µs my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0];
1105
110675µs724µs if ($self->readIsDone()) {
# spent 24µs making 7 calls to Archive::Zip::Member::readIsDone, avg 3µs/call
1107 $self->endRead();
1108 my $dummy = '';
1109 return (\$dummy, AZ_STREAM_END);
1110 }
1111
111272µs $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize);
111374µs71µs $chunkSize = $self->_readDataRemaining()
# spent 1µs making 7 calls to Archive::Zip::Member::_readDataRemaining, avg 186ns/call
1114 if $chunkSize > $self->_readDataRemaining();
1115
111671µs my $buffer = '';
11177400ns my $outputRef;
111877µs7591µs my ($bytesRead, $status) = $self->_readRawChunk(\$buffer, $chunkSize);
# spent 591µs making 7 calls to Archive::Zip::ZipFileMember::_readRawChunk, avg 84µs/call
111971µs return (\$buffer, $status) unless $status == AZ_OK;
1120
112177µs75µs $buffer && $self->isEncrypted and $buffer = $self->_decode($buffer);
# spent 5µs making 7 calls to Archive::Zip::Member::isEncrypted, avg 686ns/call
112272µs $self->{'readDataRemaining'} -= $bytesRead;
112372µs $self->{'readOffset'} += $bytesRead;
1124
112574µs72µs if ($self->compressionMethod() == COMPRESSION_STORED) {
# spent 2µs making 7 calls to Archive::Zip::Member::compressionMethod, avg 314ns/call
1126 $self->{'crc32'} = $self->computeCRC32($buffer, $self->{'crc32'});
1127 }
1128
112978µs712.3ms ($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer);
# spent 12.3ms making 7 calls to Archive::Zip::Member::_inflateChunk, avg 1.76ms/call
113075µs $self->{'writeOffset'} += length($$outputRef);
1131
113278µs1427µs $self->endRead()
# spent 14µs making 7 calls to Archive::Zip::FileMember::endRead, avg 2µs/call # spent 13µs making 7 calls to Archive::Zip::Member::readIsDone, avg 2µs/call
1133 if $self->readIsDone();
1134
113578µs return ($outputRef, $status);
1136}
1137
1138# Read the next raw chunk of my data. Subclasses MUST implement.
1139# my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
1140sub _readRawChunk {
1141 my $self = shift;
1142 return $self->_subclassResponsibility();
1143}
1144
1145# A place holder to catch rewindData errors if someone ignores
1146# the error code.
1147sub _noChunk {
1148 my $self = shift;
1149 return (\undef, _error("trying to copy chunk when init failed"));
1150}
1151
1152# Basically a no-op so that I can have a consistent interface.
1153# ( $outputRef, $status) = $self->_copyChunk( \$buffer );
1154sub _copyChunk {
1155 my ($self, $dataRef) = @_;
1156 return ($dataRef, AZ_OK);
1157}
1158
1159# ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
1160sub _deflateChunk {
1161 my ($self, $buffer) = @_;
1162 my ($status) = $self->_deflater()->deflate($buffer, my $out);
1163
1164 if ($self->_readDataRemaining() == 0) {
1165 my $extraOutput;
1166 ($status) = $self->_deflater()->flush($extraOutput);
1167 $out .= $extraOutput;
1168 $self->endRead();
1169 return (\$out, AZ_STREAM_END);
1170 } elsif ($status == Z_OK) {
1171 return (\$out, AZ_OK);
1172 } else {
1173 $self->endRead();
1174 my $retval = _error('deflate error', $status);
1175 my $dummy = '';
1176 return (\$dummy, $retval);
1177 }
1178}
1179
1180# ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
1181
# spent 12.3ms (78µs+12.2) within Archive::Zip::Member::_inflateChunk which was called 7 times, avg 1.76ms/call: # 7 times (78µs+12.2ms) by Archive::Zip::Member::readChunk at line 1129, avg 1.76ms/call
sub _inflateChunk {
118272µs my ($self, $buffer) = @_;
1183712.1ms1412.1ms my ($status) = $self->_inflater()->inflate($buffer, my $out);
# spent 12.1ms making 7 calls to Compress::Raw::Zlib::inflateStream::inflate, avg 1.73ms/call # spent 3µs making 7 calls to Archive::Zip::Member::_inflater, avg 457ns/call
11847600ns my $retval;
1185717µs14109µs $self->endRead() unless $status == Z_OK;
# spent 102µs making 7 calls to Archive::Zip::FileMember::endRead, avg 15µs/call # spent 8µs making 7 calls to Compress::Raw::Zlib::__ANON__[Compress/Raw/Zlib.pm:122], avg 1µs/call
1186712µs1416µs if ($status == Z_OK || $status == Z_STREAM_END) {
# spent 10µs making 1 call to Compress::Raw::Zlib::AUTOLOAD # spent 6µs making 13 calls to Compress::Raw::Zlib::__ANON__[Compress/Raw/Zlib.pm:122], avg 469ns/call
118774µs72µs $retval = ($status == Z_STREAM_END) ? AZ_STREAM_END : AZ_OK;
# spent 2µs making 7 calls to Compress::Raw::Zlib::__ANON__[Compress/Raw/Zlib.pm:122], avg 214ns/call
1188712µs return (\$out, $retval);
1189 } else {
1190 $retval = _error('inflate error', $status);
1191 my $dummy = '';
1192 return (\$dummy, $retval);
1193 }
1194}
1195
1196
# spent 912µs (136+775) within Archive::Zip::Member::rewindData which was called 7 times, avg 130µs/call: # 7 times (136µs+775µs) by Archive::Zip::ZipFileMember::rewindData at line 440 of Archive/Zip/ZipFileMember.pm, avg 130µs/call
sub rewindData {
11977500ns my $self = shift;
11987700ns my $status;
1199
1200 # set to trap init errors
1201718µs75µs $self->{'chunkHandler'} = $self->can('_noChunk');
# spent 5µs making 7 calls to UNIVERSAL::can, avg 771ns/call
1202
1203 # Work around WinZip bug with 0-length DEFLATED files
120474µs72µs $self->desiredCompressionMethod(COMPRESSION_STORED)
# spent 2µs making 7 calls to Archive::Zip::Member::uncompressedSize, avg 243ns/call
1205 if $self->uncompressedSize() == 0;
1206
1207 # assume that we're going to read the whole file, and compute the CRC anew.
120874µs73µs $self->{'crc32'} = 0
# spent 3µs making 7 calls to Archive::Zip::Member::compressionMethod, avg 371ns/call
1209 if ($self->compressionMethod() == COMPRESSION_STORED);
1210
1211 # These are the only combinations of methods we deal with right now.
1212710µs218µs if ( $self->compressionMethod() == COMPRESSION_STORED
# spent 6µs making 7 calls to Archive::Zip::Member::desiredCompressionMethod, avg 843ns/call # spent 2µs making 14 calls to Archive::Zip::Member::compressionMethod, avg 150ns/call
1213 and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED) {
1214 ($self->{'deflater'}, $status) = Compress::Raw::Zlib::Deflate->new(
1215 '-Level' => $self->desiredCompressionLevel(),
1216 '-WindowBits' => -MAX_WBITS(), # necessary magic
1217 '-Bufsize' => $Archive::Zip::ChunkSize,
1218 @_
1219 ); # pass additional options
1220 return _error('deflateInit error:', $status)
1221 unless $status == Z_OK;
1222 $self->{'chunkHandler'} = $self->can('_deflateChunk');
1223 } elsif ($self->compressionMethod() == COMPRESSION_DEFLATED
1224 and $self->desiredCompressionMethod() == COMPRESSION_STORED) {
1225729µs14728µs ($self->{'inflater'}, $status) = Compress::Raw::Zlib::Inflate->new(
# spent 722µs making 7 calls to Compress::Raw::Zlib::Inflate::new, avg 103µs/call # spent 6µs making 7 calls to Compress::Raw::Zlib::__ANON__[Compress/Raw/Zlib.pm:122], avg 829ns/call
1226 '-WindowBits' => -MAX_WBITS(), # necessary magic
1227 '-Bufsize' => $Archive::Zip::ChunkSize,
1228 @_
1229 ); # pass additional options
123079µs717µs return _error('inflateInit error:', $status)
# spent 13µs making 1 call to Compress::Raw::Zlib::AUTOLOAD # spent 4µs making 6 calls to Compress::Raw::Zlib::__ANON__[Compress/Raw/Zlib.pm:122], avg 733ns/call
1231 unless $status == Z_OK;
1232715µs75µs $self->{'chunkHandler'} = $self->can('_inflateChunk');
# spent 5µs making 7 calls to UNIVERSAL::can, avg 743ns/call
1233 } elsif ($self->compressionMethod() == $self->desiredCompressionMethod()) {
1234 $self->{'chunkHandler'} = $self->can('_copyChunk');
1235 } else {
1236 return _error(
1237 sprintf(
1238 "Unsupported compression combination: read %d, write %d",
1239 $self->compressionMethod(),
1240 $self->desiredCompressionMethod()));
1241 }
1242
1243712µs147µs $self->{'readDataRemaining'} =
# spent 4µs making 7 calls to Archive::Zip::Member::compressedSize, avg 514ns/call # spent 3µs making 7 calls to Archive::Zip::Member::compressionMethod, avg 457ns/call
1244 ($self->compressionMethod() == COMPRESSION_STORED)
1245 ? $self->uncompressedSize()
1246 : $self->compressedSize();
124772µs $self->{'dataEnded'} = 0;
124872µs $self->{'readOffset'} = 0;
1249
125078µs return AZ_OK;
1251}
1252
1253
# spent 72µs (47+25) within Archive::Zip::Member::endRead which was called 31 times, avg 2µs/call: # 31 times (47µs+25µs) by Archive::Zip::FileMember::endRead at line 52 of Archive/Zip/FileMember.pm, avg 2µs/call
sub endRead {
1254312µs my $self = shift;
12553146µs725µs delete $self->{'inflater'};
# spent 25µs making 7 calls to Compress::Raw::Zlib::inflateStream::DESTROY, avg 4µs/call
1256314µs delete $self->{'deflater'};
1257316µs $self->{'dataEnded'} = 1;
1258315µs $self->{'readDataRemaining'} = 0;
12593122µs return AZ_OK;
1260}
1261
1262
# spent 37µs (29+8) within Archive::Zip::Member::readIsDone which was called 14 times, avg 3µs/call: # 7 times (20µs+5µs) by Archive::Zip::Member::readChunk at line 1106, avg 3µs/call # 7 times (9µs+3µs) by Archive::Zip::Member::readChunk at line 1132, avg 2µs/call
sub readIsDone {
1263142µs my $self = shift;
12641425µs218µs return ($self->_dataEnded() or !$self->_readDataRemaining());
# spent 7µs making 14 calls to Archive::Zip::Member::_dataEnded, avg 493ns/call # spent 1µs making 7 calls to Archive::Zip::Member::_readDataRemaining, avg 186ns/call
1265}
1266
1267
# spent 19.1ms (4.16+15.0) within Archive::Zip::Member::contents which was called 7 times, avg 2.73ms/call: # 7 times (4.16ms+15.0ms) by Spreadsheet::ParseXLSX::_zip_file_member at line 1045 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 2.73ms/call
sub contents {
12687800ns my $self = shift;
12697900ns my $newContents = shift;
1270
127172µs if (defined($newContents)) {
1272
1273 # Change our type and ensure that succeeded to avoid
1274 # endless recursion
1275 $self->_become('Archive::Zip::StringMember');
1276 $self->_ISA('Archive::Zip::StringMember') or
1277 return
1278 wantarray
1279 ? (undef, $self->_error('becoming Archive::Zip::StringMember'))
1280 : undef;
1281
1282 # Now call the subclass contents method
1283 my $retval =
1284 $self->contents(pack('C0a*', $newContents)); # in case of Unicode
1285
1286 return wantarray ? ($retval, AZ_OK) : $retval;
1287 } else {
128875µs730µs my $oldCompression =
# spent 30µs making 7 calls to Archive::Zip::Member::desiredCompressionMethod, avg 4µs/call
1289 $self->desiredCompressionMethod(COMPRESSION_STORED);
129077µs71.85ms my $status = $self->rewindData(@_);
# spent 1.85ms making 7 calls to Archive::Zip::ZipFileMember::rewindData, avg 264µs/call
129172µs if ($status != AZ_OK) {
1292 $self->endRead();
1293 return wantarray ? (undef, $status) : undef;
1294 }
129572µs my $retval = '';
129673µs while ($status == AZ_OK) {
12977500ns my $ref;
1298713µs1413.1ms ($ref, $status) = $self->readChunk($self->_readDataRemaining());
# spent 13.0ms making 7 calls to Archive::Zip::Member::readChunk, avg 1.86ms/call # spent 4µs making 7 calls to Archive::Zip::Member::_readDataRemaining, avg 543ns/call
1299
1300 # did we get it in one chunk?
130174.09ms73µs if (length($$ref) == $self->uncompressedSize()) {
# spent 3µs making 7 calls to Archive::Zip::Member::uncompressedSize, avg 429ns/call
1302 $retval = $$ref;
1303 } else {
1304 $retval .= $$ref
1305 }
1306 }
130776µs715µs $self->desiredCompressionMethod($oldCompression);
# spent 15µs making 7 calls to Archive::Zip::Member::desiredCompressionMethod, avg 2µs/call
130873µs714µs $self->endRead();
# spent 14µs making 7 calls to Archive::Zip::FileMember::endRead, avg 2µs/call
130972µs $status = AZ_OK if $status == AZ_STREAM_END;
13107800ns $retval = undef unless $status == AZ_OK;
1311711µs return wantarray ? ($retval, $status) : $retval;
1312 }
1313}
1314
1315sub extractToFileHandle {
1316 my $self = shift;
1317 # This can be the link name when "extracting" symbolic links
1318 my $fhOrName = (ref($_[0]) eq 'HASH') ? shift->{fileHandle} : shift;
1319 _binmode($fhOrName) if ref($fhOrName);
1320 my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED);
1321 my $status = $self->rewindData(@_);
1322 $status = $self->_writeData($fhOrName) if $status == AZ_OK;
1323 $self->desiredCompressionMethod($oldCompression);
1324 $self->endRead();
1325 return $status;
1326}
1327
1328# write local header and data stream to file handle.
1329# Returns a pair ($status, $memberSize) if successful.
1330# Stores the offset to the start of the header in my
1331# writeLocalHeaderRelativeOffset member.
1332sub _writeToFileHandle {
1333 my $self = shift;
1334 my $fh = shift;
1335 my $fhIsSeekable = shift;
1336 my $offset = shift;
1337 my $adz64m = shift; # $archiveDesiredZip64Mode
1338
1339 return _error("no member name given for $self")
1340 if $self->fileName() eq '';
1341
1342 $self->{'writeLocalHeaderRelativeOffset'} = $offset;
1343
1344 # Determine if I need to refresh the header in a second pass
1345 # later. If in doubt, I'd rather refresh, since it does not
1346 # seem to be worth the hassle to save the extra seeks and
1347 # writes. In addition, having below condition independent of
1348 # any specific compression methods helps me piping through
1349 # members with unknown compression methods unchanged. See
1350 # test t/26_bzip2.t for details.
1351 my $headerFieldsUnknown = $self->uncompressedSize() > 0;
1352
1353 # Determine if I need to write a data descriptor
1354 # I need to do this if I can't refresh the header
1355 # and I don't know compressed size or crc32 fields.
1356 my $shouldWriteDataDescriptor =
1357 ($headerFieldsUnknown and not $fhIsSeekable);
1358
1359 $self->hasDataDescriptor(1)
1360 if ($shouldWriteDataDescriptor);
1361
1362 # Determine whether to write zip64 format
1363 my $zip64 = $adz64m == ZIP64_HEADERS
1364 || $self->desiredZip64Mode() == ZIP64_HEADERS
1365 || $self->uncompressedSize() > 0xffffffff;
1366
1367 $self->{'zip64'} ||= $zip64;
1368
1369 $self->{'writeOffset'} = 0;
1370
1371 my $status = $self->rewindData();
1372 return $status if $status != AZ_OK;
1373
1374 my $memberSize;
1375 ($status, $memberSize) = $self->_writeLocalFileHeader($fh);
1376 return $status if $status != AZ_OK;
1377
1378 $status = $self->_writeData($fh);
1379 return $status if $status != AZ_OK;
1380 $memberSize += $self->_writeOffset();
1381
1382 if ($self->hasDataDescriptor()) {
1383 my $ddSize;
1384 ($status, $ddSize) = $self->_writeDataDescriptor($fh);
1385 $memberSize += $ddSize;
1386 } elsif ($headerFieldsUnknown) {
1387 $status = $self->_refreshLocalFileHeader($fh);
1388 }
1389 return $status if $status != AZ_OK;
1390
1391 return ($status, $memberSize);
1392}
1393
1394# Copy my (possibly compressed) data to given file handle.
1395# Returns C<AZ_OK> on success
1396sub _writeData {
1397 my $self = shift;
1398 my $fhOrName = shift;
1399
1400 if ($self->isSymbolicLink() && OS_SUPPORTS_SYMLINK) {
1401 my $chunkSize = $Archive::Zip::ChunkSize;
1402 my ($outRef, $status) = $self->readChunk($chunkSize);
1403 symlink($$outRef, $fhOrName)
1404 or return _ioError("creating symbolic link");
1405 } else {
1406 return AZ_OK if ($self->uncompressedSize() == 0);
1407 my $status;
1408 my $chunkSize = $Archive::Zip::ChunkSize;
1409 while ($self->_readDataRemaining() > 0) {
1410 my $outRef;
1411 ($outRef, $status) = $self->readChunk($chunkSize);
1412 return $status if ($status != AZ_OK and $status != AZ_STREAM_END);
1413
1414 if (length($$outRef) > 0) {
1415 $self->_print($fhOrName, $$outRef)
1416 or return _ioError("write error during copy");
1417 }
1418
1419 last if $status == AZ_STREAM_END;
1420 }
1421 }
1422 return AZ_OK;
1423}
1424
1425# Return true if I depend on the named file
1426sub _usesFileNamed {
1427 return 0;
1428}
1429
1430# ##############################################################################
1431#
1432# Decrypt section
1433#
1434# H.Merijn Brand (Tux) 2011-06-28
1435#
1436# ##############################################################################
1437
1438# This code is derived from the crypt source of unzip-6.0 dated 05 Jan 2007
1439# Its license states:
1440#
1441# --8<---
1442# Copyright (c) 1990-2007 Info-ZIP. All rights reserved.
1443
1444# See the accompanying file LICENSE, version 2005-Feb-10 or later
1445# (the contents of which are also included in (un)zip.h) for terms of use.
1446# If, for some reason, all these files are missing, the Info-ZIP license
1447# also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html
1448#
1449# crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h]
1450
1451# The main encryption/decryption source code for Info-Zip software was
1452# originally written in Europe. To the best of our knowledge, it can
1453# be freely distributed in both source and object forms from any country,
1454# including the USA under License Exception TSU of the U.S. Export
1455# Administration Regulations (section 740.13(e)) of 6 June 2002.
1456
1457# NOTE on copyright history:
1458# Previous versions of this source package (up to version 2.8) were
1459# not copyrighted and put in the public domain. If you cannot comply
1460# with the Info-Zip LICENSE, you may want to look for one of those
1461# public domain versions.
1462#
1463# This encryption code is a direct transcription of the algorithm from
1464# Roger Schlafly, described by Phil Katz in the file appnote.txt. This
1465# file (appnote.txt) is distributed with the PKZIP program (even in the
1466# version without encryption capabilities).
1467# -->8---
1468
1469# As of January 2000, US export regulations were amended to allow export
1470# of free encryption source code from the US. As of June 2002, these
1471# regulations were further relaxed to allow export of encryption binaries
1472# associated with free encryption source code. The Zip 2.31, UnZip 5.52
1473# and Wiz 5.02 archives now include full crypto source code. As of the
1474# Zip 2.31 release, all official binaries include encryption support; the
1475# former "zcr" archives ceased to exist.
1476# (Note that restrictions may still exist in other countries, of course.)
1477
1478# For now, we just support the decrypt stuff
1479# All below methods are supposed to be private
1480
1481# use Data::Peek;
1482
14831200nsmy @keys;
148417µsmy @crct = do {
14851100ns my $xor = 0xedb88320;
1486113µs my @crc = (0) x 1024;
1487
1488 # generate a crc for every 8-bit value
14891900ns foreach my $n (0 .. 255) {
149025615µs my $c = $n;
1491256274µs $c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8;
149225698µs25680µs $crc[$n] = _revbe($c);
# spent 80µs making 256 calls to Archive::Zip::Member::_revbe, avg 314ns/call
1493 }
1494
1495 # generate crc for each value followed by one, two, and three zeros */
14961500ns foreach my $n (0 .. 255) {
149725638µs my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff;
1498256144µs $crc[$_ * 256 + $n] = $c for 1 .. 3;
1499 }
15001311µs1024318µs map { _revbe($crc[$_]) } 0 .. 1023;
# spent 318µs making 1024 calls to Archive::Zip::Member::_revbe, avg 310ns/call
1501};
1502
1503sub _crc32 {
1504 my ($c, $b) = @_;
1505 return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8));
1506} # _crc32
1507
1508
# spent 398µs within Archive::Zip::Member::_revbe which was called 1280 times, avg 311ns/call: # 1024 times (318µs+0s) by Spreadsheet::ParseXLSX::BEGIN@11 at line 1500, avg 310ns/call # 256 times (80µs+0s) by Spreadsheet::ParseXLSX::BEGIN@11 at line 1492, avg 314ns/call
sub _revbe {
1509128086µs my $w = shift;
15101280833µs return (($w >> 24) +
1511 (($w >> 8) & 0xff00) +
1512 (($w & 0xff00) << 8) +
1513 (($w & 0xff) << 24));
1514} # _revbe
1515
1516sub _update_keys {
15172305µs2121µs
# spent 119µs (117+2) within Archive::Zip::Member::BEGIN@1517 which was called: # once (117µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@11 at line 1517
use integer;
# spent 119µs making 1 call to Archive::Zip::Member::BEGIN@1517 # spent 2µs making 1 call to integer::import
1518 my $c = shift; # signed int
1519 $keys[0] = _crc32($keys[0], $c);
1520 $keys[1] = (($keys[1] + ($keys[0] & 0xff)) * 0x08088405 + 1) & 0xffffffff;
1521 my $keyshift = $keys[1] >> 24;
1522 $keys[2] = _crc32($keys[2], $keyshift);
1523} # _update_keys
1524
1525sub _zdecode ($) {
1526 my $c = shift;
1527 my $t = ($keys[2] & 0xffff) | 2;
1528 _update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff));
1529 return $c;
1530} # _zdecode
1531
1532sub _decode {
1533 my $self = shift;
1534 my $buff = shift;
1535
1536 $self->isEncrypted or return $buff;
1537
1538 my $pass = $self->password;
1539 defined $pass or return "";
1540
1541 @keys = (0x12345678, 0x23456789, 0x34567890);
1542 _update_keys($_) for unpack "C*", $pass;
1543
1544 # DDumper { uk => [ @keys ] };
1545
1546 my $head = substr $buff, 0, 12, "";
1547 my @head = map { _zdecode($_) } unpack "C*", $head;
1548 my $x =
1549 $self->{externalFileAttributes}
1550 ? ($self->{lastModFileDateTime} >> 8) & 0xff
1551 : $self->{crc32} >> 24;
1552 $head[-1] == $x or return ""; # Password fail
1553
1554 # Worth checking ...
1555 $self->{crc32c} = (unpack LOCAL_FILE_HEADER_FORMAT, pack "C*", @head)[3];
1556
1557 # DHexDump ($buff);
1558 $buff = pack "C*" => map { _zdecode($_) } unpack "C*" => $buff;
1559
1560 # DHexDump ($buff);
1561 return $buff;
1562} # _decode
1563
1564113µs1;
 
# spent 3µs within Archive::Zip::Member::DEFAULT_FILE_PERMISSIONS which was called 11 times, avg 236ns/call: # 11 times (3µs+0s) by Archive::Zip::Member::new at line 137, avg 236ns/call
sub Archive::Zip::Member::DEFAULT_FILE_PERMISSIONS; # xsub
# spent 400ns within Archive::Zip::Member::__ANON__ which was called: # once (400ns+0s) by Archive::Zip::Member::BEGIN@578 at line 578
sub Archive::Zip::Member::__ANON__; # xsub