File Coverage

blib/lib/Archive/Zip/Archive.pm
Criterion Covered Total %
statement 309 414 74.6
branch 102 222 45.9
condition 16 34 47.1
subroutine 45 58 77.6
pod 37 37 100.0
total 509 765 66.5


line stmt bran cond sub pod time code
1             package Archive::Zip::Archive;
2              
3             # Represents a generic ZIP archive
4              
5 6     6   86 use strict;
  6         56  
  6         123  
6 6     6   108 use File::Path;
  6         55  
  6         198  
7 6     6   103 use File::Find ();
  6         56  
  6         58  
8 6     6   127 use File::Spec ();
  6         55  
  6         56  
9 6     6   240 use File::Copy ();
  6         62  
  6         64  
10 6     6   103 use File::Basename;
  6         53  
  6         140  
11 6     6   132 use Cwd;
  6         2811  
  6         207  
12              
13 6     6   202 use vars qw( $VERSION @ISA );
  6         158  
  6         96  
14              
15             BEGIN {
16 6     6   180     $VERSION = '1.18';
17 6         78     @ISA = qw( Archive::Zip );
18             }
19              
20 6         195 use Archive::Zip qw(
21             :CONSTANTS
22             :ERROR_CODES
23             :PKZIP_CONSTANTS
24             :UTILITY_METHODS
25 6     6   4634 );
  6         57  
