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.27_01';
  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     require Encode;
  25     $fileName = Encode::encode( 'cp437', $fileName );
  26     $newName = Encode::encode( 'cp437', $newName );
  27     $self->{'externalFileName'} = $fileName;
  28     $self->fileName($newName);
  29
  30     if ( -e $fileName ) {
  31
  32         # -e does NOT do a full stat, so we need to do one now
  33         if ( -d _ ) {
  34             my @stat = stat(_);
  35             $self->unixFileAttributes( $stat[2] );
  36             my $mod_t = $stat[9];
  37             if ( $^O eq 'MSWin32' and !$mod_t ) {
  38                 $mod_t = time();
  39             }
  40             $self->setLastModFileDateTimeFromUnix($mod_t);
  41
  42         } else {    # hmm.. trying to add a non-directory?
  43             _error( $fileName, ' exists but is not a directory' );
  44             return undef;
  45         }
  46     } else {
  47         $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
  48         $self->setLastModFileDateTimeFromUnix( time() );
  49     }
  50     return $self;
  51 }
  52
  53 sub externalFileName {
  54     shift->{'externalFileName'};
  55 }
  56
  57 sub isDirectory {
  58     return 1;
  59 }
  60
  61 sub extractToFileNamed {
  62     my $self    = shift;
  63     my $name    = shift;                                 # local FS name
  64     require Encode;
  65     $name = Encode::decode( 'cp437', $name );
  66     $name = Encode::encode( 'iso-8859-1', $name );
  67     my $attribs = $self->unixFileAttributes() & 07777;
  68     mkpath( $name, 0, $attribs );                        # croaks on error
  69     utime( $self->lastModTime(), $self->lastModTime(), $name );
  70     return AZ_OK;
  71 }
  72
  73 sub fileName {
  74     my $self    = shift;
  75     my $newName = shift;
  76     $newName =~ s{/?$}{/} if defined($newName);
  77     return $self->SUPER::fileName($newName);
  78 }
  79
  80 # So people don't get too confused. This way it looks like the problem
  81 # is in their code...
  82 sub contents {
  83     return wantarray ? ( undef, AZ_OK ) : undef;
  84 }
  85
  86 1;