← Index
NYTProf Performance Profile   « block view • line view • sub view »
For C:/lo/libo-master/solenv/bin/make_installer.pl
  Run on Mon Sep 24 00:52:54 2012
Reported on Mon Sep 24 07:34:31 2012

Filename/usr/lib/perl5/site_perl/5.14/Archive/Zip/Archive.pm
StatementsExecuted 219401 statements in 798ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
21011344ms3.79sArchive::Zip::Archive::::readFromFileHandleArchive::Zip::Archive::readFromFileHandle
21011242ms43.2sArchive::Zip::Archive::::extractTreeArchive::Zip::Archive::extractTree
21011105ms178msArchive::Zip::Archive::::membersMatchingArchive::Zip::Archive::membersMatching
4202194.1ms208msArchive::Zip::Archive::::memberNamesArchive::Zip::Archive::memberNames
99821156.8ms56.8msArchive::Zip::Archive::::CORE:substArchive::Zip::Archive::CORE:subst (opcode)
101921122.5ms22.5msArchive::Zip::Archive::::eocdOffsetArchive::Zip::Archive::eocdOffset
99821114.2ms14.2msArchive::Zip::Archive::::CORE:matchArchive::Zip::Archive::CORE:match (opcode)
199642114.0ms14.0msArchive::Zip::Archive::::CORE:regcompArchive::Zip::Archive::CORE:regcomp (opcode)
11110.8ms11.3msArchive::Zip::Archive::::BEGIN@7Archive::Zip::Archive::BEGIN@7
210118.28ms23.2msArchive::Zip::Archive::::_findEndOfCentralDirectoryArchive::Zip::Archive::_findEndOfCentralDirectory
630215.79ms5.79msArchive::Zip::Archive::::membersArchive::Zip::Archive::members
210115.72ms3.88sArchive::Zip::Archive::::readArchive::Zip::Archive::read
210115.35ms5.35msArchive::Zip::Archive::::newArchive::Zip::Archive::new
210115.03ms11.0msArchive::Zip::Archive::::_readEndOfCentralDirectoryArchive::Zip::Archive::_readEndOfCentralDirectory
420211.21ms1.21msArchive::Zip::Archive::::centralDirectorySizeArchive::Zip::Archive::centralDirectorySize
21011782µs782µsArchive::Zip::Archive::::CORE:unpackArchive::Zip::Archive::CORE:unpack (opcode)
21011535µs535µsArchive::Zip::Archive::::centralDirectoryOffsetWRTStartingDiskNumberArchive::Zip::Archive::centralDirectoryOffsetWRTStartingDiskNumber
111189µs200µsArchive::Zip::Archive::::BEGIN@5Archive::Zip::Archive::BEGIN@5
11121µs115µsArchive::Zip::Archive::::BEGIN@10Archive::Zip::Archive::BEGIN@10
11120µs20µsArchive::Zip::Archive::::BEGIN@15Archive::Zip::Archive::BEGIN@15
11117µs1.10msArchive::Zip::Archive::::BEGIN@20Archive::Zip::Archive::BEGIN@20
11117µs82µsArchive::Zip::Archive::::BEGIN@11Archive::Zip::Archive::BEGIN@11
11117µs98µsArchive::Zip::Archive::::BEGIN@13Archive::Zip::Archive::BEGIN@13
11117µs99µsArchive::Zip::Archive::::BEGIN@6Archive::Zip::Archive::BEGIN@6
1118µs8µsArchive::Zip::Archive::::BEGIN@8Archive::Zip::Archive::BEGIN@8
1116µs6µsArchive::Zip::Archive::::BEGIN@9Archive::Zip::Archive::BEGIN@9
0000s0sArchive::Zip::Archive::::__ANON__[:726]Archive::Zip::Archive::__ANON__[:726]
0000s0sArchive::Zip::Archive::::__ANON__[:742]Archive::Zip::Archive::__ANON__[:742]
0000s0sArchive::Zip::Archive::::__ANON__[:790]Archive::Zip::Archive::__ANON__[:790]
0000s0sArchive::Zip::Archive::::__ANON__[:921]Archive::Zip::Archive::__ANON__[:921]
0000s0sArchive::Zip::Archive::::__ANON__[:941]Archive::Zip::Archive::__ANON__[:941]
0000s0sArchive::Zip::Archive::::_untaintDirArchive::Zip::Archive::_untaintDir
0000s0sArchive::Zip::Archive::::_writeCentralDirectoryOffsetArchive::Zip::Archive::_writeCentralDirectoryOffset
0000s0sArchive::Zip::Archive::::_writeEOCDOffsetArchive::Zip::Archive::_writeEOCDOffset
0000s0sArchive::Zip::Archive::::_writeEndOfCentralDirectoryArchive::Zip::Archive::_writeEndOfCentralDirectory
0000s0sArchive::Zip::Archive::::addDirectoryArchive::Zip::Archive::addDirectory
0000s0sArchive::Zip::Archive::::addFileArchive::Zip::Archive::addFile
0000s0sArchive::Zip::Archive::::addFileOrDirectoryArchive::Zip::Archive::addFileOrDirectory
0000s0sArchive::Zip::Archive::::addMemberArchive::Zip::Archive::addMember
0000s0sArchive::Zip::Archive::::addStringArchive::Zip::Archive::addString
0000s0sArchive::Zip::Archive::::addTreeArchive::Zip::Archive::addTree
0000s0sArchive::Zip::Archive::::addTreeMatchingArchive::Zip::Archive::addTreeMatching
0000s0sArchive::Zip::Archive::::contentsArchive::Zip::Archive::contents
0000s0sArchive::Zip::Archive::::diskNumberArchive::Zip::Archive::diskNumber
0000s0sArchive::Zip::Archive::::diskNumberWithStartOfCentralDirectoryArchive::Zip::Archive::diskNumberWithStartOfCentralDirectory
0000s0sArchive::Zip::Archive::::extractMemberArchive::Zip::Archive::extractMember
0000s0sArchive::Zip::Archive::::extractMemberWithoutPathsArchive::Zip::Archive::extractMemberWithoutPaths
0000s0sArchive::Zip::Archive::::fileNameArchive::Zip::Archive::fileName
0000s0sArchive::Zip::Archive::::memberNamedArchive::Zip::Archive::memberNamed
0000s0sArchive::Zip::Archive::::numberOfCentralDirectoriesArchive::Zip::Archive::numberOfCentralDirectories
0000s0sArchive::Zip::Archive::::numberOfCentralDirectoriesOnThisDiskArchive::Zip::Archive::numberOfCentralDirectoriesOnThisDisk
0000s0sArchive::Zip::Archive::::numberOfMembersArchive::Zip::Archive::numberOfMembers
0000s0sArchive::Zip::Archive::::overwriteArchive::Zip::Archive::overwrite
0000s0sArchive::Zip::Archive::::overwriteAsArchive::Zip::Archive::overwriteAs
0000s0sArchive::Zip::Archive::::removeMemberArchive::Zip::Archive::removeMember
0000s0sArchive::Zip::Archive::::replaceMemberArchive::Zip::Archive::replaceMember
0000s0sArchive::Zip::Archive::::storeSymbolicLinkArchive::Zip::Archive::storeSymbolicLink
0000s0sArchive::Zip::Archive::::updateMemberArchive::Zip::Archive::updateMember
0000s0sArchive::Zip::Archive::::updateTreeArchive::Zip::Archive::updateTree
0000s0sArchive::Zip::Archive::::writeCentralDirectoryArchive::Zip::Archive::writeCentralDirectory
0000s0sArchive::Zip::Archive::::writeToFileHandleArchive::Zip::Archive::writeToFileHandle
0000s0sArchive::Zip::Archive::::writeToFileNamedArchive::Zip::Archive::writeToFileNamed
0000s0sArchive::Zip::Archive::::zipfileCommentArchive::Zip::Archive::zipfileComment
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Archive::Zip::Archive;
2
3# Represents a generic ZIP archive
4
5263µs2210µs
# spent 200µs (189+10) within Archive::Zip::Archive::BEGIN@5 which was called: # once (189µs+10µs) by installer::archivefiles::BEGIN@30 at line 5
use strict;
# spent 200µs making 1 call to Archive::Zip::Archive::BEGIN@5 # spent 10µs making 1 call to strict::import
6255µs2180µs
# spent 99µs (17+82) within Archive::Zip::Archive::BEGIN@6 which was called: # once (17µs+82µs) by installer::archivefiles::BEGIN@30 at line 6
use File::Path;
# spent 99µs making 1 call to Archive::Zip::Archive::BEGIN@6 # spent 82µs making 1 call to Exporter::import
722.43ms111.3ms
# spent 11.3ms (10.8+565µs) within Archive::Zip::Archive::BEGIN@7 which was called: # once (10.8ms+565µs) by installer::archivefiles::BEGIN@30 at line 7
use File::Find ();
# spent 11.3ms making 1 call to Archive::Zip::Archive::BEGIN@7
8246µs18µs
# spent 8µs within Archive::Zip::Archive::BEGIN@8 which was called: # once (8µs+0s) by installer::archivefiles::BEGIN@30 at line 8
use File::Spec ();
# spent 8µs making 1 call to Archive::Zip::Archive::BEGIN@8
9248µs16µs
# spent 6µs within Archive::Zip::Archive::BEGIN@9 which was called: # once (6µs+0s) by installer::archivefiles::BEGIN@30 at line 9
use File::Copy ();
# spent 6µs making 1 call to Archive::Zip::Archive::BEGIN@9
10258µs2209µs
# spent 115µs (21+94) within Archive::Zip::Archive::BEGIN@10 which was called: # once (21µs+94µs) by installer::archivefiles::BEGIN@30 at line 10
use File::Basename;
# spent 115µs making 1 call to Archive::Zip::Archive::BEGIN@10 # spent 94µs making 1 call to Exporter::import
11263µs2146µs
# spent 82µs (17+64) within Archive::Zip::Archive::BEGIN@11 which was called: # once (17µs+64µs) by installer::archivefiles::BEGIN@30 at line 11
use Cwd;
# spent 82µs making 1 call to Archive::Zip::Archive::BEGIN@11 # spent 64µs making 1 call to Exporter::import
12
13283µs2180µs
# spent 98µs (17+81) within Archive::Zip::Archive::BEGIN@13 which was called: # once (17µs+81µs) by installer::archivefiles::BEGIN@30 at line 13
use vars qw( $VERSION @ISA );
# spent 98µs making 1 call to Archive::Zip::Archive::BEGIN@13 # spent 81µs making 1 call to vars::import
14
15
# spent 20µs within Archive::Zip::Archive::BEGIN@15 which was called: # once (20µs+0s) by installer::archivefiles::BEGIN@30 at line 18
BEGIN {
16219µs $VERSION = '1.30';
17 @ISA = qw( Archive::Zip );
18158µs120µs}
# spent 20µs making 1 call to Archive::Zip::Archive::BEGIN@15
19
2011.08ms
# spent 1.10ms (17µs+1.08) within Archive::Zip::Archive::BEGIN@20 which was called: # once (17µs+1.08ms) by installer::archivefiles::BEGIN@30 at line 25
use Archive::Zip qw(
# spent 1.08ms making 1 call to Exporter::import
21 :CONSTANTS
22 :ERROR_CODES
23 :PKZIP_CONSTANTS
24 :UTILITY_METHODS
25210.2ms11.10ms);
# spent 1.10ms making 1 call to Archive::Zip::Archive::BEGIN@20
26
27# Note that this returns undef on read errors, else new zip object.
28
29
# spent 5.35ms within Archive::Zip::Archive::new which was called 210 times, avg 25µs/call: # 210 times (5.35ms+0s) by Archive::Zip::new at line 287 of Archive/Zip.pm, avg 25µs/call
sub new {
3012605.68ms my $class = shift;
31 my $self = bless(
32 {
33 'diskNumber' => 0,
34 'diskNumberWithStartOfCentralDirectory' => 0,
35 'numberOfCentralDirectoriesOnThisDisk' => 0, # shld be # of members
36 'numberOfCentralDirectories' => 0, # shld be # of members
37 'centralDirectorySize' => 0, # must re-compute on write
38 'centralDirectoryOffsetWRTStartingDiskNumber' =>
39 0, # must re-compute
40 'writeEOCDOffset' => 0,
41 'writeCentralDirectoryOffset' => 0,
42 'zipfileComment' => '',
43 'eocdOffset' => 0,
44 'fileName' => ''
45 },
46 $class
47 );
48 $self->{'members'} = [];
49 my $fileName = ( ref( $_[0] ) eq 'HASH' ) ? shift->{filename} : shift;
50 if ($fileName) {
51 my $status = $self->read($fileName);
52 return $status == AZ_OK ? $self : undef;
53 }
54 return $self;
55}
56
57sub storeSymbolicLink {
58 my $self = shift;
59 $self->{'storeSymbolicLink'} = shift;
60}
61
62
# spent 5.79ms within Archive::Zip::Archive::members which was called 630 times, avg 9µs/call: # 420 times (4.40ms+0s) by Archive::Zip::Archive::memberNames at line 72, avg 10µs/call # 210 times (1.39ms+0s) by Archive::Zip::Archive::membersMatching at line 88, avg 7µs/call
sub members {
636307.03ms @{ shift->{'members'} };
64}
65
66sub numberOfMembers {
67 scalar( shift->members() );
68}
69
70
# spent 208ms (94.1+114) within Archive::Zip::Archive::memberNames which was called 420 times, avg 495µs/call: # 210 times (47.5ms+57.5ms) by installer::archivefiles::resolving_archive_flag at line 326 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/archivefiles.pm, avg 500µs/call # 210 times (46.6ms+56.2ms) by installer::archivefiles::resolving_archive_flag at line 263 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/archivefiles.pm, avg 490µs/call
sub memberNames {
712080463.7ms my $self = shift;
7220384114ms return map { $_->fileName() } $self->members();
# spent 69.7ms making 17202 calls to Archive::Zip::Member::fileName, avg 4µs/call # spent 39.6ms making 2762 calls to Archive::Zip::DirectoryMember::fileName, avg 14µs/call # spent 4.40ms making 420 calls to Archive::Zip::Archive::members, avg 10µs/call
73}
74
75# return ref to member with given name or undef
76sub memberNamed {
77 my $self = shift;
78 my $fileName = ( ref( $_[0] ) eq 'HASH' ) ? shift->{zipName} : shift;
79 foreach my $member ( $self->members() ) {
80 return $member if $member->fileName() eq $fileName;
81 }
82 return undef;
83}
84
85
# spent 178ms (105+73.0) within Archive::Zip::Archive::membersMatching which was called 210 times, avg 848µs/call: # 210 times (105ms+73.0ms) by Archive::Zip::Archive::extractTree at line 815, avg 848µs/call
sub membersMatching {
8610612109ms my $self = shift;
87 my $pattern = ( ref( $_[0] ) eq 'HASH' ) ? shift->{regex} : shift;
883015673.0ms return grep { $_->fileName() =~ /$pattern/ } $self->members();
# spent 33.3ms making 8601 calls to Archive::Zip::Member::fileName, avg 4µs/call # spent 19.3ms making 1381 calls to Archive::Zip::DirectoryMember::fileName, avg 14µs/call # spent 14.2ms making 9982 calls to Archive::Zip::Archive::CORE:match, avg 1µs/call # spent 4.73ms making 9982 calls to Archive::Zip::Archive::CORE:regcomp, avg 474ns/call # spent 1.39ms making 210 calls to Archive::Zip::Archive::members, avg 7µs/call
89}
90
91sub diskNumber {
92 shift->{'diskNumber'};
93}
94
95sub diskNumberWithStartOfCentralDirectory {
96 shift->{'diskNumberWithStartOfCentralDirectory'};
97}
98
99sub numberOfCentralDirectoriesOnThisDisk {
100 shift->{'numberOfCentralDirectoriesOnThisDisk'};
101}
102
103sub numberOfCentralDirectories {
104 shift->{'numberOfCentralDirectories'};
105}
106
107
# spent 1.21ms within Archive::Zip::Archive::centralDirectorySize which was called 420 times, avg 3µs/call: # 210 times (736µs+0s) by Archive::Zip::Archive::readFromFileHandle at line 589, avg 4µs/call # 210 times (475µs+0s) by Archive::Zip::Archive::readFromFileHandle at line 595, avg 2µs/call
sub centralDirectorySize {
1084201.82ms shift->{'centralDirectorySize'};
109}
110
111
# spent 535µs within Archive::Zip::Archive::centralDirectoryOffsetWRTStartingDiskNumber which was called 210 times, avg 3µs/call: # 210 times (535µs+0s) by Archive::Zip::Archive::readFromFileHandle at line 595, avg 3µs/call
sub centralDirectoryOffsetWRTStartingDiskNumber {
112210900µs shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
113}
114
115sub zipfileComment {
116 my $self = shift;
117 my $comment = $self->{'zipfileComment'};
118 if (@_) {
119 my $new_comment = ( ref( $_[0] ) eq 'HASH' ) ? shift->{comment} : shift;
120 $self->{'zipfileComment'} = pack( 'C0a*', $new_comment ); # avoid unicode
121 }
122 return $comment;
123}
124
125
# spent 22.5ms within Archive::Zip::Archive::eocdOffset which was called 10192 times, avg 2µs/call: # 10192 times (22.5ms+0s) by Archive::Zip::Archive::readFromFileHandle at line 599, avg 2µs/call
sub eocdOffset {
1261019237.8ms shift->{'eocdOffset'};
127}
128
129# Return the name of the file last read.
130sub fileName {
131 shift->{'fileName'};
132}
133
134sub removeMember {
135 my $self = shift;
136 my $member = ( ref( $_[0] ) eq 'HASH' ) ? shift->{memberOrZipName} : shift;
137 $member = $self->memberNamed($member) unless ref($member);
138 return undef unless $member;
139 my @newMembers = grep { $_ != $member } $self->members();
140 $self->{'members'} = \@newMembers;
141 return $member;
142}
143
144sub replaceMember {
145 my $self = shift;
146
147 my ( $oldMember, $newMember );
148 if ( ref( $_[0] ) eq 'HASH' ) {
149 $oldMember = $_[0]->{memberOrZipName};
150 $newMember = $_[0]->{newMember};
151 }
152 else {
153 ( $oldMember, $newMember ) = @_;
154 }
155
156 $oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
157 return undef unless $oldMember;
158 return undef unless $newMember;
159 my @newMembers =
160 map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
161 $self->{'members'} = \@newMembers;
162 return $oldMember;
163}
164
165sub extractMember {
166 my $self = shift;
167
168 my ( $member, $name );
169 if ( ref( $_[0] ) eq 'HASH' ) {
170 $member = $_[0]->{memberOrZipName};
171 $name = $_[0]->{name};
172 }
173 else {
174 ( $member, $name ) = @_;
175 }
176
177 $member = $self->memberNamed($member) unless ref($member);
178 return _error('member not found') unless $member;
179 my $originalSize = $member->compressedSize();
180 my ( $volumeName, $dirName, $fileName );
181 if ( defined($name) ) {
182 ( $volumeName, $dirName, $fileName ) = File::Spec->splitpath($name);
183 $dirName = File::Spec->catpath( $volumeName, $dirName, '' );
184 }
185 else {
186 $name = $member->fileName();
187 ( $dirName = $name ) =~ s{[^/]*$}{};
188 $dirName = Archive::Zip::_asLocalName($dirName);
189 $name = Archive::Zip::_asLocalName($name);
190 }
191 if ( $dirName && !-d $dirName ) {
192 mkpath($dirName);
193 return _ioError("can't create dir $dirName") if ( !-d $dirName );
194 }
195 my $rc = $member->extractToFileNamed( $name, @_ );
196
197 # TODO refactor this fix into extractToFileNamed()
198 $member->{'compressedSize'} = $originalSize;
199 return $rc;
200}
201
202sub extractMemberWithoutPaths {
203 my $self = shift;
204
205 my ( $member, $name );
206 if ( ref( $_[0] ) eq 'HASH' ) {
207 $member = $_[0]->{memberOrZipName};
208 $name = $_[0]->{name};
209 }
210 else {
211 ( $member, $name ) = @_;
212 }
213
214 $member = $self->memberNamed($member) unless ref($member);
215 return _error('member not found') unless $member;
216 my $originalSize = $member->compressedSize();
217 return AZ_OK if $member->isDirectory();
218 unless ($name) {
219 $name = $member->fileName();
220 $name =~ s{.*/}{}; # strip off directories, if any
221 $name = Archive::Zip::_asLocalName($name);
222 }
223 my $rc = $member->extractToFileNamed( $name, @_ );
224 $member->{'compressedSize'} = $originalSize;
225 return $rc;
226}
227
228sub addMember {
229 my $self = shift;
230 my $newMember = ( ref( $_[0] ) eq 'HASH' ) ? shift->{member} : shift;
231 push( @{ $self->{'members'} }, $newMember ) if $newMember;
232 return $newMember;
233}
234
235sub addFile {
236 my $self = shift;
237
238 my ( $fileName, $newName, $compressionLevel );
239 if ( ref( $_[0] ) eq 'HASH' ) {
240 $fileName = $_[0]->{filename};
241 $newName = $_[0]->{zipName};
242 $compressionLevel = $_[0]->{compressionLevel};
243 }
244 else {
245 ( $fileName, $newName, $compressionLevel ) = @_;
246 }
247
248 my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
249 $newMember->desiredCompressionLevel($compressionLevel);
250 if ( $self->{'storeSymbolicLink'} && -l $fileName ) {
251 my $newMember = $self->ZIPMEMBERCLASS->newFromString(readlink $fileName, $newName);
252 # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
253 $newMember->{'externalFileAttributes'} = 0xA1FF0000;
254 $self->addMember($newMember);
255 } else {
256 $self->addMember($newMember);
257 }
258 return $newMember;
259}
260
261sub addString {
262 my $self = shift;
263
264 my ( $stringOrStringRef, $name, $compressionLevel );
265 if ( ref( $_[0] ) eq 'HASH' ) {
266 $stringOrStringRef = $_[0]->{string};
267 $name = $_[0]->{zipName};
268 $compressionLevel = $_[0]->{compressionLevel};
269 }
270 else {
271 ( $stringOrStringRef, $name, $compressionLevel ) = @_;;
272 }
273
274 my $newMember = $self->ZIPMEMBERCLASS->newFromString(
275 $stringOrStringRef, $name
276 );
277 $newMember->desiredCompressionLevel($compressionLevel);
278 return $self->addMember($newMember);
279}
280
281sub addDirectory {
282 my $self = shift;
283
284 my ( $name, $newName );
285 if ( ref( $_[0] ) eq 'HASH' ) {
286 $name = $_[0]->{directoryName};
287 $newName = $_[0]->{zipName};
288 }
289 else {
290 ( $name, $newName ) = @_;
291 }
292
293 my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name, $newName );
294 if ( $self->{'storeSymbolicLink'} && -l $name ) {
295 my $link = readlink $name;
296 ( $newName =~ s{/$}{} ) if $newName; # Strip trailing /
297 my $newMember = $self->ZIPMEMBERCLASS->newFromString($link, $newName);
298 # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
299 $newMember->{'externalFileAttributes'} = 0xA1FF0000;
300 $self->addMember($newMember);
301 } else {
302 $self->addMember($newMember);
303 }
304 return $newMember;
305}
306
307# add either a file or a directory.
308
309sub addFileOrDirectory {
310 my $self = shift;
311
312 my ( $name, $newName, $compressionLevel );
313 if ( ref( $_[0] ) eq 'HASH' ) {
314 $name = $_[0]->{name};
315 $newName = $_[0]->{zipName};
316 $compressionLevel = $_[0]->{compressionLevel};
317 }
318 else {
319 ( $name, $newName, $compressionLevel ) = @_;
320 }
321
322 $name =~ s{/$}{};
323 if ( $newName ) {
324 $newName =~ s{/$}{};
325 } else {
326 $newName = $name;
327 }
328 if ( -f $name ) {
329 return $self->addFile( $name, $newName, $compressionLevel );
330 }
331 elsif ( -d $name ) {
332 return $self->addDirectory( $name, $newName );
333 }
334 else {
335 return _error("$name is neither a file nor a directory");
336 }
337}
338
339sub contents {
340 my $self = shift;
341
342 my ( $member, $newContents );
343 if ( ref( $_[0] ) eq 'HASH' ) {
344 $member = $_[0]->{memberOrZipName};
345 $newContents = $_[0]->{contents};
346 }
347 else {
348 ( $member, $newContents ) = @_;
349 }
350
351 return _error('No member name given') unless $member;
352 $member = $self->memberNamed($member) unless ref($member);
353 return undef unless $member;
354 return $member->contents($newContents);
355}
356
357sub writeToFileNamed {
358 my $self = shift;
359 my $fileName =
360 ( ref( $_[0] ) eq 'HASH' ) ? shift->{filename} : shift; # local FS format
361 foreach my $member ( $self->members() ) {
362 if ( $member->_usesFileNamed($fileName) ) {
363 return _error( "$fileName is needed by member "
364 . $member->fileName()
365 . "; consider using overwrite() or overwriteAs() instead." );
366 }
367 }
368 my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
369 return _ioError("Can't open $fileName for write") unless $status;
370 my $retval = $self->writeToFileHandle( $fh, 1 );
371 $fh->close();
372 $fh = undef;
373
374 return $retval;
375}
376
377# It is possible to write data to the FH before calling this,
378# perhaps to make a self-extracting archive.
379sub writeToFileHandle {
380 my $self = shift;
381
382 my ( $fh, $fhIsSeekable );
383 if ( ref( $_[0] ) eq 'HASH' ) {
384 $fh = $_[0]->{fileHandle};
385 $fhIsSeekable =
386 exists( $_[0]->{seek} ) ? $_[0]->{seek} : _isSeekable($fh);
387 }
388 else {
389 $fh = shift;
390 $fhIsSeekable = @_ ? shift : _isSeekable($fh);
391 }
392
393 return _error('No filehandle given') unless $fh;
394 return _ioError('filehandle not open') unless $fh->opened();
395 _binmode($fh);
396
397 # Find out where the current position is.
398 my $offset = $fhIsSeekable ? $fh->tell() : 0;
399 $offset = 0 if $offset < 0;
400
401 foreach my $member ( $self->members() ) {
402 my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
403 $member->endRead();
404 return $retval if $retval != AZ_OK;
405 $offset += $member->_localHeaderSize() + $member->_writeOffset();
406 $offset +=
407 $member->hasDataDescriptor()
408 ? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH
409 : 0;
410
411 # changed this so it reflects the last successful position
412 $self->{'writeCentralDirectoryOffset'} = $offset;
413 }
414 return $self->writeCentralDirectory($fh);
415}
416
417# Write zip back to the original file,
418# as safely as possible.
419# Returns AZ_OK if successful.
420sub overwrite {
421 my $self = shift;
422 return $self->overwriteAs( $self->{'fileName'} );
423}
424
425# Write zip to the specified file,
426# as safely as possible.
427# Returns AZ_OK if successful.
428sub overwriteAs {
429 my $self = shift;
430 my $zipName = ( ref( $_[0] ) eq 'HASH' ) ? $_[0]->{filename} : shift;
431 return _error("no filename in overwriteAs()") unless defined($zipName);
432
433 my ( $fh, $tempName ) = Archive::Zip::tempFile();
434 return _error( "Can't open temp file", $! ) unless $fh;
435
436 ( my $backupName = $zipName ) =~ s{(\.[^.]*)?$}{.zbk};
437
438 my $status = $self->writeToFileHandle($fh);
439 $fh->close();
440 $fh = undef;
441
442 if ( $status != AZ_OK ) {
443 unlink($tempName);
444 _printError("Can't write to $tempName");
445 return $status;
446 }
447
448 my $err;
449
450 # rename the zip
451 if ( -f $zipName && !rename( $zipName, $backupName ) ) {
452 $err = $!;
453 unlink($tempName);
454 return _error( "Can't rename $zipName as $backupName", $err );
455 }
456
457 # move the temp to the original name (possibly copying)
458 unless ( File::Copy::move( $tempName, $zipName ) ) {
459 $err = $!;
460 rename( $backupName, $zipName );
461 unlink($tempName);
462 return _error( "Can't move $tempName to $zipName", $err );
463 }
464
465 # unlink the backup
466 if ( -f $backupName && !unlink($backupName) ) {
467 $err = $!;
468 return _error( "Can't unlink $backupName", $err );
469 }
470
471 return AZ_OK;
472}
473
474# Used only during writing
475sub _writeCentralDirectoryOffset {
476 shift->{'writeCentralDirectoryOffset'};
477}
478
479sub _writeEOCDOffset {
480 shift->{'writeEOCDOffset'};
481}
482
483# Expects to have _writeEOCDOffset() set
484sub _writeEndOfCentralDirectory {
485 my ( $self, $fh ) = @_;
486
487 $self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
488 or return _ioError('writing EOCD Signature');
489 my $zipfileCommentLength = length( $self->zipfileComment() );
490
491 my $header = pack(
492 END_OF_CENTRAL_DIRECTORY_FORMAT,
493 0, # {'diskNumber'},
494 0, # {'diskNumberWithStartOfCentralDirectory'},
495 $self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'},
496 $self->numberOfMembers(), # {'numberOfCentralDirectories'},
497 $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
498 $self->_writeCentralDirectoryOffset(),
499 $zipfileCommentLength
500 );
501 $self->_print($fh, $header)
502 or return _ioError('writing EOCD header');
503 if ($zipfileCommentLength) {
504 $self->_print($fh, $self->zipfileComment() )
505 or return _ioError('writing zipfile comment');
506 }
507 return AZ_OK;
508}
509
510# $offset can be specified to truncate a zip file.
511sub writeCentralDirectory {
512 my $self = shift;
513
514 my ( $fh, $offset );
515 if ( ref( $_[0] ) eq 'HASH' ) {
516 $fh = $_[0]->{fileHandle};
517 $offset = $_[0]->{offset};
518 }
519 else {
520 ( $fh, $offset ) = @_;
521 }
522
523 if ( defined($offset) ) {
524 $self->{'writeCentralDirectoryOffset'} = $offset;
525 $fh->seek( $offset, IO::Seekable::SEEK_SET )
526 or return _ioError('seeking to write central directory');
527 }
528 else {
529 $offset = $self->_writeCentralDirectoryOffset();
530 }
531
532 foreach my $member ( $self->members() ) {
533 my $status = $member->_writeCentralDirectoryFileHeader($fh);
534 return $status if $status != AZ_OK;
535 $offset += $member->_centralDirectoryHeaderSize();
536 $self->{'writeEOCDOffset'} = $offset;
537 }
538 return $self->_writeEndOfCentralDirectory($fh);
539}
540
541
# spent 3.88s (5.72ms+3.87) within Archive::Zip::Archive::read which was called 210 times, avg 18.5ms/call: # 210 times (5.72ms+3.87s) by installer::archivefiles::resolving_archive_flag at line 253 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/archivefiles.pm, avg 18.5ms/call
sub read {
54221005.25ms my $self = shift;
543 my $fileName = ( ref( $_[0] ) eq 'HASH' ) ? shift->{filename} : shift;
544 return _error('No filename given') unless $fileName;
54521074.5ms my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
# spent 74.5ms making 210 calls to Archive::Zip::_newFileHandle, avg 355µs/call
546 return _ioError("opening $fileName for read") unless $status;
547
5482103.79s $status = $self->readFromFileHandle( $fh, $fileName );
# spent 3.79s making 210 calls to Archive::Zip::Archive::readFromFileHandle, avg 18.0ms/call
549 return $status if $status != AZ_OK;
550
5512109.07ms $fh->close();
# spent 9.07ms making 210 calls to IO::Handle::close, avg 43µs/call
552 $self->{'fileName'} = $fileName;
553 return AZ_OK;
554}
555
556
# spent 3.79s (344ms+3.44) within Archive::Zip::Archive::readFromFileHandle which was called 210 times, avg 18.0ms/call: # 210 times (344ms+3.44s) by Archive::Zip::Archive::read at line 548, avg 18.0ms/call
sub readFromFileHandle {
557115052275ms my $self = shift;
558
559 my ( $fh, $fileName );
560 if ( ref( $_[0] ) eq 'HASH' ) {
561 $fh = $_[0]->{fileHandle};
562 $fileName = $_[0]->{filename};
563 }
564 else {
565 ( $fh, $fileName ) = @_;
566 }
567
568 $fileName = $fh unless defined($fileName);
569 return _error('No filehandle given') unless $fh;
570210940µs return _ioError('filehandle not open') unless $fh->opened();
# spent 940µs making 210 calls to IO::Handle::opened, avg 4µs/call
571
5722107.35ms _binmode($fh);
# spent 7.35ms making 210 calls to Archive::Zip::_binmode, avg 35µs/call
573 $self->{'fileName'} = "$fh";
574
575 # TODO: how to support non-seekable zips?
57621014.1ms return _error('file not seekable')
# spent 14.1ms making 210 calls to Archive::Zip::_isSeekable, avg 67µs/call
577 unless _isSeekable($fh);
578
5792102.57ms $fh->seek( 0, 0 ); # rewind the file
# spent 2.57ms making 210 calls to IO::Seekable::seek, avg 12µs/call
580
58121023.2ms my $status = $self->_findEndOfCentralDirectory($fh);
# spent 23.2ms making 210 calls to Archive::Zip::Archive::_findEndOfCentralDirectory, avg 111µs/call
582 return $status if $status != AZ_OK;
583
5842101.19ms my $eocdPosition = $fh->tell();
# spent 1.19ms making 210 calls to IO::Seekable::tell, avg 6µs/call
585
58621011.0ms $status = $self->_readEndOfCentralDirectory($fh);
# spent 11.0ms making 210 calls to Archive::Zip::Archive::_readEndOfCentralDirectory, avg 52µs/call
587 return $status if $status != AZ_OK;
588
5894202.83ms $fh->seek( $eocdPosition - $self->centralDirectorySize(),
# spent 2.10ms making 210 calls to IO::Seekable::seek, avg 10µs/call # spent 736µs making 210 calls to Archive::Zip::Archive::centralDirectorySize, avg 4µs/call
590 IO::Seekable::SEEK_SET )
591 or return _ioError("Can't seek $fileName");
592
593 # Try to detect garbage at beginning of archives
594 # This should be 0
5954201.01ms $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
# spent 535µs making 210 calls to Archive::Zip::Archive::centralDirectoryOffsetWRTStartingDiskNumber, avg 3µs/call # spent 475µs making 210 calls to Archive::Zip::Archive::centralDirectorySize, avg 2µs/call
596 - $self->centralDirectoryOffsetWRTStartingDiskNumber();
597
598 for ( ; ; ) {
599305761.01s my $newMember =
# spent 971ms making 10192 calls to Archive::Zip::Member::_newFromZipFile, avg 95µs/call # spent 22.5ms making 10192 calls to Archive::Zip::Archive::eocdOffset, avg 2µs/call # spent 15.0ms making 10192 calls to Archive::Zip::ZIPMEMBERCLASS, avg 1µs/call
600 $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName,
601 $self->eocdOffset() );
602 my $signature;
60310192210ms ( $status, $signature ) = _readSignature( $fh, $fileName );
# spent 210ms making 10192 calls to Archive::Zip::_readSignature, avg 21µs/call
604 return $status if $status != AZ_OK;
605 last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
6069982718ms $status = $newMember->_readCentralDirectoryFileHeader();
# spent 718ms making 9982 calls to Archive::Zip::ZipFileMember::_readCentralDirectoryFileHeader, avg 72µs/call
607 return $status if $status != AZ_OK;
6089982158ms $status = $newMember->endRead();
# spent 158ms making 9982 calls to Archive::Zip::FileMember::endRead, avg 16µs/call
609 return $status if $status != AZ_OK;
61099821.29s $newMember->_becomeDirectoryIfNecessary();
# spent 1.29s making 9982 calls to Archive::Zip::Member::_becomeDirectoryIfNecessary, avg 129µs/call
611 push( @{ $self->{'members'} }, $newMember );
612 }
613
614 return AZ_OK;
615}
616
617# Read EOCD, starting from position before signature.
618# Return AZ_OK on success.
619
# spent 11.0ms (5.03+5.93) within Archive::Zip::Archive::_readEndOfCentralDirectory which was called 210 times, avg 52µs/call: # 210 times (5.03ms+5.93ms) by Archive::Zip::Archive::readFromFileHandle at line 586, avg 52µs/call
sub _readEndOfCentralDirectory {
62021005.30ms my $self = shift;
621 my $fh = shift;
622
623 # Skip past signature
6242102.09ms $fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
# spent 2.09ms making 210 calls to IO::Seekable::seek, avg 10µs/call
625 or return _ioError("Can't seek past EOCD signature");
626
627 my $header = '';
6282103.06ms my $bytesRead = $fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH );
# spent 3.06ms making 210 calls to IO::Handle::read, avg 15µs/call
629 if ( $bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH ) {
630 return _ioError("reading end of central directory");
631 }
632
633 my $zipfileCommentLength;
634 (
635210782µs $self->{'diskNumber'},
# spent 782µs making 210 calls to Archive::Zip::Archive::CORE:unpack, avg 4µs/call
636 $self->{'diskNumberWithStartOfCentralDirectory'},
637 $self->{'numberOfCentralDirectoriesOnThisDisk'},
638 $self->{'numberOfCentralDirectories'},
639 $self->{'centralDirectorySize'},
640 $self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
641 $zipfileCommentLength
642 ) = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
643
644 if ($zipfileCommentLength) {
645 my $zipfileComment = '';
646 $bytesRead = $fh->read( $zipfileComment, $zipfileCommentLength );
647 if ( $bytesRead != $zipfileCommentLength ) {
648 return _ioError("reading zipfile comment");
649 }
650 $self->{'zipfileComment'} = $zipfileComment;
651 }
652
653 return AZ_OK;
654}
655
656# Seek in my file to the end, then read backwards until we find the
657# signature of the central directory record. Leave the file positioned right
658# before the signature. Returns AZ_OK if success.
659
# spent 23.2ms (8.28+15.0) within Archive::Zip::Archive::_findEndOfCentralDirectory which was called 210 times, avg 111µs/call: # 210 times (8.28ms+15.0ms) by Archive::Zip::Archive::readFromFileHandle at line 581, avg 111µs/call
sub _findEndOfCentralDirectory {
66039906.87ms my $self = shift;
661 my $fh = shift;
662 my $data = '';
6632102.99ms $fh->seek( 0, IO::Seekable::SEEK_END )
# spent 2.99ms making 210 calls to IO::Seekable::seek, avg 14µs/call
664 or return _ioError("seeking to end");
665
6662101.46ms my $fileLength = $fh->tell();
# spent 1.46ms making 210 calls to IO::Seekable::tell, avg 7µs/call
667 if ( $fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4 ) {
668 return _formatError("file is too short");
669 }
670
671 my $seekOffset = 0;
672 my $pos = -1;
673 for ( ; ; ) {
674 $seekOffset += 512;
675 $seekOffset = $fileLength if ( $seekOffset > $fileLength );
6762102.81ms $fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
# spent 2.81ms making 210 calls to IO::Seekable::seek, avg 13µs/call
677 or return _ioError("seek failed");
6782105.37ms my $bytesRead = $fh->read( $data, $seekOffset );
# spent 5.37ms making 210 calls to IO::Handle::read, avg 26µs/call
679 if ( $bytesRead != $seekOffset ) {
680 return _ioError("read failed");
681 }
682 $pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
683 last
684 if ( $pos >= 0
685 or $seekOffset == $fileLength
686 or $seekOffset >= $Archive::Zip::ChunkSize );
687 }
688
689 if ( $pos >= 0 ) {
6902102.34ms $fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
# spent 2.34ms making 210 calls to IO::Seekable::seek, avg 11µs/call
691 or return _ioError("seeking to EOCD");
692 return AZ_OK;
693 }
694 else {
695 return _formatError("can't find EOCD signature");
696 }
697}
698
699# Used to avoid taint problems when chdir'ing.
700# Not intended to increase security in any way; just intended to shut up the -T
701# complaints. If your Cwd module is giving you unreliable returns from cwd()
702# you have bigger problems than this.
703sub _untaintDir {
704 my $dir = shift;
705 $dir =~ m/\A(.+)\z/s;
706 return $1;
707}
708
709sub addTree {
710 my $self = shift;
711
712 my ( $root, $dest, $pred, $compressionLevel );
713 if ( ref( $_[0] ) eq 'HASH' ) {
714 $root = $_[0]->{root};
715 $dest = $_[0]->{zipName};
716 $pred = $_[0]->{select};
717 $compressionLevel = $_[0]->{compressionLevel};
718 }
719 else {
720 ( $root, $dest, $pred, $compressionLevel ) = @_;
721 }
722
723 return _error("root arg missing in call to addTree()")
724 unless defined($root);
725 $dest = '' unless defined($dest);
726 $pred = sub { -r } unless defined($pred);
727
728 my @files;
729 my $startDir = _untaintDir( cwd() );
730
731 return _error( 'undef returned by _untaintDir on cwd ', cwd() )
732 unless $startDir;
733
734 # This avoids chdir'ing in Find, in a way compatible with older
735 # versions of File::Find.
736 my $wanted = sub {
737 local $main::_ = $File::Find::name;
738 my $dir = _untaintDir($File::Find::dir);
739 chdir($startDir);
740 push( @files, $File::Find::name ) if (&$pred);
741 chdir($dir);
742 };
743
744 File::Find::find( $wanted, $root );
745
746 my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
747 my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
748
749 $dest = _asZipDirName( $dest, 1 ); # with trailing slash
750
751 foreach my $fileName (@files) {
752 my $isDir = -d $fileName;
753
754 # normalize, remove leading ./
755 my $archiveName = _asZipDirName( $fileName, $isDir );
756 if ( $archiveName eq $rootZipName ) { $archiveName = $dest }
757 else { $archiveName =~ s{$pattern}{$dest} }
758 next if $archiveName =~ m{^\.?/?$}; # skip current dir
759 my $member = $isDir
760 ? $self->addDirectory( $fileName, $archiveName )
761 : $self->addFile( $fileName, $archiveName );
762 $member->desiredCompressionLevel($compressionLevel);
763
764 return _error("add $fileName failed in addTree()") if !$member;
765 }
766 return AZ_OK;
767}
768
769sub addTreeMatching {
770 my $self = shift;
771
772 my ( $root, $dest, $pattern, $pred, $compressionLevel );
773 if ( ref( $_[0] ) eq 'HASH' ) {
774 $root = $_[0]->{root};
775 $dest = $_[0]->{zipName};
776 $pattern = $_[0]->{pattern};
777 $pred = $_[0]->{select};
778 $compressionLevel = $_[0]->{compressionLevel};
779 }
780 else {
781 ( $root, $dest, $pattern, $pred, $compressionLevel ) = @_;
782 }
783
784 return _error("root arg missing in call to addTreeMatching()")
785 unless defined($root);
786 $dest = '' unless defined($dest);
787 return _error("pattern missing in call to addTreeMatching()")
788 unless defined($pattern);
789 my $matcher =
790 $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
791 return $self->addTree( $root, $dest, $matcher, $compressionLevel );
792}
793
794# $zip->extractTree( $root, $dest [, $volume] );
795#
796# $root and $dest are Unix-style.
797# $volume is in local FS format.
798#
799
# spent 43.2s (242ms+43.0) within Archive::Zip::Archive::extractTree which was called 210 times, avg 206ms/call: # 210 times (242ms+43.0s) by installer::archivefiles::resolving_archive_flag at line 280 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/archivefiles.pm, avg 206ms/call
sub extractTree {
80052010267ms my $self = shift;
801
802 my ( $root, $dest, $volume );
803 if ( ref( $_[0] ) eq 'HASH' ) {
804 $root = $_[0]->{root};
805 $dest = $_[0]->{zipName};
806 $volume = $_[0]->{volume};
807 }
808 else {
809 ( $root, $dest, $volume ) = @_;
810 }
811
812 $root = '' unless defined($root);
813 $dest = './' unless defined($dest);
814 my $pattern = "^\Q$root";
815210178ms my @members = $self->membersMatching($pattern);
# spent 178ms making 210 calls to Archive::Zip::Archive::membersMatching, avg 848µs/call
816
817 foreach my $member (@members) {
818998277.9ms my $fileName = $member->fileName(); # in Unix format
# spent 51.0ms making 8601 calls to Archive::Zip::Member::fileName, avg 6µs/call # spent 27.0ms making 1381 calls to Archive::Zip::DirectoryMember::fileName, avg 20µs/call
8191996466.0ms $fileName =~ s{$pattern}{$dest}; # in Unix format
# spent 56.8ms making 9982 calls to Archive::Zip::Archive::CORE:subst, avg 6µs/call # spent 9.22ms making 9982 calls to Archive::Zip::Archive::CORE:regcomp, avg 924ns/call
820 # convert to platform format:
82199821.99s $fileName = Archive::Zip::_asLocalName( $fileName, $volume );
# spent 1.99s making 9982 calls to Archive::Zip::_asLocalName, avg 200µs/call
822998240.7s my $status = $member->extractToFileNamed($fileName);
# spent 38.7s making 8601 calls to Archive::Zip::Member::extractToFileNamed, avg 4.50ms/call # spent 1.94s making 1381 calls to Archive::Zip::DirectoryMember::extractToFileNamed, avg 1.40ms/call
823 return $status if $status != AZ_OK;
824 }
825 return AZ_OK;
826}
827
828# $zip->updateMember( $memberOrName, $fileName );
829# Returns (possibly updated) member, if any; undef on errors.
830
831sub updateMember {
832 my $self = shift;
833
834 my ( $oldMember, $fileName );
835 if ( ref( $_[0] ) eq 'HASH' ) {
836 $oldMember = $_[0]->{memberOrZipName};
837 $fileName = $_[0]->{name};
838 }
839 else {
840 ( $oldMember, $fileName ) = @_;
841 }
842
843 if ( !defined($fileName) ) {
844 _error("updateMember(): missing fileName argument");
845 return undef;
846 }
847
848 my @newStat = stat($fileName);
849 if ( !@newStat ) {
850 _ioError("Can't stat $fileName");
851 return undef;
852 }
853
854 my $isDir = -d _;
855
856 my $memberName;
857
858 if ( ref($oldMember) ) {
859 $memberName = $oldMember->fileName();
860 }
861 else {
862 $oldMember = $self->memberNamed( $memberName = $oldMember )
863 || $self->memberNamed( $memberName =
864 _asZipDirName( $oldMember, $isDir ) );
865 }
866
867 unless ( defined($oldMember)
868 && $oldMember->lastModTime() == $newStat[9]
869 && $oldMember->isDirectory() == $isDir
870 && ( $isDir || ( $oldMember->uncompressedSize() == $newStat[7] ) ) )
871 {
872
873 # create the new member
874 my $newMember = $isDir
875 ? $self->ZIPMEMBERCLASS->newDirectoryNamed( $fileName, $memberName )
876 : $self->ZIPMEMBERCLASS->newFromFile( $fileName, $memberName );
877
878 unless ( defined($newMember) ) {
879 _error("creation of member $fileName failed in updateMember()");
880 return undef;
881 }
882
883 # replace old member or append new one
884 if ( defined($oldMember) ) {
885 $self->replaceMember( $oldMember, $newMember );
886 }
887 else { $self->addMember($newMember); }
888
889 return $newMember;
890 }
891
892 return $oldMember;
893}
894
895# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] );
896#
897# This takes the same arguments as addTree, but first checks to see
898# whether the file or directory already exists in the zip file.
899#
900# If the fourth argument $mirror is true, then delete all my members
901# if corresponding files weren't found.
902
903sub updateTree {
904 my $self = shift;
905
906 my ( $root, $dest, $pred, $mirror, $compressionLevel );
907 if ( ref( $_[0] ) eq 'HASH' ) {
908 $root = $_[0]->{root};
909 $dest = $_[0]->{zipName};
910 $pred = $_[0]->{select};
911 $mirror = $_[0]->{mirror};
912 $compressionLevel = $_[0]->{compressionLevel};
913 }
914 else {
915 ( $root, $dest, $pred, $mirror, $compressionLevel ) = @_;
916 }
917
918 return _error("root arg missing in call to updateTree()")
919 unless defined($root);
920 $dest = '' unless defined($dest);
921 $pred = sub { -r } unless defined($pred);
922
923 $dest = _asZipDirName( $dest, 1 );
924 my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
925 my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
926
927 my @files;
928 my $startDir = _untaintDir( cwd() );
929
930 return _error( 'undef returned by _untaintDir on cwd ', cwd() )
931 unless $startDir;
932
933 # This avoids chdir'ing in Find, in a way compatible with older
934 # versions of File::Find.
935 my $wanted = sub {
936 local $main::_ = $File::Find::name;
937 my $dir = _untaintDir($File::Find::dir);
938 chdir($startDir);
939 push( @files, $File::Find::name ) if (&$pred);
940 chdir($dir);
941 };
942
943 File::Find::find( $wanted, $root );
944
945 # Now @files has all the files that I could potentially be adding to
946 # the zip. Only add the ones that are necessary.
947 # For each file (updated or not), add its member name to @done.
948 my %done;
949 foreach my $fileName (@files) {
950 my @newStat = stat($fileName);
951 my $isDir = -d _;
952
953 # normalize, remove leading ./
954 my $memberName = _asZipDirName( $fileName, $isDir );
955 if ( $memberName eq $rootZipName ) { $memberName = $dest }
956 else { $memberName =~ s{$pattern}{$dest} }
957 next if $memberName =~ m{^\.?/?$}; # skip current dir
958
959 $done{$memberName} = 1;
960 my $changedMember = $self->updateMember( $memberName, $fileName );
961 $changedMember->desiredCompressionLevel($compressionLevel);
962 return _error("updateTree failed to update $fileName")
963 unless ref($changedMember);
964 }
965
966 # @done now has the archive names corresponding to all the found files.
967 # If we're mirroring, delete all those members that aren't in @done.
968 if ($mirror) {
969 foreach my $member ( $self->members() ) {
970 $self->removeMember($member)
971 unless $done{ $member->fileName() };
972 }
973 }
974
975 return AZ_OK;
976}
977
97819µs1;
 
