File Coverage

blib/lib/Archive/Zip/DirectoryMember.pm
Criterion Covered Total %
statement 42 47 89.3
branch 8 12 66.6
condition 1 3 33.3
subroutine 9 11 81.8
pod 5 5 100.0
total 65 78 83.3


line stmt bran cond sub pod time code
1             package Archive::Zip::DirectoryMember;
2              
3 26     26   165 use strict;
  26         54  
  26         706  
4 26     26   130 use File::Path;
  26         54  
  26         1314  
5              
6 26     26   149 use vars qw( $VERSION @ISA );
  26         49  
  26         1367  
7              
8             BEGIN {
9 26     26   95 $VERSION = '1.66';
10 26         1103 @ISA = qw( Archive::Zip::Member );
11             }
12              
13 26         13234 use Archive::Zip qw(
14             :ERROR_CODES
15             :UTILITY_METHODS
16 26     26   174 );
  26         47  
17              
18             sub _newNamed {
19 11     11   33 my $class = shift;
20 11         30 my $fileName = shift; # FS name
21 11         22 my $newName = shift; # Zip name
22 11 100       70 $newName = _asZipDirName($fileName) unless $newName;
23 11         165 my $self = $class->new(@_);
24 11         50 $self->{'externalFileName'} = $fileName;
25 11         69 $self->fileName($newName);
26              
27 11 100       305 if (-e $fileName) {
28              
29             # -e does NOT do a full stat, so we need to do one now
30 9 50       33 if (-d _ ) {
31 9         47 my @stat = stat(_);
32 9         47 $self->unixFileAttributes($stat[2]);
33 9         16 my $mod_t = $stat[9];
34 9 50 33     87 if ($^O eq 'MSWin32' and !$mod_t) {
35 0         0 $mod_t = time();
36             }
37 9         66 $self->setLastModFileDateTimeFromUnix($mod_t);
38              
39             } else { # hmm.. trying to add a non-directory?
40 0         0 _error($fileName, ' exists but is not a directory');
41 0         0 return undef;
42             }
43             } else {
44 2         35 $self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS);
45 2         14 $self->setLastModFileDateTimeFromUnix(time());
46             }
47 11         35 return $self;
48             }
49              
50             sub externalFileName {
51 0     0 1 0 shift->{'externalFileName'};
52             }
53              
54             sub isDirectory {
55 31     31 1 102 return 1;
56             }
57              
58             sub extractToFileNamed {
59 12     12 1 23 my $self = shift;
60 12         24 my $name = shift; # local FS name
61 12         61 my $attribs = $self->unixFileAttributes() & 07777;
62 12         822 mkpath($name, 0, $attribs); # croaks on error
63 12         79 utime($self->lastModTime(), $self->lastModTime(), $name);
64 12         61 return AZ_OK;
65             }
66              
67             sub fileName {
68 314     314 1 1551 my $self = shift;
69 314         432 my $newName = shift;
70 314 100       692 $newName =~ s{/?$}{/} if defined($newName);
71 314         824 return $self->SUPER::fileName($newName);
72             }
73              
74             # So people don't get too confused. This way it looks like the problem
75             # is in their code...
76             sub contents {
77 0 0   0 1   return wantarray ? (undef, AZ_OK) : undef;
78             }
79              
80             1;