git.maemo.org Git - pkg-perl/blob - deb-src/libarchive-zip-perl/libarchive-zip-perl-1.18/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.18';
  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         }
  40         else {    # hmm.. trying to add a non-directory?
  41             _error( $fileName, ' exists but is not a directory' );
  42             return undef;
  43         }
  44     }
  45     else {
  46         $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
  47         $self->setLastModFileDateTimeFromUnix( time() );
  48     }
  49     return $self;
  50 }
  51
  52 sub externalFileName {
  53     shift->{'externalFileName'};
  54 }
  55
  56 sub isDirectory {
  57     return 1;
  58 }
  59
  60 sub extractToFileNamed {
  61     my $self    = shift;
  62     my $name    = shift;                                 # local FS name
  63     my $attribs = $self->unixFileAttributes() & 07777;
  64     mkpath( $name, 0, $attribs );                        # croaks on error
  65     utime( $self->lastModTime(), $self->lastModTime(), $name );
  66     return AZ_OK;
  67 }
  68
  69 sub fileName {
  70     my $self    = shift;
  71     my $newName = shift;
  72     $newName =~ s{/?$}{/} if defined($newName);
  73     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     return wantarray ? ( undef, AZ_OK ) : undef;
  80 }
  81
  82 1;