Subversion Repositories DevTools

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
6954 dpurdie 1 
package Archive::Zip::DirectoryMember;
2 
 
3 
use strict;
4 
use File::Path;
5 
 
6 
use vars qw( $VERSION @ISA );
7 
 
8 
BEGIN {
9 
    $VERSION = '1.57';
10 
    @ISA     = qw( Archive::Zip::Member );
11 
}
12 
 
13 
use Archive::Zip qw(
14 
  :ERROR_CODES
15 
  :UTILITY_METHODS
16 
);
17 
 
18 
sub _newNamed {
19 
    my $class    = shift;
20 
    my $fileName = shift;    # FS name
21 
    my $newName  = shift;    # Zip name
22 
    $newName = _asZipDirName($fileName) unless $newName;
23 
    my $self = $class->new(@_);
24 
    $self->{'externalFileName'} = $fileName;
25 
    $self->fileName($newName);
26 
 
27 
    if (-e $fileName) {
28 
 
29 
        # -e does NOT do a full stat, so we need to do one now
30 
        if (-d _ ) {
31 
            my @stat = stat(_);
32 
            $self->unixFileAttributes($stat[2]);
33 
            my $mod_t = $stat[9];
34 
            if ($^O eq 'MSWin32' and !$mod_t) {
35 
                $mod_t = time();
36 
            }
37 
            $self->setLastModFileDateTimeFromUnix($mod_t);
38 
 
39 
        } else {    # hmm.. trying to add a non-directory?
40 
            _error($fileName, ' exists but is not a directory');
41 
            return undef;
42 
        }
43 
    } else {
44 
        $self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS);
45 
        $self->setLastModFileDateTimeFromUnix(time());
46 
    }
47 
    return $self;
48 
}
49 
 
50 
sub externalFileName {
51 
    shift->{'externalFileName'};
52 
}
53 
 
54 
sub isDirectory {
55 
    return 1;
56 
}
57 
 
58 
sub extractToFileNamed {
59 
    my $self    = shift;
60 
    my $name    = shift;                                 # local FS name
61 
    my $attribs = $self->unixFileAttributes() & 07777;
62 
    mkpath($name, 0, $attribs);                          # croaks on error
63 
    utime($self->lastModTime(), $self->lastModTime(), $name);
64 
    return AZ_OK;
65 
}
66 
 
67 
sub fileName {
68 
    my $self    = shift;
69 
    my $newName = shift;
70 
    $newName =~ s{/?$}{/} if defined($newName);
71 
    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 
    return wantarray ? (undef, AZ_OK) : undef;
78 
}
79 
 
80 
1;