lib/Archive/Zip/DirectoryMember.pm

   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.28';
  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;