# spent 14.2ms within Archive::Zip::Archive::CORE:match which was called 9982 times, avg 1µs/call: # 9982 times (14.2ms+0s) by Archive::Zip::Archive::membersMatching at line 88, avg 1µs/call
sub Archive::Zip::Archive::CORE:match; # opcode
# spent 14.0ms within Archive::Zip::Archive::CORE:regcomp which was called 19964 times, avg 699ns/call: # 9982 times (9.22ms+0s) by Archive::Zip::Archive::extractTree at line 819, avg 924ns/call # 9982 times (4.73ms+0s) by Archive::Zip::Archive::membersMatching at line 88, avg 474ns/call
sub Archive::Zip::Archive::CORE:regcomp; # opcode
# spent 56.8ms within Archive::Zip::Archive::CORE:subst which was called 9982 times, avg 6µs/call: # 9982 times (56.8ms+0s) by Archive::Zip::Archive::extractTree at line 819, avg 6µs/call
sub Archive::Zip::Archive::CORE:subst; # opcode
# spent 782µs within Archive::Zip::Archive::CORE:unpack which was called 210 times, avg 4µs/call: # 210 times (782µs+0s) by Archive::Zip::Archive::_readEndOfCentralDirectory at line 635, avg 4µs/call
sub Archive::Zip::Archive::CORE:unpack; # opcode
Report produced by the NYTProf 4.09 Perl profiler, developed by Tim Bunce and Adam Kaplan.