26              
27             # Note that this returns undef on read errors, else new zip object.
28              
29             sub new {
30 7     7 1 72     my $class = shift;
31 7         310     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 7         82     $self->{'members'} = [];
49 7 50       85     if (@_) {
50 0         0         my $status = $self->read(@_);
51 0 0       0         return $status == AZ_OK ? $self : undef;
52                 }
53 7         81     return $self;
54             }
55              
56             sub members {
57 219     219 1 3110     @{ shift->{'members'} };
  219         5164  
58             }
59              
60             sub numberOfMembers {
61 42     42 1 942     scalar( shift->members() );
62             }
63              
64             sub memberNames {
65 5     5 1 558     my $self = shift;
66 5         174     return map { $_->fileName() } $self->members();
  27         394  
67             }
68              
69             # return ref to member with given name or undef
70             sub memberNamed {
71 67     67 1 833     my ( $self, $fileName ) = @_;
72 67         1169     foreach my $member ( $self->members() ) {
73 348 100       4868         return $member if $member->fileName() eq $fileName;
74                 }
75 24         395     return undef;
76             }
77              
78             sub membersMatching {
79 4     4 1 270     my ( $self, $pattern ) = @_;
80 4         63     return grep { $_->fileName() =~ /$pattern/ } $self->members();
  24         404  
81             }
82              
83             sub diskNumber {
84 0     0 1 0     shift->{'diskNumber'};
85             }
86              
87             sub diskNumberWithStartOfCentralDirectory {
88 0     0 1 0     shift->{'diskNumberWithStartOfCentralDirectory'};
89             }
90              
91             sub numberOfCentralDirectoriesOnThisDisk {
92 0     0 1 0     shift->{'numberOfCentralDirectoriesOnThisDisk'};
93             }
94              
95             sub numberOfCentralDirectories {
96 0     0 1 0     shift->{'numberOfCentralDirectories'};
97             }
98              
99             sub centralDirectorySize {
100 2     2 1 46     shift->{'centralDirectorySize'};
101             }
102              
103             sub centralDirectoryOffsetWRTStartingDiskNumber {
104 1     1 1 10     shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
105             }
106              
107             sub zipfileComment {
108 17     17 1 196     my $self = shift;
109 17         171     my $comment = $self->{'zipfileComment'};
110 17 50       168     if (@_) {
111 0         0         $self->{'zipfileComment'} = pack( 'C0a*', shift() ); # avoid unicode
112                 }
113 17         182     return $comment;
114             }
115              
116             sub eocdOffset {
117 6     6 1 151     shift->{'eocdOffset'};
118             }
119              
120             # Return the name of the file last read.
121             sub fileName {
122 0     0 1 0     shift->{'fileName'};
123             }
124              
125             sub removeMember {
126 4     4 1 280     my ( $self, $member ) = @_;
127 4 50       180     $member = $self->memberNamed($member) unless ref($member);
128 4 50       77     return undef unless $member;
129 4         201     my @newMembers = grep { $_ != $member } $self->members();
  28         341  
130 4         122     $self->{'members'} = \@newMembers;
131 4         88     return $member;
132             }
133              
134             sub replaceMember {
135 31     31 1 478     my ( $self, $oldMember, $newMember ) = @_;
136 31 50       486     $oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
137 31 50       303     return undef unless $oldMember;
138 31 50       322     return undef unless $newMember;
139 354 100       3737     my @newMembers =
140 31         373       map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
141 31         395     $self->{'members'} = \@newMembers;
142 31         445     return $oldMember;
143             }
144              
145             sub extractMember {
146 15     15 1 1079     my $self = shift;
147 15         441     my $member = shift;
148 15 100       1082     $member = $self->memberNamed($member) unless ref($member);
149 15 50       308     return _error('member not found') unless $member;
150 15         687     my $originalSize = $member->compressedSize();
151 15         151     my $name = shift; # local FS name if given
152 15         197     my ( $volumeName, $dirName, $fileName );
153 15 100       219     if ( defined($name) ) {
154 2         438         ( $volumeName, $dirName, $fileName ) = File::Spec->splitpath($name);
155 2         460         $dirName = File::Spec->catpath( $volumeName, $dirName, '' );
156                 }
157                 else {
158 13         242         $name = $member->fileName();
159 13         658         ( $dirName = $name ) =~ s{[^/]*$}{};
160 13         1132         $dirName = Archive::Zip::_asLocalName($dirName);
161 13         758         $name = Archive::Zip::_asLocalName($name);
162                 }
163 15 100 66     2683     if ( $dirName && !-d $dirName ) {
164 2         296         mkpath($dirName);
165 2 50       1488         return _ioError("can't create dir $dirName") if ( !-d $dirName );
166                 }
167 15         1755     my $rc = $member->extractToFileNamed( $name, @_ );
168              
169             # TODO refactor this fix into extractToFileNamed()
170 15         492     $member->{'compressedSize'} = $originalSize;
171 15         4341     return $rc;
172             }
173              
174             sub extractMemberWithoutPaths {
175 0     0 1 0     my $self = shift;
176 0         0     my $member = shift;
177 0 0       0     $member = $self->memberNamed($member) unless ref($member);
178 0 0       0     return _error('member not found') unless $member;
179 0         0     my $originalSize = $member->compressedSize();
180 0 0       0     return AZ_OK if $member->isDirectory();
181 0         0     my $name = shift;
182 0 0       0     unless ($name) {
183 0         0         $name = $member->fileName();
184 0         0         $name =~ s{.*/}{}; # strip off directories, if any
185 0         0         $name = Archive::Zip::_asLocalName($name);
186                 }
187 0         0     my $rc = $member->extractToFileNamed( $name, @_ );
188 0         0     $member->{'compressedSize'} = $originalSize;
189 0         0     return $rc;
190             }
191              
192             sub addMember {
193 42     42 1 562     my ( $self, $newMember ) = @_;
194 42 50       676     push( @{ $self->{'members'} }, $newMember ) if $newMember;
  42         592  
195 42         432     return $newMember;
196             }
197              
198             sub addFile {
199 23     23 1 272     my $self = shift;
200 23         311     my $fileName = shift;
201 23         255     my $newName = shift;
202 23         1521     my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
203 23 50       391     $self->addMember($newMember) if defined($newMember);
204 23         224     return $newMember;
205             }
206              
207             sub addString {
208 4     4 1 255     my $self = shift;
209 4         353     my $newMember = $self->ZIPMEMBERCLASS->newFromString(@_);
210 4         74     return $self->addMember($newMember);
211             }
212              
213             sub addDirectory {
214 1     1 1 233     my ( $self, $name, $newName ) = @_;
215 1         358     my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name, $newName );
216 1         31     $self->addMember($newMember);
217 1         12     return $newMember;
218             }
219              
220             # add either a file or a directory.
221              
222             sub addFileOrDirectory {
223 0     0 1 0     my ( $self, $name, $newName ) = @_;
224 0 0       0     if ( -f $name ) {
    0          
225 0 0       0         ( $newName =~ s{/$}{} ) if $newName;
226 0         0         return $self->addFile( $name, $newName );
227                 }
228                 elsif ( -d $name ) {
229 0 0       0         ( $newName =~ s{[^/]$}{&/} ) if $newName;
230 0         0         return $self->addDirectory( $name, $newName );
231                 }
232                 else {
233 0         0         return _error("$name is neither a file nor a directory");
234                 }
235             }
236              
237             sub contents {
238 1     1 1 149     my ( $self, $member, $newContents ) = @_;
239 1 50       84     return _error('No member name given') unless $member;
240 1 50       14     $member = $self->memberNamed($member) unless ref($member);
241 1 50       65     return undef unless $member;
242 1         106     return $member->contents($newContents);
243             }
244              
245             sub writeToFileNamed {
246 16     16 1 1225     my $self = shift;
247 16         412     my $fileName = shift; # local FS format
248 16         597     foreach my $member ( $self->members() ) {
249 62 50       1460         if ( $member->_usesFileNamed($fileName) ) {
250 0         0             return _error( "$fileName is needed by member "
251                               . $member->fileName()
252                               . "; consider using overwrite() or overwriteAs() instead." );
253                     }
254                 }
255 16         600     my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
256 16 50       681     return _ioError("Can't open $fileName for write") unless $status;
257 16         852     my $retval = $self->writeToFileHandle( $fh, 1 );
258 16         452     $fh->close();
259 16         1484     $fh = undef;
260              
261 16         267     return $retval;
262             }
263              
264             # It is possible to write data to the FH before calling this,
265             # perhaps to make a self-extracting archive.
266             sub writeToFileHandle {
267 17     17 1 616     my $self = shift;
268 17         3776     my $fh = shift;
269 17 50       302     return _error('No filehandle given') unless $fh;
270 17 50       602     return _ioError('filehandle not open') unless $fh->opened();
271              
272 17 100       608     my $fhIsSeekable = @_ ? shift: _isSeekable($fh);
273 17         224     _binmode($fh);
274              
275             # Find out where the current position is.
276 17 100       1043     my $offset = $fhIsSeekable ? $fh->tell() : 0;
277 17 50       475     $offset = 0 if $offset < 0;
278              
279 17         233     foreach my $member ( $self->members() ) {
280 71         1516         my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
281 71         1023         $member->endRead();
282 71 50       766         return $retval if $retval != AZ_OK;
283 71         1570         $offset += $member->_localHeaderSize() + $member->_writeOffset();
284 71 100       849         $offset +=
285                       $member->hasDataDescriptor()
286                       ? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH
287                       : 0;
288              
289             # changed this so it reflects the last successful position
290 71         1853         $self->{'writeCentralDirectoryOffset'} = $offset;
291                 }
292 17         980     return $self->writeCentralDirectory($fh);
293             }
294              
295             # Write zip back to the original file,
296             # as safely as possible.
297             # Returns AZ_OK if successful.
298             sub overwrite {
299 0     0 1 0     my $self = shift;
300 0         0     return $self->overwriteAs( $self->{'fileName'} );
301             }
302