Profile of Archive/Zip/Member.pm

← 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
Statements | Executed 5597 statements in 22.9ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
7 | 1 | 1 | 4.16ms | 19.1ms | Archive::Zip::Member::::contentsArchive::Zip::Member::contents
1 | 1 | 1 | 838µs | 942µs | Archive::Zip::Member::::BEGIN@27Archive::Zip::Member::BEGIN@27
1280 | 2 | 1 | 398µs | 398µs | Archive::Zip::Member::::_revbeArchive::Zip::Member::_revbe
7 | 1 | 1 | 136µs | 912µs | Archive::Zip::Member::::rewindDataArchive::Zip::Member::rewindData
1 | 1 | 1 | 117µs | 119µs | Archive::Zip::Member::::BEGIN@1517Archive::Zip::Member::BEGIN@1517
7 | 1 | 1 | 90µs | 13.0ms | Archive::Zip::Member::::readChunkArchive::Zip::Member::readChunk
11 | 1 | 1 | 85µs | 210µs | Archive::Zip::Member::::newArchive::Zip::Member::new
7 | 1 | 1 | 78µs | 12.3ms | Archive::Zip::Member::::_inflateChunkArchive::Zip::Member::_inflateChunk
31 | 4 | 2 | 71µs | 75µs | Archive::Zip::Member::::desiredCompressionMethodArchive::Zip::Member::desiredCompressionMethod
101 | 3 | 2 | 57µs | 57µs | Archive::Zip::Member::::fileNameArchive::Zip::Member::fileName
11 | 1 | 1 | 51µs | 122µs | Archive::Zip::Member::::unixFileAttributesArchive::Zip::Member::unixFileAttributes
31 | 1 | 1 | 47µs | 72µs | Archive::Zip::Member::::endReadArchive::Zip::Member::endRead
11 | 1 | 1 | 31µs | 41µs | Archive::Zip::Member::::_mapPermissionsToUnixArchive::Zip::Member::_mapPermissionsToUnix
14 | 2 | 1 | 29µs | 37µs | Archive::Zip::Member::::readIsDoneArchive::Zip::Member::readIsDone
11 | 1 | 1 | 19µs | 266µs | Archive::Zip::Member::::_newFromZipFileArchive::Zip::Member::_newFromZipFile
45 | 5 | 2 | 15µs | 15µs | Archive::Zip::Member::::compressionMethodArchive::Zip::Member::compressionMethod
1 | 1 | 1 | 10µs | 11µs | Archive::Zip::Member::::BEGIN@578Archive::Zip::Member::BEGIN@578
1 | 1 | 1 | 10µs | 11µs | Archive::Zip::Member::::BEGIN@5Archive::Zip::Member::BEGIN@5
11 | 1 | 1 | 10µs | 10µs | Archive::Zip::Member::::localExtraFieldArchive::Zip::Member::localExtraField
21 | 3 | 1 | 9µs | 9µs | Archive::Zip::Member::::uncompressedSizeArchive::Zip::Member::uncompressedSize
11 | 1 | 1 | 9µs | 9µs | Archive::Zip::Member::::_mapPermissionsFromUnixArchive::Zip::Member::_mapPermissionsFromUnix
1 | 1 | 1 | 8µs | 8µs | Archive::Zip::Member::::BEGIN@8Archive::Zip::Member::BEGIN@8
1 | 1 | 1 | 7µs | 26µs | Archive::Zip::Member::::BEGIN@37Archive::Zip::Member::BEGIN@37
14 | 1 | 1 | 7µs | 7µs | Archive::Zip::Member::::_dataEndedArchive::Zip::Member::_dataEnded
1 | 1 | 1 | 7µs | 70µs | Archive::Zip::Member::::BEGIN@28Archive::Zip::Member::BEGIN@28
21 | 3 | 1 | 6µs | 6µs | Archive::Zip::Member::::_readDataRemainingArchive::Zip::Member::_readDataRemaining
7 | 1 | 1 | 5µs | 5µs | Archive::Zip::Member::::isEncryptedArchive::Zip::Member::isEncrypted
1 | 1 | 1 | 4µs | 18µs | Archive::Zip::Member::::BEGIN@29Archive::Zip::Member::BEGIN@29
1 | 1 | 1 | 4µs | 19µs | Archive::Zip::Member::::BEGIN@30Archive::Zip::Member::BEGIN@30
1 | 1 | 1 | 4µs | 240µs | Archive::Zip::Member::::BEGIN@19Archive::Zip::Member::BEGIN@19
7 | 1 | 1 | 4µs | 4µs | Archive::Zip::Member::::compressedSizeArchive::Zip::Member::compressedSize
1 | 1 | 1 | 3µs | 24µs | Archive::Zip::Member::::BEGIN@33Archive::Zip::Member::BEGIN@33
1 | 1 | 1 | 3µs | 21µs | Archive::Zip::Member::::BEGIN@6Archive::Zip::Member::BEGIN@6
7 | 1 | 1 | 3µs | 3µs | Archive::Zip::Member::::_inflaterArchive::Zip::Member::_inflater
11 | 1 | 1 | 3µs | 3µs | Archive::Zip::Member::::DEFAULT_FILE_PERMISSIONSArchive::Zip::Member::DEFAULT_FILE_PERMISSIONS (xsub)
1 | 1 | 1 | 2µs | 19µs | Archive::Zip::Member::::BEGIN@34Archive::Zip::Member::BEGIN@34
1 | 1 | 1 | 2µs | 16µs | Archive::Zip::Member::::BEGIN@35Archive::Zip::Member::BEGIN@35
1 | 1 | 1 | 2µs | 16µs | Archive::Zip::Member::::BEGIN@36Archive::Zip::Member::BEGIN@36
1 | 1 | 1 | 400ns | 400ns | Archive::Zip::Member::::__ANON__Archive::Zip::Member::__ANON__ (xsub)
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_becomeArchive::Zip::Member::_become
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_copyChunkArchive::Zip::Member::_copyChunk
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_crc32Archive::Zip::Member::_crc32
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_decodeArchive::Zip::Member::_decode
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_deflateChunkArchive::Zip::Member::_deflateChunk
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_deflaterArchive::Zip::Member::_deflater
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_dosToUnixTimeArchive::Zip::Member::_dosToUnixTime
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_extractZip64ExtraFieldArchive::Zip::Member::_extractZip64ExtraField
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_noChunkArchive::Zip::Member::_noChunk
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_readOffsetArchive::Zip::Member::_readOffset
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_readRawChunkArchive::Zip::Member::_readRawChunk
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_refreshLocalFileHeaderArchive::Zip::Member::_refreshLocalFileHeader
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_unixToDosTimeArchive::Zip::Member::_unixToDosTime
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_update_keysArchive::Zip::Member::_update_keys
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_usesFileNamedArchive::Zip::Member::_usesFileNamed
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeCentralDirectoryFileHeaderArchive::Zip::Member::_writeCentralDirectoryFileHeader
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeDataArchive::Zip::Member::_writeData
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeDataDescriptorArchive::Zip::Member::_writeDataDescriptor
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeLocalFileHeaderArchive::Zip::Member::_writeLocalFileHeader
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeOffsetArchive::Zip::Member::_writeOffset
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_writeToFileHandleArchive::Zip::Member::_writeToFileHandle
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::_zdecodeArchive::Zip::Member::_zdecode
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::bitFlagArchive::Zip::Member::bitFlag
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::cdExtraFieldArchive::Zip::Member::cdExtraField
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::crc32Archive::Zip::Member::crc32
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::crc32StringArchive::Zip::Member::crc32String
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::desiredCompressionLevelArchive::Zip::Member::desiredCompressionLevel
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::desiredZip64ModeArchive::Zip::Member::desiredZip64Mode
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::externalFileAttributesArchive::Zip::Member::externalFileAttributes
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::externalFileNameArchive::Zip::Member::externalFileName
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::extraFieldsArchive::Zip::Member::extraFields
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::extractToFileHandleArchive::Zip::Member::extractToFileHandle
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::extractToFileNamedArchive::Zip::Member::extractToFileNamed
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::fileAttributeFormatArchive::Zip::Member::fileAttributeFormat
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::fileCommentArchive::Zip::Member::fileComment
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::fileNameAsBytesArchive::Zip::Member::fileNameAsBytes
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::hasDataDescriptorArchive::Zip::Member::hasDataDescriptor
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::internalFileAttributesArchive::Zip::Member::internalFileAttributes
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::isBinaryFileArchive::Zip::Member::isBinaryFile
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::isDirectoryArchive::Zip::Member::isDirectory
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::isSymbolicLinkArchive::Zip::Member::isSymbolicLink
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::isTextFileArchive::Zip::Member::isTextFile
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::lastModFileDateTimeArchive::Zip::Member::lastModFileDateTime
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::lastModTimeArchive::Zip::Member::lastModTime
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::mkpath_win32Archive::Zip::Member::mkpath_win32
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::newDirectoryNamedArchive::Zip::Member::newDirectoryNamed
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::newFromFileArchive::Zip::Member::newFromFile
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::newFromStringArchive::Zip::Member::newFromString
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::passwordArchive::Zip::Member::password
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::setLastModFileDateTimeFromUnixArchive::Zip::Member::setLastModFileDateTimeFromUnix
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::versionMadeByArchive::Zip::Member::versionMadeBy
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::versionNeededToExtractArchive::Zip::Member::versionNeededToExtract
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::wasWrittenArchive::Zip::Member::wasWritten
0 | 0 | 0 | 0s | 0s | Archive::Zip::Member::::writeLocalHeaderRelativeOffsetArchive::Zip::Member::writeLocalHeaderRelativeOffset
0 | 0 | 0 | 0s | 0s | Archive::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Archive::Zip::Member;
2 |  |  |  |  |
3 |  |  |  |  | # A generic member of an archive
4 |  |  |  |  |
5 | 2 | 22µs | 2 | 13µ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
6 | 2 | 42µs | 2 | 38µ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 {
9 | 1 | 200ns |  |  | $VERSION = '1.68';
10 | 1 | 6µs |  |  | @ISA = qw( Archive::Zip );
11 |  |  |  |  |
12 | 1 | 3µs |  |  | if ($^O eq 'MSWin32') {
13 |  |  |  |  | require Win32;
14 |  |  |  |  | require Encode;
15 |  |  |  |  | Encode->import(qw{ decode_utf8 });
16 |  |  |  |  | }
17 | 1 | 21µs | 1 | 8µs | } # spent 8µs making 1 call to Archive::Zip::Member::BEGIN@8
18 |  |  |  |  |
19 | 1 | 2µs | 1 | 237µ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
25 | 1 | 17µs | 1 | 240µs | ); # spent 240µs making 1 call to Archive::Zip::Member::BEGIN@19
26 |  |  |  |  |
27 | 2 | 80µs | 1 | 942µ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
28 | 2 | 20µs | 2 | 134µ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
29 | 2 | 14µs | 2 | 31µ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
30 | 2 | 16µs | 2 | 34µ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.
33 | 2 | 14µs | 2 | 45µ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
34 | 2 | 12µs | 2 | 36µ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
35 | 2 | 12µs | 2 | 30µ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
36 | 2 | 26µs | 2 | 29µ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
37 | 1 | 2µs | 1 | 16µ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
38 | 1 | 100ns |  |  | local $@;
39 | 3 | 7µs | 1 | 3µs | !!eval { symlink("",""); 1 }; # spent 3µs making 1 call to CORE::symlink
40 | 1 | 1.36ms | 1 | 26µ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 {
46 | 11 | 1µs |  |  | my $class = shift;
47 | 11 | 8µs | 11 | 247µs | my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_); # spent 247µs making 11 calls to Archive::Zip::ZipFileMember::_newFromZipFile, avg 22µs/call
48 | 11 | 8µs |  |  | return $self;
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | sub 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 |  |  |  |  |
67 |  |  |  |  | sub 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 |  |  |  |  |
83 |  |  |  |  | sub 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 {
100 | 11 | 1µ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
112 | 11 | 49µ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 |  |  |  |  | };
136 | 11 | 3µs |  |  | bless($self, $class);
137 | 11 | 26µs | 22 | 125µ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
138 | 11 | 13µs |  |  | return $self;
139 |  |  |  |  | }
140 |  |  |  |  |
141 |  |  |  |  | # Morph into given class (do whatever cleanup I need to do)
142 |  |  |  |  | sub _become {
143 |  |  |  |  | return bless($_[0], $_[1]);
144 |  |  |  |  | }
145 |  |  |  |  |
146 |  |  |  |  | sub 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 |  |  |  |  |
157 |  |  |  |  | sub zip64 {
158 |  |  |  |  | shift->{'zip64'};
159 |  |  |  |  | }
160 |  |  |  |  |
161 |  |  |  |  | sub 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 |  |  |  |  |
171 |  |  |  |  | sub versionMadeBy {
172 |  |  |  |  | shift->{'versionMadeBy'};
173 |  |  |  |  | }
174 |  |  |  |  |
175 |  |  |  |  | sub versionNeededToExtract {
176 |  |  |  |  | shift->{'versionNeededToExtract'};
177 |  |  |  |  | }
178 |  |  |  |  |
179 |  |  |  |  | sub 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 |  |  |  |  |
203 |  |  |  |  | sub 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 {
210 | 45 | 34µ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 {
214 | 31 | 4µs |  |  | my $self = shift;
215 |  |  |  |  | my $newDesiredCompressionMethod =
216 | 31 | 10µs |  |  | (ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift;
217 | 31 | 6µs |  |  | my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
218 | 31 | 7µs |  |  | if (defined($newDesiredCompressionMethod)) {
219 | 24 | 4µs |  |  | $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
220 | 24 | 17µs |  |  | if ($newDesiredCompressionMethod == COMPRESSION_STORED) {
221 | 7 | 2µs |  |  | $self->{'desiredCompressionLevel'} = 0;
222 | 7 | 7µs | 7 | 4µ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 |  |  |  |  | }
228 | 31 | 38µs |  |  | return $oldDesiredCompressionMethod;
229 |  |  |  |  | }
230 |  |  |  |  |
231 |  |  |  |  | sub 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 {
248 | 101 | 6µs |  |  | my $self = shift;
249 | 101 | 9µs |  |  | my $newName = shift;
250 | 101 | 7µs |  |  | if (defined $newName) {
251 |  |  |  |  | $newName =~ y{\\/}{/}s; # deal with dos/windoze problems
252 |  |  |  |  | $self->{'fileName'} = $newName;
253 |  |  |  |  | }
254 | 101 | 74µs |  |  | return $self->{'fileName'};
255 |  |  |  |  | }
256 |  |  |  |  |
257 |  |  |  |  | sub 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 |  |  |  |  |
266 |  |  |  |  | sub lastModFileDateTime {
267 |  |  |  |  | my $modTime = shift->{'lastModFileDateTime'};
268 |  |  |  |  | $modTime =~ m/^(\d+)$/; # untaint
269 |  |  |  |  | return $1;
270 |  |  |  |  | }
271 |  |  |  |  |
272 |  |  |  |  | sub lastModTime {
273 |  |  |  |  | my $self = shift;
274 |  |  |  |  | return _dosToUnixTime($self->lastModFileDateTime());
275 |  |  |  |  | }
276 |  |  |  |  |
277 |  |  |  |  | sub setLastModFileDateTimeFromUnix {
278 |  |  |  |  | my $self = shift;
279 |  |  |  |  | my $time_t = shift;
280 |  |  |  |  | $self->{'lastModFileDateTime'} = _unixToDosTime($time_t);
281 |  |  |  |  | }
282 |  |  |  |  |
283 |  |  |  |  | sub internalFileAttributes {
284 |  |  |  |  | shift->{'internalFileAttributes'};
285 |  |  |  |  | }
286 |  |  |  |  |
287 |  |  |  |  | sub 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 {
294 | 11 | 900ns |  |  | my $self = shift;
295 | 11 | 1µs |  |  | my $mode = shift;
296 | 11 | 2µs |  |  | my $attribs = $mode << 16;
297 |  |  |  |  |
298 |  |  |  |  | # Microsoft Windows Explorer needs this bit set for directories
299 | 11 | 2µs |  |  | if ($mode & DIRECTORY_ATTRIB) {
300 |  |  |  |  | $attribs |= 16;
301 |  |  |  |  | }
302 |  |  |  |  |
303 | 11 | 8µ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 {
320 | 11 | 900ns |  |  | my $self = shift;
321 |  |  |  |  |
322 | 11 | 3µs |  |  | my $format = $self->{'fileAttributeFormat'};
323 | 11 | 1µs |  |  | my $attribs = $self->{'externalFileAttributes'};
324 |  |  |  |  |
325 | 11 | 1µs |  |  | my $mode = 0;
326 |  |  |  |  |
327 | 11 | 1µ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 |  |  |  |  |
333 | 11 | 1µ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 |  |  |  |  |
342 | 11 | 1µ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) {
349 | 11 | 1µs |  |  | $mode = $attribs >> 16;
350 | 11 | 17µs | 11 | 10µ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 {
392 | 11 | 1µs |  |  | my $self = shift;
393 | 11 | 8µs | 11 | 41µs | my $oldPerms = $self->_mapPermissionsToUnix; # spent 41µs making 11 calls to Archive::Zip::Member::_mapPermissionsToUnix, avg 4µs/call
394 |  |  |  |  |
395 | 11 | 800ns |  |  | my $perms;
396 | 11 | 3µs |  |  | if (@_) {
397 | 11 | 2µs |  |  | $perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0];
398 |  |  |  |  |
399 | 11 | 7µs | 11 | 22µ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 {
403 | 11 | 1µs |  |  | $perms &= ~DIRECTORY_ATTRIB;
404 | 11 | 2µs |  |  | $perms |= FILE_ATTRIB;
405 |  |  |  |  | }
406 |  |  |  |  | $self->{externalFileAttributes} =
407 | 11 | 9µs | 11 | 9µs | $self->_mapPermissionsFromUnix($perms); # spent 9µs making 11 calls to Archive::Zip::Member::_mapPermissionsFromUnix, avg 800ns/call
408 |  |  |  |  | }
409 |  |  |  |  |
410 | 11 | 8µ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 {
414 | 11 | 1µs |  |  | my $self = shift;
415 |  |  |  |  |
416 | 11 | 2µ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 {
432 | 11 | 12µs |  |  | return $self->{localExtraField};
433 |  |  |  |  | }
434 |  |  |  |  | }
435 |  |  |  |  |
436 |  |  |  |  | sub 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 |  |  |  |  |
459 |  |  |  |  | sub extraFields {
460 |  |  |  |  | my $self = shift;
461 |  |  |  |  | return $self->localExtraField() . $self->cdExtraField();
462 |  |  |  |  | }
463 |  |  |  |  |
464 |  |  |  |  | sub 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 |  |  |  |  |
477 |  |  |  |  | sub 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 |  |  |  |  |
490 |  |  |  |  | sub crc32 {
491 |  |  |  |  | shift->{'crc32'};
492 |  |  |  |  | }
493 |  |  |  |  |
494 |  |  |  |  | sub 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 {
499 | 7 | 6µ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 {
503 | 21 | 24µ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 {
507 | 7 | 7µs |  |  | shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK;
508 |  |  |  |  | }
509 |  |  |  |  |
510 |  |  |  |  | sub 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 |  |  |  |  |
522 |  |  |  |  | sub 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 |  |  |  |  |
534 |  |  |  |  | sub 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 |  |  |  |  |
576 |  |  |  |  | sub mkpath_win32 {
577 |  |  |  |  | my $path = shift;
578 | 2 | 2.02ms | 2 | 11µ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 |  |  |  |  |
589 |  |  |  |  | sub isSymbolicLink {
590 |  |  |  |  | return shift->{'externalFileAttributes'} == 0xA1FF0000;
591 |  |  |  |  | }
592 |  |  |  |  |
593 |  |  |  |  | sub isDirectory {
594 |  |  |  |  | return 0;
595 |  |  |  |  | }
596 |  |  |  |  |
597 |  |  |  |  | sub 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.
615 |  |  |  |  | sub _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
718 |  |  |  |  | sub _writeOffset {
719 |  |  |  |  | shift->{'writeOffset'};
720 |  |  |  |  | }
721 |  |  |  |  |
722 |  |  |  |  | sub _readOffset {
723 |  |  |  |  | shift->{'readOffset'};
724 |  |  |  |  | }
725 |  |  |  |  |
726 |  |  |  |  | sub writeLocalHeaderRelativeOffset {
727 |  |  |  |  | shift->{'writeLocalHeaderRelativeOffset'};
728 |  |  |  |  | }
729 |  |  |  |  |
730 |  |  |  |  | # Maintained in method Archive::Zip::Archive::writeToFileHandle
731 |  |  |  |  | sub 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 {
736 | 14 | 14µ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 {
740 | 21 | 15µ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 {
744 | 7 | 6µs |  |  | shift->{'inflater'};
745 |  |  |  |  | }
746 |  |  |  |  |
747 |  |  |  |  | sub _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!
761 |  |  |  |  | sub _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.
782 | 1 | 200ns |  |  | my $safe_epoch = 31.686060;
783 |  |  |  |  |
784 |  |  |  |  | # convert a unix time to DOS date/time
785 |  |  |  |  | # NOT AN OBJECT METHOD!
786 |  |  |  |  | sub _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.
809 |  |  |  |  | sub _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 |  |  |  |  |
886 |  |  | 1 | 1µ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.
927 |  |  |  |  | sub _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.
946 |  |  |  |  | sub _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 =
1011 |  |  | 1 | 900ns | 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.
1072 |  |  |  |  | sub _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 {
1103 | 7 | 1µs |  |  | my $self = shift;
1104 | 7 | 3µs |  |  | my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0];
1105 |  |  |  |  |
1106 | 7 | 5µs | 7 | 24µ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 |  |  |  |  |
1112 | 7 | 2µs |  |  | $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize);
1113 | 7 | 4µs | 7 | 1µs | $chunkSize = $self->_readDataRemaining() # spent 1µs making 7 calls to Archive::Zip::Member::_readDataRemaining, avg 186ns/call
1114 |  |  |  |  | if $chunkSize > $self->_readDataRemaining();
1115 |  |  |  |  |
1116 | 7 | 1µs |  |  | my $buffer = '';
1117 | 7 | 400ns |  |  | my $outputRef;
1118 | 7 | 7µs | 7 | 591µs | my ($bytesRead, $status) = $self->_readRawChunk(\$buffer, $chunkSize); # spent 591µs making 7 calls to Archive::Zip::ZipFileMember::_readRawChunk, avg 84µs/call
1119 | 7 | 1µs |  |  | return (\$buffer, $status) unless $status == AZ_OK;
1120 |  |  |  |  |
1121 | 7 | 7µs | 7 | 5µs | $buffer && $self->isEncrypted and $buffer = $self->_decode($buffer); # spent 5µs making 7 calls to Archive::Zip::Member::isEncrypted, avg 686ns/call
1122 | 7 | 2µs |  |  | $self->{'readDataRemaining'} -= $bytesRead;
1123 | 7 | 2µs |  |  | $self->{'readOffset'} += $bytesRead;
1124 |  |  |  |  |
1125 | 7 | 4µs | 7 | 2µ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 |  |  |  |  |
1129 | 7 | 8µs | 7 | 12.3ms | ($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer); # spent 12.3ms making 7 calls to Archive::Zip::Member::_inflateChunk, avg 1.76ms/call
1130 | 7 | 5µs |  |  | $self->{'writeOffset'} += length($$outputRef);
1131 |  |  |  |  |
1132 | 7 | 8µs | 14 | 27µ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 |  |  |  |  |
1135 | 7 | 8µ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 );
1140 |  |  |  |  | sub _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.
1147 |  |  |  |  | sub _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 );
1154 |  |  |  |  | sub _copyChunk {
1155 |  |  |  |  | my ($self, $dataRef) = @_;
1156 |  |  |  |  | return ($dataRef, AZ_OK);
1157 |  |  |  |  | }
1158 |  |  |  |  |
1159 |  |  |  |  | # ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
1160 |  |  |  |  | sub _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 {
1182 | 7 | 2µs |  |  | my ($self, $buffer) = @_;
1183 | 7 | 12.1ms | 14 | 12.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
1184 | 7 | 600ns |  |  | my $retval;
1185 | 7 | 17µs | 14 | 109µ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
1186 | 7 | 12µs | 14 | 16µ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
1187 | 7 | 4µs | 7 | 2µ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
1188 | 7 | 12µ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 {
1197 | 7 | 500ns |  |  | my $self = shift;
1198 | 7 | 700ns |  |  | my $status;
1199 |  |  |  |  |
1200 |  |  |  |  | # set to trap init errors
1201 | 7 | 18µs | 7 | 5µ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
1204 | 7 | 4µs | 7 | 2µ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.
1208 | 7 | 4µs | 7 | 3µ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.
1212 | 7 | 10µs | 21 | 8µ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) {
1225 | 7 | 29µs | 14 | 728µ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
1230 | 7 | 9µs | 7 | 17µ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;
1232 | 7 | 15µs | 7 | 5µ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 |  |  |  |  |
1243 | 7 | 12µs | 14 | 7µ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();
1247 | 7 | 2µs |  |  | $self->{'dataEnded'} = 0;
1248 | 7 | 2µs |  |  | $self->{'readOffset'} = 0;
1249 |  |  |  |  |
1250 | 7 | 8µ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 {
1254 | 31 | 2µs |  |  | my $self = shift;
1255 | 31 | 46µs | 7 | 25µs | delete $self->{'inflater'}; # spent 25µs making 7 calls to Compress::Raw::Zlib::inflateStream::DESTROY, avg 4µs/call
1256 | 31 | 4µs |  |  | delete $self->{'deflater'};
1257 | 31 | 6µs |  |  | $self->{'dataEnded'} = 1;
1258 | 31 | 5µs |  |  | $self->{'readDataRemaining'} = 0;
1259 | 31 | 22µ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 {
1263 | 14 | 2µs |  |  | my $self = shift;
1264 | 14 | 25µs | 21 | 8µ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 {
1268 | 7 | 800ns |  |  | my $self = shift;
1269 | 7 | 900ns |  |  | my $newContents = shift;
1270 |  |  |  |  |
1271 | 7 | 2µ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 {
1288 | 7 | 5µs | 7 | 30µs | my $oldCompression = # spent 30µs making 7 calls to Archive::Zip::Member::desiredCompressionMethod, avg 4µs/call
1289 |  |  |  |  | $self->desiredCompressionMethod(COMPRESSION_STORED);
1290 | 7 | 7µs | 7 | 1.85ms | my $status = $self->rewindData(@_); # spent 1.85ms making 7 calls to Archive::Zip::ZipFileMember::rewindData, avg 264µs/call
1291 | 7 | 2µs |  |  | if ($status != AZ_OK) {
1292 |  |  |  |  | $self->endRead();
1293 |  |  |  |  | return wantarray ? (undef, $status) : undef;
1294 |  |  |  |  | }
1295 | 7 | 2µs |  |  | my $retval = '';
1296 | 7 | 3µs |  |  | while ($status == AZ_OK) {
1297 | 7 | 500ns |  |  | my $ref;
1298 | 7 | 13µs | 14 | 13.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?
1301 | 7 | 4.09ms | 7 | 3µ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 |  |  |  |  | }
1307 | 7 | 6µs | 7 | 15µs | $self->desiredCompressionMethod($oldCompression); # spent 15µs making 7 calls to Archive::Zip::Member::desiredCompressionMethod, avg 2µs/call
1308 | 7 | 3µs | 7 | 14µs | $self->endRead(); # spent 14µs making 7 calls to Archive::Zip::FileMember::endRead, avg 2µs/call
1309 | 7 | 2µs |  |  | $status = AZ_OK if $status == AZ_STREAM_END;
1310 | 7 | 800ns |  |  | $retval = undef unless $status == AZ_OK;
1311 | 7 | 11µs |  |  | return wantarray ? ($retval, $status) : $retval;
1312 |  |  |  |  | }
1313 |  |  |  |  | }
1314 |  |  |  |  |
1315 |  |  |  |  | sub 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.
1332 |  |  |  |  | sub _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
1396 |  |  |  |  | sub _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
1426 |  |  |  |  | sub _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 |  |  |  |  |
1483 | 1 | 200ns |  |  | my @keys;
1484 | 1 | 7µs |  |  | my @crct = do {
1485 | 1 | 100ns |  |  | my $xor = 0xedb88320;
1486 | 1 | 13µs |  |  | my @crc = (0) x 1024;
1487 |  |  |  |  |
1488 |  |  |  |  | # generate a crc for every 8-bit value
1489 | 1 | 900ns |  |  | foreach my $n (0 .. 255) {
1490 | 256 | 15µs |  |  | my $c = $n;
1491 | 256 | 274µs |  |  | $c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8;
1492 | 256 | 98µs | 256 | 80µ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 */
1496 | 1 | 500ns |  |  | foreach my $n (0 .. 255) {
1497 | 256 | 38µs |  |  | my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff;
1498 | 256 | 144µs |  |  | $crc[$_ * 256 + $n] = $c for 1 .. 3;
1499 |  |  |  |  | }
1500 | 1 | 311µs | 1024 | 318µs | map { _revbe($crc[$_]) } 0 .. 1023; # spent 318µs making 1024 calls to Archive::Zip::Member::_revbe, avg 310ns/call
1501 |  |  |  |  | };
1502 |  |  |  |  |
1503 |  |  |  |  | sub _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 {
1509 | 1280 | 86µs |  |  | my $w = shift;
1510 | 1280 | 833µs |  |  | return (($w >> 24) +
1511 |  |  |  |  | (($w >> 8) & 0xff00) +
1512 |  |  |  |  | (($w & 0xff00) << 8) +
1513 |  |  |  |  | (($w & 0xff) << 24));
1514 |  |  |  |  | } # _revbe
1515 |  |  |  |  |
1516 |  |  |  |  | sub _update_keys {
1517 | 2 | 305µs | 2 | 121µ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 |  |  |  |  |
1525 |  |  |  |  | sub _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 |  |  |  |  |
1532 |  |  |  |  | sub _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 |  |  |  |  |
1564 | 1 | 13µs |  |  | 1;
|  |  |  |  | # 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