File Coverage

blib/lib/Archive/Zip/DirectoryMember.pm
Criterion Covered Total %
statement 40 47 85.1
branch 7 12 58.3
condition 1 3 33.3
subroutine 9 11 81.8
pod 5 5 100.0
total 62 78 79.5


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