home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _f3e45554db4aa75b08f2c563ada7a186 < prev    next >
Encoding:
Text File  |  2004-06-01  |  74.4 KB  |  2,695 lines
  1. #! perl -w
  2. # $Revision: 1.82 $
  3.  
  4. # Copyright (c) 2000-2002 Ned Konz. All rights reserved.  This program is free
  5. # software; you can redistribute it and/or modify it under the same terms as
  6. # Perl itself.
  7.  
  8. # ----------------------------------------------------------------------
  9. # class Archive::Zip
  10. # Note that the package Archive::Zip exists only for exporting and
  11. # sharing constants. Everything else is in another package
  12. # in this file.
  13. # Creation of a new Archive::Zip object actually creates a new object
  14. # of class Archive::Zip::Archive.
  15. # ----------------------------------------------------------------------
  16.  
  17. package Archive::Zip;
  18. require 5.003_96;
  19. use strict;
  20.  
  21. use Carp();
  22. use IO::File();
  23. use IO::Seekable();
  24. use Compress::Zlib();
  25. use File::Spec 0.8 ();
  26.  
  27. use vars
  28.   qw( @ISA @EXPORT_OK %EXPORT_TAGS $VERSION $ChunkSize $ErrorHandler $TempSequence);
  29.  
  30. # This is the size we'll try to read, write, and (de)compress.
  31. # You could set it to something different if you had lots of memory
  32. # and needed more speed.
  33. $ChunkSize = 32768;
  34.  
  35. $ErrorHandler = \&Carp::carp;
  36.  
  37. # BEGIN block is necessary here so that other modules can use the constants.
  38. BEGIN
  39. {
  40.     require Exporter;
  41.  
  42.     $VERSION = "1.06";
  43.     @ISA = qw( Exporter );
  44.  
  45.     my @ConstantNames = qw( FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
  46.       GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
  47.       COMPRESSION_STORED COMPRESSION_DEFLATED COMPRESSION_LEVEL_NONE
  48.       COMPRESSION_LEVEL_DEFAULT COMPRESSION_LEVEL_FASTEST
  49.       COMPRESSION_LEVEL_BEST_COMPRESSION IFA_TEXT_FILE_MASK IFA_TEXT_FILE
  50.       IFA_BINARY_FILE );
  51.  
  52.     my @MiscConstantNames = qw( FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST
  53.       FA_OS2_HPFS FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
  54.       GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
  55.       GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
  56.       GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
  57.       DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
  58.       DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
  59.       COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
  60.       COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
  61.       COMPRESSION_DEFLATED_ENHANCED
  62.       COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED );
  63.  
  64.     my @ErrorCodeNames = qw( AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR
  65.       AZ_IO_ERROR );
  66.  
  67.     my @PKZipConstantNames = qw( SIGNATURE_FORMAT SIGNATURE_LENGTH
  68.       LOCAL_FILE_HEADER_SIGNATURE LOCAL_FILE_HEADER_FORMAT
  69.       LOCAL_FILE_HEADER_LENGTH DATA_DESCRIPTOR_FORMAT DATA_DESCRIPTOR_LENGTH
  70.       CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
  71.       CENTRAL_DIRECTORY_FILE_HEADER_FORMAT CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
  72.       END_OF_CENTRAL_DIRECTORY_SIGNATURE
  73.       END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING END_OF_CENTRAL_DIRECTORY_FORMAT
  74.       END_OF_CENTRAL_DIRECTORY_LENGTH );
  75.  
  76.     my @UtilityMethodNames = qw( _error _ioError _formatError
  77.       _subclassResponsibility _binmode _isSeekable _newFileHandle);
  78.  
  79.     @EXPORT_OK   = ('computeCRC32');
  80.     %EXPORT_TAGS = (
  81.         'CONSTANTS'      => \@ConstantNames,
  82.         'MISC_CONSTANTS' => \@MiscConstantNames,
  83.         'ERROR_CODES'    => \@ErrorCodeNames,
  84.  
  85.         # The following two sets are for internal use only
  86.         'PKZIP_CONSTANTS' => \@PKZipConstantNames,
  87.         'UTILITY_METHODS' => \@UtilityMethodNames
  88.     );
  89.  
  90.     # Add all the constant names and error code names to @EXPORT_OK
  91.     Exporter::export_ok_tags(
  92.         'CONSTANTS',       'ERROR_CODES',
  93.         'PKZIP_CONSTANTS', 'UTILITY_METHODS',
  94.         'MISC_CONSTANTS'
  95.     );
  96. }
  97.  
  98. # ------------------------- begin exportable error codes -------------------
  99.  
  100. use constant AZ_OK           => 0;
  101. use constant AZ_STREAM_END   => 1;
  102. use constant AZ_ERROR        => 2;
  103. use constant AZ_FORMAT_ERROR => 3;
  104. use constant AZ_IO_ERROR     => 4;
  105.  
  106. # ------------------------- end exportable error codes ---------------------
  107. # ------------------------- begin exportable constants ---------------------
  108.  
  109. # File types
  110. # Values of Archive::Zip::Member->fileAttributeFormat()
  111.  
  112. use constant FA_MSDOS => 0;
  113. use constant FA_UNIX  => 3;
  114.  
  115. # general-purpose bit flag masks
  116. # Found in Archive::Zip::Member->bitFlag()
  117.  
  118. use constant GPBF_ENCRYPTED_MASK             => 1 << 0;
  119. use constant GPBF_DEFLATING_COMPRESSION_MASK => 3 << 1;
  120. use constant GPBF_HAS_DATA_DESCRIPTOR_MASK   => 1 << 3;
  121.  
  122. # deflating compression types, if compressionMethod == COMPRESSION_DEFLATED
  123. # ( Archive::Zip::Member->bitFlag() & GPBF_DEFLATING_COMPRESSION_MASK )
  124.  
  125. use constant DEFLATING_COMPRESSION_NORMAL     => 0 << 1;
  126. use constant DEFLATING_COMPRESSION_MAXIMUM    => 1 << 1;
  127. use constant DEFLATING_COMPRESSION_FAST       => 2 << 1;
  128. use constant DEFLATING_COMPRESSION_SUPER_FAST => 3 << 1;
  129.  
  130. # compression method
  131.  
  132. # these two are the only ones supported in this module
  133. use constant COMPRESSION_STORED   => 0;    # file is stored (no compression)
  134. use constant COMPRESSION_DEFLATED => 8;    # file is Deflated
  135.  
  136. use constant COMPRESSION_LEVEL_NONE             => 0;
  137. use constant COMPRESSION_LEVEL_DEFAULT          => -1;
  138. use constant COMPRESSION_LEVEL_FASTEST          => 1;
  139. use constant COMPRESSION_LEVEL_BEST_COMPRESSION => 9;
  140.  
  141. # internal file attribute bits
  142. # Found in Archive::Zip::Member::internalFileAttributes()
  143.  
  144. use constant IFA_TEXT_FILE_MASK => 1;
  145. use constant IFA_TEXT_FILE      => 1;      # file is apparently text
  146. use constant IFA_BINARY_FILE    => 0;
  147.  
  148. # PKZIP file format miscellaneous constants (for internal use only)
  149. use constant SIGNATURE_FORMAT => "V";
  150. use constant SIGNATURE_LENGTH => 4;
  151.  
  152. use constant LOCAL_FILE_HEADER_SIGNATURE => 0x04034b50;
  153. use constant LOCAL_FILE_HEADER_FORMAT    => "v3 V4 v2";
  154. use constant LOCAL_FILE_HEADER_LENGTH    => 26;
  155.  
  156. use constant DATA_DESCRIPTOR_FORMAT => "V3";
  157. use constant DATA_DESCRIPTOR_LENGTH => 12;
  158.  
  159. use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE => 0x02014b50;
  160. use constant CENTRAL_DIRECTORY_FILE_HEADER_FORMAT    => "C2 v3 V4 v5 V2";
  161. use constant CENTRAL_DIRECTORY_FILE_HEADER_LENGTH    => 42;
  162.  
  163. use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE        => 0x06054b50;
  164. use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING =>
  165.   pack( "V", END_OF_CENTRAL_DIRECTORY_SIGNATURE );
  166. use constant END_OF_CENTRAL_DIRECTORY_FORMAT => "v4 V2 v";
  167. use constant END_OF_CENTRAL_DIRECTORY_LENGTH => 18;
  168.  
  169. use constant FA_AMIGA        => 1;
  170. use constant FA_VAX_VMS      => 2;
  171. use constant FA_VM_CMS       => 4;
  172. use constant FA_ATARI_ST     => 5;
  173. use constant FA_OS2_HPFS     => 6;
  174. use constant FA_MACINTOSH    => 7;
  175. use constant FA_Z_SYSTEM     => 8;
  176. use constant FA_CPM          => 9;
  177. use constant FA_WINDOWS_NTFS => 10;
  178.  
  179. use constant GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK => 1 << 1;
  180. use constant GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK  => 1 << 2;
  181. use constant GPBF_IS_COMPRESSED_PATCHED_DATA_MASK      => 1 << 5;
  182.  
  183. # the rest of these are not supported in this module
  184. use constant COMPRESSION_SHRUNK    => 1;    # file is Shrunk
  185. use constant COMPRESSION_REDUCED_1 => 2;    # file is Reduced CF=1
  186. use constant COMPRESSION_REDUCED_2 => 3;    # file is Reduced CF=2
  187. use constant COMPRESSION_REDUCED_3 => 4;    # file is Reduced CF=3
  188. use constant COMPRESSION_REDUCED_4 => 5;    # file is Reduced CF=4
  189. use constant COMPRESSION_IMPLODED  => 6;    # file is Imploded
  190. use constant COMPRESSION_TOKENIZED => 7;    # reserved for Tokenizing compr.
  191. use constant COMPRESSION_DEFLATED_ENHANCED => 9;   # reserved for enh. Deflating
  192. use constant COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED => 10;
  193.  
  194. # ------------------------- end of exportable constants ---------------------
  195.  
  196. use constant ZIPARCHIVECLASS => 'Archive::Zip::Archive';
  197. use constant ZIPMEMBERCLASS  => 'Archive::Zip::Member';
  198.  
  199. sub new    # Archive::Zip
  200. {
  201.     my $class = shift;
  202.     return $class->ZIPARCHIVECLASS->new(@_);
  203. }
  204.  
  205. sub computeCRC32    # Archive::Zip
  206. {
  207.     my $data = shift;
  208.     $data = shift if ref($data);    # allow calling as an obj method
  209.     my $crc = shift;
  210.     return Compress::Zlib::crc32( $data, $crc );
  211. }
  212.  
  213. # Report or change chunk size used for reading and writing.
  214. # Also sets Zlib's default buffer size (eventually).
  215. sub setChunkSize    # Archive::Zip
  216. {
  217.     my $chunkSize = shift;
  218.     $chunkSize = shift if ref($chunkSize);    # object method on zip?
  219.     my $oldChunkSize = $Archive::Zip::ChunkSize;
  220.     $Archive::Zip::ChunkSize = $chunkSize if ($chunkSize);
  221.     return $oldChunkSize;
  222. }
  223.  
  224. sub chunkSize    # Archive::Zip
  225. {
  226.     return $Archive::Zip::ChunkSize;
  227. }
  228.  
  229. sub setErrorHandler (&)    # Archive::Zip
  230. {
  231.     my $errorHandler = shift;
  232.     $errorHandler = \&Carp::carp unless defined($errorHandler);
  233.     my $oldErrorHandler = $Archive::Zip::ErrorHandler;
  234.     $Archive::Zip::ErrorHandler = $errorHandler;
  235.     return $oldErrorHandler;
  236. }
  237.  
  238. sub _printError    # Archive::Zip
  239. {
  240.     my $string = join ( ' ', @_, "\n" );
  241.     my $oldCarpLevel = $Carp::CarpLevel;
  242.     $Carp::CarpLevel += 2;
  243.     &{$ErrorHandler} ($string);
  244.     $Carp::CarpLevel = $oldCarpLevel;
  245. }
  246.  
  247. # This is called on format errors.
  248. sub _formatError    # Archive::Zip
  249. {
  250.     shift if ref( $_[0] );
  251.     _printError( 'format error:', @_ );
  252.     return AZ_FORMAT_ERROR;
  253. }
  254.  
  255. # This is called on IO errors.
  256. sub _ioError    # Archive::Zip
  257. {
  258.     shift if ref( $_[0] );
  259.     _printError( 'IO error:', @_, ':', $! );
  260.     return AZ_IO_ERROR;
  261. }
  262.  
  263. # This is called on generic errors.
  264. sub _error    # Archive::Zip
  265. {
  266.     shift if ref( $_[0] );
  267.     _printError( 'error:', @_ );
  268.     return AZ_ERROR;
  269. }
  270.  
  271. # Called when a subclass should have implemented
  272. # something but didn't
  273. sub _subclassResponsibility    # Archive::Zip
  274. {
  275.     Carp::croak("subclass Responsibility\n");
  276. }
  277.  
  278. # Try to set the given file handle or object into binary mode.
  279. sub _binmode    # Archive::Zip
  280. {
  281.     my $fh = shift;
  282.     return UNIVERSAL::can( $fh, 'binmode' )
  283.         ? $fh->binmode()
  284.         : binmode($fh);
  285. }
  286.  
  287. # Attempt to guess whether file handle is seekable.
  288. # Because of problems with Windoze, this only returns true when
  289. # the file handle is a real file.
  290. sub _isSeekable    # Archive::Zip
  291. {
  292.     my $fh = shift;
  293.  
  294.     if ( UNIVERSAL::isa( $fh, 'IO::Scalar' ) )
  295.     {
  296.         return 0;
  297.     }
  298.     elsif ( UNIVERSAL::isa( $fh, 'IO::String' ) )
  299.     {
  300.         return 1;
  301.     }
  302.     elsif ( UNIVERSAL::can( $fh, 'stat' ) )
  303.     {
  304.         return -f $fh;
  305.     }
  306.     return UNIVERSAL::can( $fh, 'seek' );
  307. }
  308.  
  309. # Return an opened IO::Handle
  310. # my ( $status, fh ) = _newFileHandle( 'fileName', 'w' );
  311. # Can take a filename, file handle, or ref to GLOB
  312. # Or, if given something that is a ref but not an IO::Handle,
  313. # passes back the same thing.
  314. sub _newFileHandle    # Archive::Zip
  315. {
  316.     my $fd     = shift;
  317.     my $status = 1;
  318.     my $handle;
  319.  
  320.     if ( ref($fd) )
  321.     {
  322.         if ( UNIVERSAL::isa( $fd, 'IO::Scalar' )
  323.             or UNIVERSAL::isa( $fd, 'IO::String' ) )
  324.         {
  325.             $handle = $fd;
  326.         }
  327.         elsif ( UNIVERSAL::isa( $fd, 'IO::Handle' )
  328.             or UNIVERSAL::isa( $fd, 'GLOB' ) )
  329.         {
  330.             $handle = IO::File->new();
  331.             $status = $handle->fdopen( $fd, @_ );
  332.         }
  333.         else
  334.         {
  335.             $handle = $fd;
  336.         }
  337.     }
  338.     else
  339.     {
  340.         $handle = IO::File->new();
  341.         $status = $handle->open( $fd, @_ );
  342.     }
  343.  
  344.     return ( $status, $handle );
  345. }
  346.  
  347. # Utility method to make and open a temp file.
  348. # Will create $temp_dir if it doesn't exist.
  349. # Returns file handle and name:
  350. #
  351. # my ($fh, $name) = Archive::Zip::tempFile();
  352. # my ($fh, $name) = Archive::Zip::tempFile('mytempdir');
  353. #
  354. BEGIN { $Archive::Zip::TempSequence = 0 }
  355.  
  356. sub tempFileName    # Archive::Zip
  357. {
  358.     my $temp_dir = shift ()
  359.       || ( -d '/tmp' ? '/tmp' : $ENV{TMPDIR} || $ENV{TEMP} || '.' );
  360.     unless ( -d $temp_dir )
  361.     {
  362.         mkdir($temp_dir, 0777) or die "Can't create temp directory $temp_dir\: $!\n";
  363.     }
  364.     my $base_name =
  365.       sprintf( "%d-%d.%d", $$, time(), $Archive::Zip::TempSequence++ );
  366.     return File::Spec->canonpath(
  367.         File::Spec->catpath( '', $temp_dir, $base_name ) );
  368. }
  369.  
  370. sub tempFile    # Archive::Zip
  371. {
  372.     my $full_name = tempFileName(@_);
  373.     my $fh = IO::File->new( $full_name, '+>' );
  374.     return defined($fh) ? ( $fh, $full_name ) : ();
  375. }
  376.  
  377. # Return the normalized directory name as used in a zip file (path
  378. # separators become slashes, etc.). 
  379. # Will translate internal slashes in path components (i.e. on Macs) to
  380. # underscores.  Discards volume names.
  381. # When $forceDir is set, returns paths with trailing slashes (or arrays
  382. # with trailing blank members).
  383. #
  384. # If third argument is a reference, returns volume information there.
  385. #
  386. # input         output
  387. # .                ('.')    '.'
  388. # ./a            ('a')    a
  389. # ./a/b            ('a','b')    a/b
  390. # ./a/b/        ('a','b')    a/b
  391. # a/b/            ('a','b')    a/b
  392. # /a/b/            ('','a','b')    /a/b
  393. # c:\a\b\c.doc    ('','a','b','c.doc')    /a/b/c.doc        # on Windoze
  394. # "i/o maps:whatever"    ('i_o maps', 'whatever')  "i_o maps/whatever"    # on Macs
  395. sub _asZipDirName    # Archive::Zip
  396. {
  397.     my $name      = shift;
  398.     my $forceDir  = shift;
  399.     my $volReturn = shift;
  400.     my ( $volume, $directories, $file ) =
  401.       File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
  402.     $$volReturn = $volume if ( ref($volReturn) );
  403.     my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories);
  404.     if ( @dirs > 0 ) { pop (@dirs) unless $dirs[-1] }   # remove empty component
  405.     push ( @dirs, $file || '' );
  406.     return wantarray ? @dirs : join ( '/', @dirs );
  407. }
  408.  
  409. # Return an absolute local name for a zip name.
  410. # Assume a directory if zip name has trailing slash.
  411. # Takes an optional volume name in FS format (like 'a:').
  412. #
  413. sub _asLocalName    # Archive::Zip
  414. {
  415.     my $name   = shift;    # zip format
  416.     my $volume = shift || '';    # local FS format
  417.  
  418.     my @paths     = split ( /\//, $name );
  419.     my $filename  = pop (@paths);
  420.     my $localDirs = File::Spec->catdir(@paths);
  421.     my $localName = File::Spec->catpath( $volume, $localDirs, $filename );
  422.     $localName = File::Spec->rel2abs($localName) unless $volume;
  423.     return $localName;
  424. }
  425.  
  426. # ----------------------------------------------------------------------
  427. # class Archive::Zip::Archive (concrete)
  428. # Generic ZIP archive.
  429. # ----------------------------------------------------------------------
  430. package Archive::Zip::Archive;
  431. use File::Path;
  432. use File::Find();
  433. use File::Spec();
  434. use File::Copy();
  435. use File::Basename;
  436. use Cwd;
  437.  
  438. use vars qw( @ISA );
  439. @ISA = qw( Archive::Zip );
  440.  
  441. BEGIN
  442. {
  443.     use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
  444.       :UTILITY_METHODS );
  445. }
  446.  
  447. # Note that this returns undef on read errors, else new zip object.
  448.  
  449. sub new    # Archive::Zip::Archive
  450. {
  451.     my $class = shift;
  452.     my $self = bless( {
  453.           'diskNumber'                            => 0,
  454.           'diskNumberWithStartOfCentralDirectory' => 0,
  455.           'numberOfCentralDirectoriesOnThisDisk'  => 0,   # shld be # of members
  456.           'numberOfCentralDirectories'            => 0,   # shld be # of members
  457.           'centralDirectorySize' => 0,    # must re-compute on write
  458.           'centralDirectoryOffsetWRTStartingDiskNumber' => 0,  # must re-compute
  459.           'writeEOCDOffset'             => 0,
  460.           'writeCentralDirectoryOffset' => 0,
  461.           'zipfileComment'              => '',
  462.           'eocdOffset'                  => 0,
  463.           'fileName'                    => ''
  464.       },
  465.       $class
  466.     );
  467.     $self->{'members'} = [];
  468.     if (@_)
  469.     {
  470.         my $status = $self->read(@_);
  471.         return $status == AZ_OK ? $self : undef;
  472.     }
  473.     return $self;
  474. }
  475.  
  476. sub members    # Archive::Zip::Archive
  477. {
  478.     @{ shift->{'members'} };
  479. }
  480.  
  481. sub numberOfMembers    # Archive::Zip::Archive
  482. {
  483.     scalar( shift->members() );
  484. }
  485.  
  486. sub memberNames    # Archive::Zip::Archive
  487. {
  488.     my $self = shift;
  489.     return map { $_->fileName() } $self->members();
  490. }
  491.  
  492. # return ref to member with given name or undef
  493. sub memberNamed    # Archive::Zip::Archive
  494. {
  495.     my ( $self, $fileName ) = @_;
  496.     foreach my $member ( $self->members() )
  497.     {
  498.         return $member if $member->fileName() eq $fileName;
  499.     }
  500.     return undef;
  501. }
  502.  
  503. sub membersMatching    # Archive::Zip::Archive
  504. {
  505.     my ( $self, $pattern ) = @_;
  506.     return grep { $_->fileName() =~ /$pattern/ } $self->members();
  507. }
  508.  
  509. sub diskNumber    # Archive::Zip::Archive
  510. {
  511.     shift->{'diskNumber'};
  512. }
  513.  
  514. sub diskNumberWithStartOfCentralDirectory    # Archive::Zip::Archive
  515. {
  516.     shift->{'diskNumberWithStartOfCentralDirectory'};
  517. }
  518.  
  519. sub numberOfCentralDirectoriesOnThisDisk    # Archive::Zip::Archive
  520. {
  521.     shift->{'numberOfCentralDirectoriesOnThisDisk'};
  522. }
  523.  
  524. sub numberOfCentralDirectories    # Archive::Zip::Archive
  525. {
  526.     shift->{'numberOfCentralDirectories'};
  527. }
  528.  
  529. sub centralDirectorySize    # Archive::Zip::Archive
  530. {
  531.     shift->{'centralDirectorySize'};
  532. }
  533.  
  534. sub centralDirectoryOffsetWRTStartingDiskNumber    # Archive::Zip::Archive
  535. {
  536.     shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
  537. }
  538.  
  539. sub zipfileComment    # Archive::Zip::Archive
  540. {
  541.     my $self    = shift;
  542.     my $comment = $self->{'zipfileComment'};
  543.     if (@_)
  544.     {
  545.         $self->{'zipfileComment'} = shift;
  546.     }
  547.     return $comment;
  548. }
  549.  
  550. sub eocdOffset    # Archive::Zip::Archive
  551. {
  552.     shift->{'eocdOffset'};
  553. }
  554.  
  555. # Return the name of the file last read.
  556. sub fileName    # Archive::Zip::Archive
  557. {
  558.     shift->{'fileName'};
  559. }
  560.  
  561. sub removeMember    # Archive::Zip::Archive
  562. {
  563.     my ( $self, $member ) = @_;
  564.     $member = $self->memberNamed($member) unless ref($member);
  565.     return undef unless $member;
  566.     my @newMembers = grep { $_ != $member } $self->members();
  567.     $self->{'members'} = \@newMembers;
  568.     return $member;
  569. }
  570.  
  571. sub replaceMember    # Archive::Zip::Archive
  572. {
  573.     my ( $self, $oldMember, $newMember ) = @_;
  574.     $oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
  575.     return undef unless $oldMember;
  576.     my @newMembers =
  577.       map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
  578.     $self->{'members'} = \@newMembers;
  579.     return $oldMember;
  580. }
  581.  
  582. sub extractMember    # Archive::Zip::Archive
  583. {
  584.     my $self   = shift;
  585.     my $member = shift;
  586.     $member = $self->memberNamed($member) unless ref($member);
  587.     return _error('member not found') unless $member;
  588.     my $name = shift;    # local FS name if given
  589.     my ( $volumeName, $dirName, $fileName );
  590.     if ( defined($name) )
  591.     {
  592.         ( $volumeName, $dirName, $fileName ) = File::Spec->splitpath($name);
  593.         $dirName = File::Spec->catpath( $volumeName, $dirName, '' );
  594.     }
  595.     else
  596.     {
  597.         $name = $member->fileName();
  598.         ( $dirName = $name ) =~ s{[^/]*$}{};
  599.         $dirName = Archive::Zip::_asLocalName($dirName);
  600.         $name    = Archive::Zip::_asLocalName($name);
  601.     }
  602.     if ( $dirName && !-d $dirName )
  603.     {
  604.         mkpath($dirName);
  605.         return _ioError("can't create dir $dirName") if ( !-d $dirName );
  606.     }
  607.     return $member->extractToFileNamed( $name, @_ );
  608. }
  609.  
  610. sub extractMemberWithoutPaths    # Archive::Zip::Archive
  611. {
  612.     my $self   = shift;
  613.     my $member = shift;
  614.     $member = $self->memberNamed($member) unless ref($member);
  615.     return _error('member not found') unless $member;
  616.     return AZ_OK if $member->isDirectory();
  617.     my $name = shift;
  618.     unless ($name)
  619.     {
  620.         $name = $member->fileName();
  621.         $name =~ s{.*/}{}; # strip off directories, if any
  622.         $name = Archive::Zip::_asLocalName($name);
  623.     }
  624.     return $member->extractToFileNamed( $name, @_ );
  625. }
  626.  
  627. sub addMember    # Archive::Zip::Archive
  628. {
  629.     my ( $self, $newMember ) = @_;
  630.     push ( @{ $self->{'members'} }, $newMember ) if $newMember;
  631.     return $newMember;
  632. }
  633.  
  634. sub addFile    # Archive::Zip::Archive
  635. {
  636.     my $self      = shift;
  637.     my $fileName  = shift;
  638.     my $newName   = shift;
  639.     my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
  640.     $self->addMember($newMember) if defined($newMember);
  641.     return $newMember;
  642. }
  643.  
  644. sub addString    # Archive::Zip::Archive
  645. {
  646.     my $self      = shift;
  647.     my $newMember = $self->ZIPMEMBERCLASS->newFromString(@_);
  648.     return $self->addMember($newMember);
  649. }
  650.  
  651. sub addDirectory    # Archive::Zip::Archive
  652. {
  653.     my ( $self, $name, $newName ) = @_;
  654.     my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed($name, $newName);
  655.     $self->addMember($newMember);
  656.     return $newMember;
  657. }
  658.  
  659. # add either a file or a directory.
  660.  
  661. sub addFileOrDirectory
  662. {
  663.     my ( $self, $name, $newName ) = @_;
  664.     if ( -f $name )
  665.     {
  666.         ( $newName =~ s{/$}{} ) if $newName;
  667.         return $self->addFile( $name, $newName );
  668.     }
  669.     elsif ( -d $name )
  670.     {
  671.         ( $newName =~ s{[^/]$}{&/} ) if $newName;
  672.         return $self->addDirectory( $name, $newName );
  673.     }
  674.     else
  675.     {
  676.         return _error("$name is neither a file nor a directory");
  677.     }
  678. }
  679.  
  680. sub contents    # Archive::Zip::Archive
  681. {
  682.     my ( $self, $member, $newContents ) = @_;
  683.     $member = $self->memberNamed($member) unless ref($member);
  684.     return undef unless $member;
  685.     return $member->contents($newContents);
  686. }
  687.  
  688. sub writeToFileNamed    # Archive::Zip::Archive
  689. {
  690.     my $self     = shift;
  691.     my $fileName = shift;    # local FS format
  692.     foreach my $member ( $self->members() )
  693.     {
  694.         if ( $member->_usesFileNamed($fileName) )
  695.         {
  696.             return _error( "$fileName is needed by member "
  697.                 . $member->fileName()
  698.                 . "; consider using overwrite() or overwriteAs() instead." );
  699.         }
  700.     }
  701.     my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
  702.     return _ioError("Can't open $fileName for write") unless $status;
  703.     my $retval = $self->writeToFileHandle( $fh, 1 );
  704.     $fh->close();
  705.     return $retval;
  706. }
  707.  
  708. # It is possible to write data to the FH before calling this,
  709. # perhaps to make a self-extracting archive.
  710. sub writeToFileHandle    # Archive::Zip::Archive
  711. {
  712.     my $self         = shift;
  713.     my $fh           = shift;
  714.     my $fhIsSeekable = @_ ? shift: _isSeekable($fh);
  715.     _binmode($fh);
  716.  
  717.     # Find out where the current position is.
  718.     my $offset = $fhIsSeekable ? $fh->tell() : 0;
  719.     $offset = 0 if $offset < 0;
  720.  
  721.     foreach my $member ( $self->members() )
  722.     {
  723.         my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
  724.         $member->endRead();
  725.         return $retval if $retval != AZ_OK;
  726.         $offset += $member->_localHeaderSize() + $member->_writeOffset();
  727.         $offset += $member->hasDataDescriptor() ? DATA_DESCRIPTOR_LENGTH: 0;
  728.  
  729.         # changed this so it reflects the last successful position
  730.         $self->{'writeCentralDirectoryOffset'} = $offset;
  731.     }
  732.     return $self->writeCentralDirectory($fh);
  733. }
  734.  
  735. # Write zip back to the original file,
  736. # as safely as possible.
  737. # Returns AZ_OK if successful.
  738. sub overwrite    # Archive::Zip::Archive
  739. {
  740.     my $self = shift;
  741.     return $self->overwriteAs( $self->{'fileName'} );
  742. }
  743.  
  744. # Write zip to the specified file,
  745. # as safely as possible.
  746. # Returns AZ_OK if successful.
  747. sub overwriteAs    # Archive::Zip::Archive
  748. {
  749.     my $self    = shift;
  750.     my $zipName = shift || return _error("no filename in overwriteAs()");
  751.  
  752.     my ( $fh, $tempName ) = Archive::Zip::tempFile();
  753.     return _error( "Can't open temp file", $! ) unless $fh;
  754.     ( my $backupName = $zipName ) =~ s{\.[^.]*$}{.zbk};
  755.     my $status;
  756.  
  757.     if ( ( $status = $self->writeToFileHandle($fh) ) == AZ_OK )
  758.     {
  759.         my $err;
  760.         $fh->close();
  761.  
  762.         # rename the zip
  763.         if ( -f $zipName && !rename( $zipName, $backupName ) )
  764.         {
  765.             $err = $!;
  766.             unlink($tempName);
  767.             return _error( "Can't rename $zipName as $backupName", $err );
  768.         }
  769.  
  770.         # move the temp to the original name (possibly copying)
  771.         unless ( File::Copy::move( $tempName, $zipName ) )
  772.         {
  773.             $err = $!;
  774.             rename( $backupName, $zipName );
  775.             unlink($tempName);
  776.             return _error( "Can't move $tempName to $zipName", $err );
  777.         }
  778.  
  779.         # unlink the backup
  780.         if ( -f $backupName && !unlink($backupName) )
  781.         {
  782.             $err = $!;
  783.             return _error( "Can't unlink $backupName", $err );
  784.         }
  785.         return AZ_OK;
  786.     }
  787.     else
  788.     {
  789.         $fh->close();
  790.         unlink($tempName);
  791.         _printError("Can't write to $tempName");
  792.         return $status;
  793.     }
  794. }
  795.  
  796. # Returns next signature from given file handle, leaves
  797. # file handle positioned afterwards.
  798. # In list context, returns ($status, $signature)
  799.  
  800. sub _readSignature    # Archive::Zip::Archive
  801. {
  802.     my $self     = shift;
  803.     my $fh       = shift;
  804.     my $fileName = shift;
  805.     my $signatureData;
  806.     my $bytesRead = $fh->read( $signatureData, SIGNATURE_LENGTH );
  807.     if ( $bytesRead != SIGNATURE_LENGTH )
  808.     {
  809.         return _ioError("reading header signature");
  810.     }
  811.     my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
  812.     my $status    = AZ_OK;
  813.     if ( $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
  814.         and $signature != LOCAL_FILE_HEADER_SIGNATURE
  815.         and $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE )
  816.     {
  817.         my $errmsg = sprintf( "bad signature: 0x%08x", $signature );
  818.         if ( _isSeekable( $fh ) )
  819.         {
  820.             $errmsg .=
  821.               sprintf( " at offset %d", $fh->tell() - SIGNATURE_LENGTH );
  822.         }
  823.  
  824.         $status = _formatError("$errmsg in file $fileName");
  825.     }
  826.  
  827.     return ( $status, $signature );
  828. }
  829.  
  830. # Used only during writing
  831. sub _writeCentralDirectoryOffset    # Archive::Zip::Archive
  832. {
  833.     shift->{'writeCentralDirectoryOffset'};
  834. }
  835.  
  836. sub _writeEOCDOffset    # Archive::Zip::Archive
  837. {
  838.     shift->{'writeEOCDOffset'};
  839. }
  840.  
  841. # Expects to have _writeEOCDOffset() set
  842. sub _writeEndOfCentralDirectory    # Archive::Zip::Archive
  843. {
  844.     my ( $self, $fh ) = @_;
  845.  
  846.     $fh->print(END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
  847.       or return _ioError('writing EOCD Signature');
  848.     my $zipfileCommentLength = length( $self->zipfileComment() );
  849.  
  850.     my $header = pack(
  851.         END_OF_CENTRAL_DIRECTORY_FORMAT,
  852.         0,                          # {'diskNumber'},
  853.         0,                          # {'diskNumberWithStartOfCentralDirectory'},
  854.         $self->numberOfMembers(),   # {'numberOfCentralDirectoriesOnThisDisk'},
  855.         $self->numberOfMembers(),   # {'numberOfCentralDirectories'},
  856.         $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
  857.         $self->_writeCentralDirectoryOffset(),
  858.         $zipfileCommentLength
  859.     );
  860.     $fh->print($header)
  861.       or return _ioError('writing EOCD header');
  862.     if ($zipfileCommentLength)
  863.     {
  864.         $fh->print( $self->zipfileComment() )
  865.           or return _ioError('writing zipfile comment');
  866.     }
  867.     return AZ_OK;
  868. }
  869.  
  870. # $offset can be specified to truncate a zip file.
  871. sub writeCentralDirectory    # Archive::Zip::Archive
  872. {
  873.     my ( $self, $fh, $offset ) = @_;
  874.  
  875.     if ( defined($offset) )
  876.     {
  877.         $self->{'writeCentralDirectoryOffset'} = $offset;
  878.         $fh->seek( $offset, IO::Seekable::SEEK_SET )
  879.           or return _ioError('seeking to write central directory');
  880.     }
  881.     else
  882.     {
  883.         $offset = $self->_writeCentralDirectoryOffset();
  884.     }
  885.  
  886.     foreach my $member ( $self->members() )
  887.     {
  888.         my $status = $member->_writeCentralDirectoryFileHeader($fh);
  889.         return $status if $status != AZ_OK;
  890.         $offset += $member->_centralDirectoryHeaderSize();
  891.         $self->{'writeEOCDOffset'} = $offset;
  892.     }
  893.     return $self->_writeEndOfCentralDirectory($fh);
  894. }
  895.  
  896. sub read    # Archive::Zip::Archive
  897. {
  898.     my $self     = shift;
  899.     my $fileName = shift;
  900.     return _error('No filename given') unless $fileName;
  901.     my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
  902.     return _ioError("opening $fileName for read") unless $status;
  903.  
  904.     $status = $self->readFromFileHandle( $fh, $fileName );
  905.     return $status if $status != AZ_OK;
  906.  
  907.     $fh->close();
  908.     $self->{'fileName'} = $fileName;
  909.     return AZ_OK;
  910. }
  911.  
  912. sub readFromFileHandle    # Archive::Zip::Archive
  913. {
  914.     my $self     = shift ();
  915.     my $fh       = shift ();
  916.     my $fileName = shift () || $fh;
  917.     return _error('No filehandle given')   unless $fh;
  918.     return _ioError('filehandle not open') unless $fh->opened();
  919.  
  920.     $fh->seek( 0, 0 );    # rewind the file
  921.     _binmode($fh);
  922.  
  923.     my $status = $self->_findEndOfCentralDirectory($fh);
  924.     return $status if $status != AZ_OK;
  925.  
  926.     my $eocdPosition = $fh->tell();
  927.  
  928.     $status = $self->_readEndOfCentralDirectory($fh);
  929.     return $status if $status != AZ_OK;
  930.  
  931.     $fh->seek( $eocdPosition - $self->centralDirectorySize(),
  932.         IO::Seekable::SEEK_SET )
  933.       or return _ioError("Can't seek $fileName");
  934.  
  935.     # Try to detect garbage at beginning of archives
  936.     # This should be 0
  937.     $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
  938.       - $self->centralDirectoryOffsetWRTStartingDiskNumber();
  939.  
  940.     for ( ; ; )
  941.     {
  942.         my $newMember =
  943.           $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName );
  944.         my $signature;
  945.         ( $status, $signature ) = $self->_readSignature( $fh, $fileName );
  946.         return $status if $status != AZ_OK;
  947.         last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
  948.         $status = $newMember->_readCentralDirectoryFileHeader();
  949.         return $status if $status != AZ_OK;
  950.         $status = $newMember->endRead();
  951.         return $status if $status != AZ_OK;
  952.         $newMember->_becomeDirectoryIfNecessary();
  953.         $newMember->{'localHeaderRelativeOffset'} += $self->{'eocdOffset'};
  954.         push ( @{ $self->{'members'} }, $newMember );
  955.     }
  956.  
  957.     $self->{'fileName'} = "$fh";
  958.     return AZ_OK;
  959. }
  960.  
  961. # Read EOCD, starting from position before signature.
  962. # Return AZ_OK on success.
  963. sub _readEndOfCentralDirectory    # Archive::Zip::Archive
  964. {
  965.     my $self = shift;
  966.     my $fh   = shift;
  967.  
  968.     # Skip past signature
  969.     $fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
  970.       or return _ioError("Can't seek past EOCD signature");
  971.  
  972.     my $header = '';
  973.     my $bytesRead = $fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH );
  974.     if ( $bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH )
  975.     {
  976.         return _ioError("reading end of central directory");
  977.     }
  978.  
  979.     my $zipfileCommentLength;
  980.     ( $self->{'diskNumber'},
  981.       $self->{'diskNumberWithStartOfCentralDirectory'},
  982.       $self->{'numberOfCentralDirectoriesOnThisDisk'},
  983.       $self->{'numberOfCentralDirectories'},
  984.       $self->{'centralDirectorySize'},
  985.       $self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
  986.       $zipfileCommentLength )
  987.       = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
  988.  
  989.     if ($zipfileCommentLength)
  990.     {
  991.         my $zipfileComment = '';
  992.         $bytesRead = $fh->read( $zipfileComment, $zipfileCommentLength );
  993.         if ( $bytesRead != $zipfileCommentLength )
  994.         {
  995.             return _ioError("reading zipfile comment");
  996.         }
  997.         $self->{'zipfileComment'} = $zipfileComment;
  998.     }
  999.  
  1000.     return AZ_OK;
  1001. }
  1002.  
  1003. # Seek in my file to the end, then read backwards until we find the
  1004. # signature of the central directory record. Leave the file positioned right
  1005. # before the signature. Returns AZ_OK if success.
  1006. sub _findEndOfCentralDirectory    # Archive::Zip::Archive
  1007. {
  1008.     my $self = shift;
  1009.     my $fh   = shift;
  1010.     my $data = '';
  1011.     $fh->seek( 0, IO::Seekable::SEEK_END )
  1012.       or return _ioError("seeking to end");
  1013.  
  1014.     my $fileLength = $fh->tell();
  1015.     if ( $fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4 )
  1016.     {
  1017.         return _formatError("file is too short");
  1018.     }
  1019.  
  1020.     my $seekOffset = 0;
  1021.     my $pos        = -1;
  1022.     for ( ; ; )
  1023.     {
  1024.         $seekOffset += 512;
  1025.         $seekOffset = $fileLength if ( $seekOffset > $fileLength );
  1026.         $fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
  1027.           or return _ioError("seek failed");
  1028.         my $bytesRead = $fh->read( $data, $seekOffset );
  1029.         if ( $bytesRead != $seekOffset )
  1030.         {
  1031.             return _ioError("read failed");
  1032.         }
  1033.         $pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
  1034.         last
  1035.           if ( $pos >= 0
  1036.             or $seekOffset == $fileLength
  1037.             or $seekOffset >= $Archive::Zip::ChunkSize );
  1038.     }
  1039.  
  1040.     if ( $pos >= 0 )
  1041.     {
  1042.         $fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
  1043.           or return _ioError("seeking to EOCD");
  1044.         return AZ_OK;
  1045.     }
  1046.     else
  1047.     {
  1048.         return _formatError("can't find EOCD signature");
  1049.     }
  1050. }
  1051.  
  1052. sub addTree    # Archive::Zip::Archive
  1053. {
  1054.     my $self = shift;
  1055.     my $root = shift or return _error("root arg missing in call to addTree()");
  1056.     my $dest = shift || '';
  1057.     my $pred = shift || sub { -r };
  1058.     my @files;
  1059.     my $startDir = cwd();
  1060.  
  1061.     # This avoids chdir'ing in Find, in a way compatible with older
  1062.     # versions of File::Find.
  1063.     my $wanted = sub {
  1064.         local $main::_ = $File::Find::name;
  1065.         my $dir = $File::Find::dir;
  1066.         chdir($startDir);
  1067.         push ( @files, $File::Find::name ) if (&$pred);
  1068.         chdir($dir);
  1069.     };
  1070.  
  1071.     File::Find::find( $wanted, $root );
  1072.  
  1073.     my $rootZipName =
  1074.       Archive::Zip::_asZipDirName( $root, 1 );    # with trailing slash
  1075.     my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
  1076.  
  1077.     $dest = Archive::Zip::_asZipDirName( $dest, 1 );    # with trailing slash
  1078.  
  1079.     foreach my $fileName (@files)
  1080.     {
  1081.         my $isDir = -d $fileName;
  1082.  
  1083.         # normalize, remove leading ./
  1084.         my $archiveName = Archive::Zip::_asZipDirName( $fileName, $isDir );
  1085.         if ( $archiveName eq $rootZipName ) { $archiveName = $dest }
  1086.         else { $archiveName =~ s{$pattern}{$dest} }
  1087.         next if $archiveName =~ m{^\.?/?$};    # skip current dir
  1088.         my $member =
  1089.           $isDir 
  1090.           ? $self->addDirectory( $fileName, $archiveName )
  1091.           : $self->addFile( $fileName, $archiveName );
  1092.         return _error("add $fileName failed in addTree()") if !$member;
  1093.     }
  1094.     return AZ_OK;
  1095. }
  1096.  
  1097. sub addTreeMatching    # Archive::Zip::Archive
  1098. {
  1099.     my $self = shift;
  1100.     my $root = shift
  1101.       or return _error("root arg missing in call to addTreeMatching()");
  1102.     my $dest = shift || '';
  1103.     my $pattern = shift
  1104.       or return _error("pattern missing in call to addTreeMatching()");
  1105.     my $pred    = shift;
  1106.     my $matcher =
  1107.       $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
  1108.     return $self->addTree( $root, $dest, $matcher );
  1109. }
  1110.  
  1111. # $zip->extractTree( $root, $dest [, $volume] );
  1112. #
  1113. # $root and $dest are Unix-style.
  1114. # $volume is in local FS format.
  1115. #
  1116. sub extractTree    # Archive::Zip::Archive
  1117. {
  1118.     my $self = shift ();
  1119.     my $root = shift () || '';    # Zip format
  1120.     my $dest = shift || './';    # Zip format
  1121.     my $volume = shift;            # optional
  1122.     my $pattern = "^\Q$root";
  1123.     my @members = $self->membersMatching($pattern);
  1124.  
  1125.     foreach my $member (@members)
  1126.     {
  1127.         my $fileName = $member->fileName();    # in Unix format
  1128.         $fileName =~ s{$pattern}{$dest};       # in Unix format
  1129.                                                # convert to platform format:
  1130.         $fileName = Archive::Zip::_asLocalName($fileName, $volume);
  1131.         my $status = $member->extractToFileNamed($fileName);
  1132.         return $status if $status != AZ_OK;
  1133.     }
  1134.     return AZ_OK;
  1135. }
  1136.  
  1137. # ----------------------------------------------------------------------
  1138. # class Archive::Zip::Member
  1139. # A generic member of an archive ( abstract )
  1140. # ----------------------------------------------------------------------
  1141. package Archive::Zip::Member;
  1142. use vars qw( @ISA );
  1143. @ISA = qw ( Archive::Zip );
  1144.  
  1145. BEGIN
  1146. {
  1147.     use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
  1148.       :UTILITY_METHODS );
  1149. }
  1150.  
  1151. use Time::Local();
  1152. use Compress::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
  1153. use File::Path;
  1154. use File::Basename;
  1155.  
  1156. use constant ZIPFILEMEMBERCLASS   => 'Archive::Zip::ZipFileMember';
  1157. use constant NEWFILEMEMBERCLASS   => 'Archive::Zip::NewFileMember';
  1158. use constant STRINGMEMBERCLASS    => 'Archive::Zip::StringMember';
  1159. use constant DIRECTORYMEMBERCLASS => 'Archive::Zip::DirectoryMember';
  1160.  
  1161. # Unix perms for default creation of files/dirs.
  1162. use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
  1163. use constant DEFAULT_FILE_PERMISSIONS      => 0100666;
  1164. use constant DIRECTORY_ATTRIB              => 040000;
  1165. use constant FILE_ATTRIB                   => 0100000;
  1166.  
  1167. # Returns self if successful, else undef
  1168. # Assumes that fh is positioned at beginning of central directory file header.
  1169. # Leaves fh positioned immediately after file header or EOCD signature.
  1170. sub _newFromZipFile    # Archive::Zip::Member
  1171. {
  1172.     my $class = shift;
  1173.     my $self  = $class->ZIPFILEMEMBERCLASS->_newFromZipFile(@_);
  1174.     return $self;
  1175. }
  1176.  
  1177. sub newFromString    # Archive::Zip::Member
  1178. {
  1179.     my $class = shift;
  1180.     my $self  = $class->STRINGMEMBERCLASS->_newFromString(@_);
  1181.     return $self;
  1182. }
  1183.  
  1184. sub newFromFile    # Archive::Zip::Member
  1185. {
  1186.     my $class = shift;
  1187.     my $self  = $class->NEWFILEMEMBERCLASS->_newFromFileNamed(@_);
  1188.     return $self;
  1189. }
  1190.  
  1191. sub newDirectoryNamed    # Archive::Zip::Member
  1192. {
  1193.     my $class = shift;
  1194.     my $self  = $class->DIRECTORYMEMBERCLASS->_newNamed(@_);
  1195.     return $self;
  1196. }
  1197.  
  1198. sub new    # Archive::Zip::Member
  1199. {
  1200.     my $class = shift;
  1201.     my $self  = {
  1202.         'lastModFileDateTime'      => 0,
  1203.         'fileAttributeFormat'      => FA_UNIX,
  1204.         'versionMadeBy'            => 20,
  1205.         'versionNeededToExtract'   => 20,
  1206.         'bitFlag'                  => 0,
  1207.         'compressionMethod'        => COMPRESSION_STORED,
  1208.         'desiredCompressionMethod' => COMPRESSION_STORED,
  1209.         'desiredCompressionLevel'  => COMPRESSION_LEVEL_NONE,
  1210.         'internalFileAttributes'   => 0,
  1211.         'externalFileAttributes'   => 0,                        # set later
  1212.         'fileName'                 => '',
  1213.         'cdExtraField'             => '',
  1214.         'localExtraField'          => '',
  1215.         'fileComment'              => '',
  1216.         'crc32'                    => 0,
  1217.         'compressedSize'           => 0,
  1218.         'uncompressedSize'         => 0,
  1219.         @_
  1220.     };
  1221.     bless( $self, $class );
  1222.     $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
  1223.     return $self;
  1224. }
  1225.  
  1226. sub _becomeDirectoryIfNecessary    # Archive::Zip::Member
  1227. {
  1228.     my $self = shift;
  1229.     $self->_become(DIRECTORYMEMBERCLASS)
  1230.       if $self->isDirectory();
  1231.     return $self;
  1232. }
  1233.  
  1234. # Morph into given class (do whatever cleanup I need to do)
  1235. sub _become    # Archive::Zip::Member
  1236. {
  1237.     return bless( $_[0], $_[1] );
  1238. }
  1239.  
  1240. sub versionMadeBy    # Archive::Zip::Member
  1241. {
  1242.     shift->{'versionMadeBy'};
  1243. }
  1244.  
  1245. sub fileAttributeFormat    # Archive::Zip::Member
  1246. {
  1247.     ( $#_ > 0 ) 
  1248.       ? ( $_[0]->{'fileAttributeFormat'} = $_[1] )
  1249.       : $_[0]->{'fileAttributeFormat'};
  1250. }
  1251.  
  1252. sub versionNeededToExtract    # Archive::Zip::Member
  1253. {
  1254.     shift->{'versionNeededToExtract'};
  1255. }
  1256.  
  1257. sub bitFlag    # Archive::Zip::Member
  1258. {
  1259.     shift->{'bitFlag'};
  1260. }
  1261.  
  1262. sub compressionMethod    # Archive::Zip::Member
  1263. {
  1264.     shift->{'compressionMethod'};
  1265. }
  1266.  
  1267. sub desiredCompressionMethod    # Archive::Zip::Member
  1268. {
  1269.     my $self                        = shift;
  1270.     my $newDesiredCompressionMethod = shift;
  1271.     my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
  1272.     if ( defined($newDesiredCompressionMethod) )
  1273.     {
  1274.         $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
  1275.         if ( $newDesiredCompressionMethod == COMPRESSION_STORED )
  1276.         {
  1277.             $self->{'desiredCompressionLevel'} = 0;
  1278.         }
  1279.         elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED )
  1280.         {
  1281.             $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
  1282.         }
  1283.     }
  1284.     return $oldDesiredCompressionMethod;
  1285. }
  1286.  
  1287. sub desiredCompressionLevel    # Archive::Zip::Member
  1288. {
  1289.     my $self                       = shift;
  1290.     my $newDesiredCompressionLevel = shift;
  1291.     my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
  1292.     if ( defined($newDesiredCompressionLevel) )
  1293.     {
  1294.         $self->{'desiredCompressionLevel'}  = $newDesiredCompressionLevel;
  1295.         $self->{'desiredCompressionMethod'} =
  1296.           ( $newDesiredCompressionLevel 
  1297.           ? COMPRESSION_DEFLATED
  1298.           : COMPRESSION_STORED );
  1299.     }
  1300.     return $oldDesiredCompressionLevel;
  1301. }
  1302.  
  1303. sub fileName    # Archive::Zip::Member
  1304. {
  1305.     my $self    = shift;
  1306.     my $newName = shift;
  1307.     if ($newName)
  1308.     {
  1309.         $newName =~ s{[\\/]+}{/}g;    # deal with dos/windoze problems
  1310.         $self->{'fileName'} = $newName;
  1311.     }
  1312.     return $self->{'fileName'};
  1313. }
  1314.  
  1315. sub lastModFileDateTime    # Archive::Zip::Member
  1316. {
  1317.     my $modTime = shift->{'lastModFileDateTime'};
  1318.     $modTime =~ m/^(\d+)$/;    # untaint
  1319.     return $1;
  1320. }
  1321.  
  1322. sub lastModTime    # Archive::Zip::Member
  1323. {
  1324.     my $self = shift;
  1325.     return _dosToUnixTime( $self->lastModFileDateTime() );
  1326. }
  1327.  
  1328. sub setLastModFileDateTimeFromUnix    # Archive::Zip::Member
  1329. {
  1330.     my $self   = shift;
  1331.     my $time_t = shift;
  1332.     $self->{'lastModFileDateTime'} = _unixToDosTime($time_t);
  1333. }
  1334.  
  1335. # DOS date/time format
  1336. # 0-4 (5) Second divided by 2
  1337. # 5-10 (6) Minute (0-59)
  1338. # 11-15 (5) Hour (0-23 on a 24-hour clock)
  1339. # 16-20 (5) Day of the month (1-31)
  1340. # 21-24 (4) Month (1 = January, 2 = February, etc.)
  1341. # 25-31 (7) Year offset from 1980 (add 1980 to get actual year)
  1342.  
  1343. # Convert DOS date/time format to unix time_t format
  1344. # NOT AN OBJECT METHOD!
  1345. sub _dosToUnixTime    # Archive::Zip::Member
  1346. {
  1347.     my $dt = shift || return time();
  1348.  
  1349.     my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
  1350.     my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
  1351.     my $mday = ( ( $dt >> 16 ) & 0x1f );
  1352.  
  1353.     my $hour = ( ( $dt >> 11 ) & 0x1f );
  1354.     my $min  = ( ( $dt >> 5 ) & 0x3f );
  1355.     my $sec  = ( ( $dt << 1 ) & 0x3e );
  1356.  
  1357.     # catch errors
  1358.     my $time_t = eval {
  1359.       Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year );
  1360.       };
  1361.     return time() if ($@);
  1362.     return $time_t;
  1363. }
  1364.  
  1365. sub internalFileAttributes    # Archive::Zip::Member
  1366. {
  1367.     shift->{'internalFileAttributes'};
  1368. }
  1369.  
  1370. sub externalFileAttributes    # Archive::Zip::Member
  1371. {
  1372.     shift->{'externalFileAttributes'};
  1373. }
  1374.  
  1375. # Convert UNIX permissions into proper value for zip file
  1376. # NOT A METHOD!
  1377. sub _mapPermissionsFromUnix    # Archive::Zip::Member
  1378. {
  1379.     my $perms = shift;
  1380.     return $perms << 16;
  1381.  
  1382.     # TODO: map MS-DOS perms too (RHSA?)
  1383. }
  1384.  
  1385. # Convert ZIP permissions into Unix ones
  1386. # NOT A METHOD!
  1387. sub _mapPermissionsToUnix    # Archive::Zip::Member
  1388. {
  1389.     my $perms = shift;
  1390.     return $perms >> 16;
  1391.  
  1392.     # TODO: Handle non-Unix perms
  1393. }
  1394.  
  1395. sub unixFileAttributes    # Archive::Zip::Member
  1396. {
  1397.     my $self     = shift;
  1398.     my $oldPerms = _mapPermissionsToUnix( $self->{'externalFileAttributes'} );
  1399.     if (@_)
  1400.     {
  1401.         my $perms = shift;
  1402.         if ( $self->isDirectory() )
  1403.         {
  1404.             $perms &= ~FILE_ATTRIB;
  1405.             $perms |= DIRECTORY_ATTRIB;
  1406.         }
  1407.         else
  1408.         {
  1409.             $perms &= ~DIRECTORY_ATTRIB;
  1410.             $perms |= FILE_ATTRIB;
  1411.         }
  1412.         $self->{'externalFileAttributes'} = _mapPermissionsFromUnix($perms);
  1413.     }
  1414.     return $oldPerms;
  1415. }
  1416.  
  1417. sub localExtraField    # Archive::Zip::Member
  1418. {
  1419.     ( $#_ > 0 ) 
  1420.       ? ( $_[0]->{'localExtraField'} = $_[1] )
  1421.       : $_[0]->{'localExtraField'};
  1422. }
  1423.  
  1424. sub cdExtraField    # Archive::Zip::Member
  1425. {
  1426.     ( $#_ > 0 ) ? ( $_[0]->{'cdExtraField'} = $_[1] ) : $_[0]->{'cdExtraField'};
  1427. }
  1428.  
  1429. sub extraFields    # Archive::Zip::Member
  1430. {
  1431.     my $self = shift;
  1432.     return $self->localExtraField() . $self->cdExtraField();
  1433. }
  1434.  
  1435. sub fileComment    # Archive::Zip::Member
  1436. {
  1437.     ( $#_ > 0 ) ? ( $_[0]->{'fileComment'} = $_[1] ) : $_[0]->{'fileComment'};
  1438. }
  1439.  
  1440. sub hasDataDescriptor    # Archive::Zip::Member
  1441. {
  1442.     my $self = shift;
  1443.     if (@_)
  1444.     {
  1445.         my $shouldHave = shift;
  1446.         if ($shouldHave)
  1447.         {
  1448.             $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK;
  1449.         }
  1450.         else
  1451.         {
  1452.             $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
  1453.         }
  1454.     }
  1455.     return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK;
  1456. }
  1457.  
  1458. sub crc32    # Archive::Zip::Member
  1459. {
  1460.     shift->{'crc32'};
  1461. }
  1462.  
  1463. sub crc32String    # Archive::Zip::Member
  1464. {
  1465.     sprintf( "%08x", shift->{'crc32'} );
  1466. }
  1467.  
  1468. sub compressedSize    # Archive::Zip::Member
  1469. {
  1470.     shift->{'compressedSize'};
  1471. }
  1472.  
  1473. sub uncompressedSize    # Archive::Zip::Member
  1474. {
  1475.     shift->{'uncompressedSize'};
  1476. }
  1477.  
  1478. sub isEncrypted    # Archive::Zip::Member
  1479. {
  1480.     shift->bitFlag() & GPBF_ENCRYPTED_MASK;
  1481. }
  1482.  
  1483. sub isTextFile    # Archive::Zip::Member
  1484. {
  1485.     my $self = shift;
  1486.     my $bit  = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
  1487.     if (@_)
  1488.     {
  1489.         my $flag = shift;
  1490.         $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
  1491.         $self->{'internalFileAttributes'} |=
  1492.           ( $flag ? IFA_TEXT_FILE: IFA_BINARY_FILE );
  1493.     }
  1494.     return $bit == IFA_TEXT_FILE;
  1495. }
  1496.  
  1497. sub isBinaryFile    # Archive::Zip::Member
  1498. {
  1499.     my $self = shift;
  1500.     my $bit  = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
  1501.     if (@_)
  1502.     {
  1503.         my $flag = shift;
  1504.         $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
  1505.         $self->{'internalFileAttributes'} |=
  1506.           ( $flag ? IFA_BINARY_FILE: IFA_TEXT_FILE );
  1507.     }
  1508.     return $bit == IFA_BINARY_FILE;
  1509. }
  1510.  
  1511. sub extractToFileNamed    # Archive::Zip::Member
  1512. {
  1513.     my $self = shift;
  1514.     my $name = shift;    # local FS name
  1515.     return _error("encryption unsupported") if $self->isEncrypted();
  1516.     mkpath( dirname($name) );    # croaks on error
  1517.     my ( $status, $fh ) = _newFileHandle( $name, 'w' );
  1518.     return _ioError("Can't open file $name for write") unless $status;
  1519.     my $retval = $self->extractToFileHandle($fh);
  1520.     $fh->close();
  1521.     utime( $self->lastModTime(), $self->lastModTime(), $name );
  1522.     return $retval;
  1523. }
  1524.  
  1525. sub isDirectory    # Archive::Zip::Member
  1526. {
  1527.     return 0;
  1528. }
  1529.  
  1530. sub externalFileName    # Archive::Zip::Member
  1531. {
  1532.     return undef;
  1533. }
  1534.  
  1535. # The following are used when copying data
  1536. sub _writeOffset    # Archive::Zip::Member
  1537. {
  1538.     shift->{'writeOffset'};
  1539. }
  1540.  
  1541. sub _readOffset    # Archive::Zip::Member
  1542. {
  1543.     shift->{'readOffset'};
  1544. }
  1545.  
  1546. sub writeLocalHeaderRelativeOffset    # Archive::Zip::Member
  1547. {
  1548.     shift->{'writeLocalHeaderRelativeOffset'};
  1549. }
  1550.  
  1551. sub wasWritten { shift->{'wasWritten'} }
  1552.  
  1553. sub _dataEnded    # Archive::Zip::Member
  1554. {
  1555.     shift->{'dataEnded'};
  1556. }
  1557.  
  1558. sub _readDataRemaining    # Archive::Zip::Member
  1559. {
  1560.     shift->{'readDataRemaining'};
  1561. }
  1562.  
  1563. sub _inflater    # Archive::Zip::Member
  1564. {
  1565.     shift->{'inflater'};
  1566. }
  1567.  
  1568. sub _deflater    # Archive::Zip::Member
  1569. {
  1570.     shift->{'deflater'};
  1571. }
  1572.  
  1573. # Return the total size of my local header
  1574. sub _localHeaderSize    # Archive::Zip::Member
  1575. {
  1576.     my $self = shift;
  1577.     return SIGNATURE_LENGTH + LOCAL_FILE_HEADER_LENGTH +
  1578.       length( $self->fileName() ) + length( $self->localExtraField() );
  1579. }
  1580.  
  1581. # Return the total size of my CD header
  1582. sub _centralDirectoryHeaderSize    # Archive::Zip::Member
  1583. {
  1584.     my $self = shift;
  1585.     return SIGNATURE_LENGTH + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
  1586.       length( $self->fileName() ) + length( $self->cdExtraField() ) +
  1587.       length( $self->fileComment() );
  1588. }
  1589.  
  1590. # convert a unix time to DOS date/time
  1591. # NOT AN OBJECT METHOD!
  1592. sub _unixToDosTime    # Archive::Zip::Member
  1593. {
  1594.     my $time_t = shift;
  1595.     my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
  1596.     my $dt = 0;
  1597.     $dt += ( $sec >> 1 );
  1598.     $dt += ( $min << 5 );
  1599.     $dt += ( $hour << 11 );
  1600.     $dt += ( $mday << 16 );
  1601.     $dt += ( ( $mon + 1 ) << 21 );
  1602.     $dt += ( ( $year - 80 ) << 25 );
  1603.     return $dt;
  1604. }
  1605.  
  1606. # Write my local header to a file handle.
  1607. # Stores the offset to the start of the header in my
  1608. # writeLocalHeaderRelativeOffset member.
  1609. # Returns AZ_OK on success.
  1610. sub _writeLocalFileHeader    # Archive::Zip::Member
  1611. {
  1612.     my $self = shift;
  1613.     my $fh   = shift;
  1614.  
  1615.     my $signatureData = pack( SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE );
  1616.     $fh->print($signatureData)
  1617.       or return _ioError("writing local header signature");
  1618.  
  1619.     my $header = pack(
  1620.         LOCAL_FILE_HEADER_FORMAT,
  1621.         $self->versionNeededToExtract(),
  1622.         $self->bitFlag(),
  1623.         $self->desiredCompressionMethod(),
  1624.         $self->lastModFileDateTime(),
  1625.         $self->crc32(),
  1626.         $self->compressedSize(),    # may need to be re-written later
  1627.         $self->uncompressedSize(),
  1628.         length( $self->fileName() ),
  1629.         length( $self->localExtraField() )
  1630.     );
  1631.  
  1632.     $fh->print($header) or return _ioError("writing local header");
  1633.     if ( $self->fileName() )
  1634.     {
  1635.         $fh->print( $self->fileName() )
  1636.           or return _ioError("writing local header filename");
  1637.     }
  1638.     if ( $self->localExtraField() )
  1639.     {
  1640.         $fh->print( $self->localExtraField() )
  1641.           or return _ioError("writing local extra field");
  1642.     }
  1643.  
  1644.     return AZ_OK;
  1645. }
  1646.  
  1647. sub _writeCentralDirectoryFileHeader    # Archive::Zip::Member
  1648. {
  1649.     my $self = shift;
  1650.     my $fh   = shift;
  1651.  
  1652.     my $sigData =
  1653.       pack( SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE );
  1654.     $fh->print($sigData)
  1655.       or return _ioError("writing central directory header signature");
  1656.  
  1657.     my $fileNameLength    = length( $self->fileName() );
  1658.     my $extraFieldLength  = length( $self->cdExtraField() );
  1659.     my $fileCommentLength = length( $self->fileComment() );
  1660.  
  1661.     my $header = pack(
  1662.         CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
  1663.         $self->versionMadeBy(),
  1664.         $self->fileAttributeFormat(),
  1665.         $self->versionNeededToExtract(),
  1666.         $self->bitFlag(),
  1667.         $self->desiredCompressionMethod(),
  1668.         $self->lastModFileDateTime(),
  1669.         $self->crc32(),            # these three fields should have been updated
  1670.         $self->_writeOffset(),     # by writing the data stream out
  1671.         $self->uncompressedSize(), #
  1672.         $fileNameLength,
  1673.         $extraFieldLength,
  1674.         $fileCommentLength,
  1675.         0,                         # {'diskNumberStart'},
  1676.         $self->internalFileAttributes(),
  1677.         $self->externalFileAttributes(),
  1678.         $self->writeLocalHeaderRelativeOffset()
  1679.     );
  1680.  
  1681.     $fh->print($header)
  1682.       or return _ioError("writing central directory header");
  1683.     if ($fileNameLength)
  1684.     {
  1685.         $fh->print( $self->fileName() )
  1686.           or return _ioError("writing central directory header signature");
  1687.     }
  1688.     if ($extraFieldLength)
  1689.     {
  1690.         $fh->print( $self->cdExtraField() )
  1691.           or return _ioError("writing central directory extra field");
  1692.     }
  1693.     if ($fileCommentLength)
  1694.     {
  1695.         $fh->print( $self->fileComment() )
  1696.           or return _ioError("writing central directory file comment");
  1697.     }
  1698.  
  1699.     return AZ_OK;
  1700. }
  1701.  
  1702. # This writes a data descriptor to the given file handle.
  1703. # Assumes that crc32, writeOffset, and uncompressedSize are
  1704. # set correctly (they should be after a write).
  1705. # Further, the local file header should have the
  1706. # GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
  1707. sub _writeDataDescriptor    # Archive::Zip::Member
  1708. {
  1709.     my $self   = shift;
  1710.     my $fh     = shift;
  1711.     my $header = pack(
  1712.         DATA_DESCRIPTOR_FORMAT,
  1713.         $self->crc32(),
  1714.         $self->_writeOffset(),    # compressed size
  1715.         $self->uncompressedSize()
  1716.     );
  1717.  
  1718.     $fh->print($header)
  1719.       or return _ioError("writing data descriptor");
  1720.     return AZ_OK;
  1721. }
  1722.  
  1723. # Re-writes the local file header with new crc32 and compressedSize fields.
  1724. # To be called after writing the data stream.
  1725. # Assumes that filename and extraField sizes didn't change since last written.
  1726. sub _refreshLocalFileHeader    # Archive::Zip::Member
  1727. {
  1728.     my $self = shift;
  1729.     my $fh   = shift;
  1730.  
  1731.     my $here = $fh->tell();
  1732.     $fh->seek( $self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH,
  1733.         IO::Seekable::SEEK_SET )
  1734.       or return _ioError("seeking to rewrite local header");
  1735.  
  1736.     my $header = pack(
  1737.         LOCAL_FILE_HEADER_FORMAT,
  1738.         $self->versionNeededToExtract(),
  1739.         $self->bitFlag(),
  1740.         $self->desiredCompressionMethod(),
  1741.         $self->lastModFileDateTime(),
  1742.         $self->crc32(),
  1743.         $self->_writeOffset(),    # compressed size
  1744.         $self->uncompressedSize(),
  1745.         length( $self->fileName() ),
  1746.         length( $self->localExtraField() )
  1747.     );
  1748.  
  1749.     $fh->print($header)
  1750.       or return _ioError("re-writing local header");
  1751.     $fh->seek( $here, IO::Seekable::SEEK_SET )
  1752.       or return _ioError("seeking after rewrite of local header");
  1753.  
  1754.     return AZ_OK;
  1755. }
  1756.  
  1757. sub readChunk    # Archive::Zip::Member
  1758. {
  1759.     my ( $self, $chunkSize ) = @_;
  1760.  
  1761.     if ( $self->readIsDone() )
  1762.     {
  1763.         $self->endRead();
  1764.         my $dummy = '';
  1765.         return ( \$dummy, AZ_STREAM_END );
  1766.     }
  1767.  
  1768.     $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize);
  1769.     $chunkSize = $self->_readDataRemaining()
  1770.       if $chunkSize > $self->_readDataRemaining();
  1771.  
  1772.     my $buffer = '';
  1773.     my $outputRef;
  1774.     my ( $bytesRead, $status ) = $self->_readRawChunk( \$buffer, $chunkSize );
  1775.     return ( \$buffer, $status ) unless $status == AZ_OK;
  1776.  
  1777.     $self->{'readDataRemaining'} -= $bytesRead;
  1778.     $self->{'readOffset'} += $bytesRead;
  1779.  
  1780.     if ( $self->compressionMethod() == COMPRESSION_STORED )
  1781.     {
  1782.         $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
  1783.     }
  1784.  
  1785.     ( $outputRef, $status ) = &{ $self->{'chunkHandler'} } ( $self, \$buffer );
  1786.     $self->{'writeOffset'} += length($$outputRef);
  1787.  
  1788.     $self->endRead()
  1789.       if $self->readIsDone();
  1790.  
  1791.     return ( $outputRef, $status );
  1792. }
  1793.  
  1794. # Read the next raw chunk of my data. Subclasses MUST implement.
  1795. #    my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
  1796. sub _readRawChunk    # Archive::Zip::Member
  1797. {
  1798.     my $self = shift;
  1799.     return $self->_subclassResponsibility();
  1800. }
  1801.  
  1802. # A place holder to catch rewindData errors if someone ignores
  1803. # the error code.
  1804. sub _noChunk    # Archive::Zip::Member
  1805. {
  1806.     my $self = shift;
  1807.     return ( \undef, _error("trying to copy chunk when init failed") );
  1808. }
  1809.  
  1810. # Basically a no-op so that I can have a consistent interface.
  1811. # ( $outputRef, $status) = $self->_copyChunk( \$buffer );
  1812. sub _copyChunk    # Archive::Zip::Member
  1813. {
  1814.     my ( $self, $dataRef ) = @_;
  1815.     return ( $dataRef, AZ_OK );
  1816. }
  1817.  
  1818. # ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
  1819. sub _deflateChunk    # Archive::Zip::Member
  1820. {
  1821.     my ( $self, $buffer ) = @_;
  1822.     my ( $out,  $status ) = $self->_deflater()->deflate($buffer);
  1823.  
  1824.     if ( $self->_readDataRemaining() == 0 )
  1825.     {
  1826.         my $extraOutput;
  1827.         ( $extraOutput, $status ) = $self->_deflater()->flush();
  1828.         $out .= $extraOutput;
  1829.         $self->endRead();
  1830.         return ( \$out, AZ_STREAM_END );
  1831.     }
  1832.     elsif ( $status == Z_OK )
  1833.     {
  1834.         return ( \$out, AZ_OK );
  1835.     }
  1836.     else
  1837.     {
  1838.         $self->endRead();
  1839.         my $retval = _error( 'deflate error', $status );
  1840.         my $dummy = '';
  1841.         return ( \$dummy, $retval );
  1842.     }
  1843. }
  1844.  
  1845. # ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
  1846. sub _inflateChunk    # Archive::Zip::Member
  1847. {
  1848.     my ( $self, $buffer ) = @_;
  1849.     my ( $out,  $status ) = $self->_inflater()->inflate($buffer);
  1850.     my $retval;
  1851.     $self->endRead() unless $status == Z_OK;
  1852.     if ( $status == Z_OK || $status == Z_STREAM_END )
  1853.     {
  1854.         $retval = ( $status == Z_STREAM_END ) ? AZ_STREAM_END: AZ_OK;
  1855.         return ( \$out, $retval );
  1856.     }
  1857.     else
  1858.     {
  1859.         $retval = _error( 'inflate error', $status );
  1860.         my $dummy = '';
  1861.         return ( \$dummy, $retval );
  1862.     }
  1863. }
  1864.  
  1865. sub rewindData    # Archive::Zip::Member
  1866. {
  1867.     my $self = shift;
  1868.     my $status;
  1869.  
  1870.     # set to trap init errors
  1871.     $self->{'chunkHandler'} = $self->can('_noChunk');
  1872.  
  1873.     # Work around WinZip bug with 0-length DEFLATED files
  1874.     $self->desiredCompressionMethod(COMPRESSION_STORED)
  1875.       if $self->uncompressedSize() == 0;
  1876.  
  1877.     # assume that we're going to read the whole file, and compute the CRC anew.
  1878.     $self->{'crc32'} = 0
  1879.       if ( $self->compressionMethod() == COMPRESSION_STORED );
  1880.  
  1881.     # These are the only combinations of methods we deal with right now.
  1882.     if ( $self->compressionMethod() == COMPRESSION_STORED
  1883.         and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
  1884.     {
  1885.         ( $self->{'deflater'}, $status ) = Compress::Zlib::deflateInit(
  1886.             '-Level'      => $self->desiredCompressionLevel(),
  1887.             '-WindowBits' => -MAX_WBITS(),                     # necessary magic
  1888. #            '-Bufsize'    => $Archive::Zip::ChunkSize,
  1889.             @_
  1890.         );    # pass additional options
  1891.         return _error( 'deflateInit error:', $status ) unless $status == Z_OK;
  1892.         $self->{'chunkHandler'} = $self->can('_deflateChunk');
  1893.     }
  1894.     elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
  1895.         and $self->desiredCompressionMethod() == COMPRESSION_STORED )
  1896.     {
  1897.         ( $self->{'inflater'}, $status ) = Compress::Zlib::inflateInit(
  1898.             '-WindowBits' => -MAX_WBITS(),               # necessary magic
  1899. #            '-Bufsize'    => $Archive::Zip::ChunkSize,
  1900.             @_
  1901.         );    # pass additional options
  1902.         return _error( 'inflateInit error:', $status ) unless $status == Z_OK;
  1903.         $self->{'chunkHandler'} = $self->can('_inflateChunk');
  1904.     }
  1905.     elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() )
  1906.     {
  1907.         $self->{'chunkHandler'} = $self->can('_copyChunk');
  1908.     }
  1909.     else
  1910.     {
  1911.         return _error(
  1912.             sprintf(
  1913.                 "Unsupported compression combination: read %d, write %d",
  1914.                 $self->compressionMethod(),
  1915.                 $self->desiredCompressionMethod()
  1916.             )
  1917.         );
  1918.     }
  1919.  
  1920.     $self->{'readDataRemaining'} =
  1921.       ( $self->compressionMethod() == COMPRESSION_STORED )
  1922.       ? $self->uncompressedSize()
  1923.       : $self->compressedSize();
  1924.     $self->{'dataEnded'}  = 0;
  1925.     $self->{'readOffset'} = 0;
  1926.  
  1927.     return AZ_OK;
  1928. }
  1929.  
  1930. sub endRead    # Archive::Zip::Member
  1931. {
  1932.     my $self = shift;
  1933.     delete $self->{'inflater'};
  1934.     delete $self->{'deflater'};
  1935.     $self->{'dataEnded'}         = 1;
  1936.     $self->{'readDataRemaining'} = 0;
  1937.     return AZ_OK;
  1938. }
  1939.  
  1940. sub readIsDone    # Archive::Zip::Member
  1941. {
  1942.     my $self = shift;
  1943.     return ( $self->_dataEnded() or !$self->_readDataRemaining() );
  1944. }
  1945.  
  1946. sub contents    # Archive::Zip::Member
  1947. {
  1948.     my $self        = shift;
  1949.     my $newContents = shift;
  1950.     if ( defined($newContents) )
  1951.     {
  1952.         $self->_become(STRINGMEMBERCLASS);
  1953.         return $self->contents($newContents);
  1954.     }
  1955.     else
  1956.     {
  1957.         my $oldCompression =
  1958.           $self->desiredCompressionMethod(COMPRESSION_STORED);
  1959.         my $status = $self->rewindData(@_);
  1960.         if ( $status != AZ_OK )
  1961.         {
  1962.             $self->endRead();
  1963.             return $status;
  1964.         }
  1965.         my $retval = '';
  1966.         while ( $status == AZ_OK )
  1967.         {
  1968.             my $ref;
  1969.             ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
  1970.  
  1971.             # did we get it in one chunk?
  1972.             if ( length($$ref) == $self->uncompressedSize() )
  1973.             {
  1974.                 $retval = $$ref;
  1975.             }
  1976.             else { $retval .= $$ref }
  1977.         }
  1978.         $self->desiredCompressionMethod($oldCompression);
  1979.         $self->endRead();
  1980.         $status = AZ_OK if $status == AZ_STREAM_END;
  1981.         $retval = undef unless $status == AZ_OK;
  1982.         return wantarray ? ( $retval, $status ) : $retval;
  1983.     }
  1984. }
  1985.  
  1986. sub extractToFileHandle    # Archive::Zip::Member
  1987. {
  1988.     my $self = shift;
  1989.     return _error("encryption unsupported") if $self->isEncrypted();
  1990.     my $fh = shift;
  1991.     _binmode($fh);
  1992.     my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED);
  1993.     my $status         = $self->rewindData(@_);
  1994.     $status = $self->_writeData($fh) if $status == AZ_OK;
  1995.     $self->desiredCompressionMethod($oldCompression);
  1996.     $self->endRead();
  1997.     return $status;
  1998. }
  1999.  
  2000. # write local header and data stream to file handle
  2001. sub _writeToFileHandle    # Archive::Zip::Member
  2002. {
  2003.     my $self         = shift;
  2004.     my $fh           = shift;
  2005.     my $fhIsSeekable = shift;
  2006.     my $offset       = shift;
  2007.  
  2008.     $self->{'writeLocalHeaderRelativeOffset'} = $offset;
  2009.     $self->{'wasWritten'}                     = 0;
  2010.  
  2011.     # Determine if I need to write a data descriptor
  2012.     # I need to do this if I can't refresh the header
  2013.     # and I don't know compressed size or crc32 fields.
  2014.     my $headerFieldsUnknown =
  2015.       ( ( $self->uncompressedSize() > 0 )
  2016.       and ( $self->compressionMethod() == COMPRESSION_STORED
  2017.           or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED ) );
  2018.  
  2019.     my $shouldWriteDataDescriptor =
  2020.       ( $headerFieldsUnknown and not $fhIsSeekable );
  2021.  
  2022.     $self->hasDataDescriptor(1)
  2023.       if ($shouldWriteDataDescriptor);
  2024.  
  2025.     $self->{'writeOffset'} = 0;
  2026.  
  2027.     my $status = $self->rewindData();
  2028.     ( $status = $self->_writeLocalFileHeader($fh) )
  2029.       if $status == AZ_OK;
  2030.     ( $status = $self->_writeData($fh) )
  2031.       if $status == AZ_OK;
  2032.     if ( $status == AZ_OK )
  2033.     {
  2034.         $self->{'wasWritten'} = 1;
  2035.         if ( $self->hasDataDescriptor() )
  2036.         {
  2037.             $status = $self->_writeDataDescriptor($fh);
  2038.         }
  2039.         elsif ($headerFieldsUnknown)
  2040.         {
  2041.             $status = $self->_refreshLocalFileHeader($fh);
  2042.         }
  2043.     }
  2044.  
  2045.     return $status;
  2046. }
  2047.  
  2048. # Copy my (possibly compressed) data to given file handle.
  2049. # Returns C<AZ_OK> on success
  2050. sub _writeData    # Archive::Zip::Member
  2051. {
  2052.     my $self    = shift;
  2053.     my $writeFh = shift;
  2054.  
  2055.     return AZ_OK if ( $self->uncompressedSize() == 0 );
  2056.     my $status;
  2057.     my $chunkSize = $Archive::Zip::ChunkSize;
  2058.     while ( $self->_readDataRemaining() > 0 )
  2059.     {
  2060.         my $outRef;
  2061.         ( $outRef, $status ) = $self->readChunk($chunkSize);
  2062.         return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );
  2063.  
  2064.         if ( length($$outRef) > 0 )
  2065.         {
  2066.             $writeFh->print($$outRef)
  2067.               or return _ioError("write error during copy");
  2068.         }
  2069.  
  2070.         last if $status == AZ_STREAM_END;
  2071.     }
  2072.     $self->{'compressedSize'} = $self->_writeOffset();
  2073.     return AZ_OK;
  2074. }
  2075.  
  2076. # Return true if I depend on the named file
  2077. sub _usesFileNamed
  2078. {
  2079.     return 0;
  2080. }
  2081.  
  2082. # ----------------------------------------------------------------------
  2083. # class Archive::Zip::DirectoryMember
  2084. # ----------------------------------------------------------------------
  2085.  
  2086. package Archive::Zip::DirectoryMember;
  2087. use File::Path;
  2088.  
  2089. use vars qw( @ISA );
  2090. @ISA = qw ( Archive::Zip::Member );
  2091. BEGIN { use Archive::Zip qw( :ERROR_CODES :UTILITY_METHODS ) }
  2092.  
  2093. sub _newNamed    # Archive::Zip::DirectoryMember
  2094. {
  2095.     my $class    = shift;
  2096.     my $fileName = shift;    # FS name
  2097.     my $newName  = shift;    # Zip name
  2098.     $newName = Archive::Zip::_asZipDirName($fileName) unless $newName;
  2099.     my $self = $class->new(@_);
  2100.     $self->{'externalFileName'} = $fileName;
  2101.     $self->fileName($newName);
  2102.     if ( -e $fileName )
  2103.     {
  2104.  
  2105.         if ( -d _ )
  2106.         {
  2107.             my @stat = stat(_);
  2108.             $self->unixFileAttributes( $stat[2] );
  2109.             $self->setLastModFileDateTimeFromUnix( $stat[9] );
  2110.         }
  2111.         else    # hmm.. trying to add a non-directory?
  2112.         {
  2113.             _error( $fileName, ' exists but is not a directory' );
  2114.             return undef;
  2115.         }
  2116.     }
  2117.     else
  2118.     {
  2119.         $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
  2120.         $self->setLastModFileDateTimeFromUnix( time() );
  2121.     }
  2122.     return $self;
  2123. }
  2124.  
  2125. sub externalFileName    # Archive::Zip::DirectoryMember
  2126. {
  2127.     shift->{'externalFileName'};
  2128. }
  2129.  
  2130. sub isDirectory    # Archive::Zip::DirectoryMember
  2131. {
  2132.     return 1;
  2133. }
  2134.  
  2135. sub extractToFileNamed    # Archive::Zip::DirectoryMember
  2136. {
  2137.     my $self    = shift;
  2138.     my $name    = shift;                                 # local FS name
  2139.     my $attribs = $self->unixFileAttributes() & 07777;
  2140.     mkpath( $name, 0, $attribs );                        # croaks on error
  2141.     utime( $self->lastModTime(), $self->lastModTime(), $name );
  2142.     return AZ_OK;
  2143. }
  2144.  
  2145. sub fileName    # Archive::Zip::DirectoryMember
  2146. {
  2147.     my $self    = shift;
  2148.     my $newName = shift;
  2149.     $newName =~ s{/?$}{/} if defined($newName);
  2150.     return $self->SUPER::fileName($newName);
  2151. }
  2152.  
  2153. # So people don't get too confused. This way it looks like the problem
  2154. # is in their code...
  2155. sub contents
  2156. {
  2157.     undef;
  2158. }
  2159.  
  2160. # ----------------------------------------------------------------------
  2161. # class Archive::Zip::FileMember
  2162. # Base class for classes that have file handles
  2163. # to external files
  2164. # ----------------------------------------------------------------------
  2165.  
  2166. package Archive::Zip::FileMember;
  2167. use vars qw( @ISA );
  2168. @ISA = qw ( Archive::Zip::Member );
  2169. BEGIN { use Archive::Zip qw( :UTILITY_METHODS ) }
  2170.  
  2171. sub externalFileName    # Archive::Zip::FileMember
  2172. {
  2173.     shift->{'externalFileName'};
  2174. }
  2175.  
  2176. # Return true if I depend on the named file
  2177. sub _usesFileNamed
  2178. {
  2179.     my $self     = shift;
  2180.     my $fileName = shift;
  2181.     my $xfn      = $self->externalFileName();
  2182.     return undef if ref($xfn);
  2183.     return $xfn eq $fileName;
  2184. }
  2185.  
  2186. sub fh    # Archive::Zip::FileMember
  2187. {
  2188.     my $self = shift;
  2189.     $self->_openFile() if !defined( $self->{'fh'} ) || !$self->{'fh'}->opened();
  2190.     return $self->{'fh'};
  2191. }
  2192.  
  2193. # opens my file handle from my file name
  2194. sub _openFile    # Archive::Zip::FileMember
  2195. {
  2196.     my $self = shift;
  2197.     my ( $status, $fh ) = _newFileHandle( $self->externalFileName(), 'r' );
  2198.     if ( !$status )
  2199.     {
  2200.         _ioError( "Can't open", $self->externalFileName() );
  2201.         return undef;
  2202.     }
  2203.     $self->{'fh'} = $fh;
  2204.     _binmode($fh);
  2205.     return $fh;
  2206. }
  2207.  
  2208. # Closes my file handle
  2209. sub _closeFile    # Archive::Zip::FileMember
  2210. {
  2211.     my $self = shift;
  2212.     my $fh = $self->{'fh'};
  2213.     $self->{'fh'} = undef;
  2214. }
  2215.  
  2216. # Make sure I close my file handle
  2217. sub endRead    # Archive::Zip::FileMember
  2218. {
  2219.     my $self = shift;
  2220.     $self->_closeFile();
  2221.     return $self->SUPER::endRead(@_);
  2222. }
  2223.  
  2224. sub _become    # Archive::Zip::FileMember
  2225. {
  2226.     my $self     = shift;
  2227.     my $newClass = shift;
  2228.     return $self if ref($self) eq $newClass;
  2229.     delete( $self->{'externalFileName'} );
  2230.     delete( $self->{'fh'} );
  2231.     return $self->SUPER::_become($newClass);
  2232. }
  2233.  
  2234. # ----------------------------------------------------------------------
  2235. # class Archive::Zip::NewFileMember
  2236. # Used when adding a pre-existing file to an archive
  2237. # ----------------------------------------------------------------------
  2238.  
  2239. package Archive::Zip::NewFileMember;
  2240. use vars qw( @ISA );
  2241. @ISA = qw ( Archive::Zip::FileMember );
  2242.  
  2243. BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :UTILITY_METHODS ) }
  2244.  
  2245. # Given a file name, set up for eventual writing.
  2246. sub _newFromFileNamed    # Archive::Zip::NewFileMember
  2247. {
  2248.     my $class    = shift;
  2249.     my $fileName = shift;    # local FS format
  2250.     my $newName  = shift || Archive::Zip::_asZipDirName($fileName);
  2251.     return undef unless ( stat($fileName) && -r _ && !-d _ );
  2252.     my $self = $class->new(@_);
  2253.     $self->fileName($newName);
  2254.     $self->{'externalFileName'}  = $fileName;
  2255.     $self->{'compressionMethod'} = COMPRESSION_STORED;
  2256.     my @stat = stat(_);
  2257.     $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
  2258.     $self->desiredCompressionMethod( ( $self->compressedSize() > 0 ) 
  2259.         ? COMPRESSION_DEFLATED
  2260.         : COMPRESSION_STORED );
  2261.     $self->unixFileAttributes( $stat[2] );
  2262.     $self->setLastModFileDateTimeFromUnix( $stat[9] );
  2263.     $self->isTextFile( -T _ );
  2264.     return $self;
  2265. }
  2266.  
  2267. sub rewindData    # Archive::Zip::NewFileMember
  2268. {
  2269.     my $self = shift;
  2270.  
  2271.     my $status = $self->SUPER::rewindData(@_);
  2272.     return $status unless $status == AZ_OK;
  2273.  
  2274.     return AZ_IO_ERROR unless $self->fh();
  2275.     $self->fh()->clearerr();
  2276.     $self->fh()->seek( 0, IO::Seekable::SEEK_SET )
  2277.       or return _ioError( "rewinding", $self->externalFileName() );
  2278.     return AZ_OK;
  2279. }
  2280.  
  2281. # Return bytes read. Note that first parameter is a ref to a buffer.
  2282. # my $data;
  2283. # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
  2284. sub _readRawChunk    # Archive::Zip::NewFileMember
  2285. {
  2286.     my ( $self, $dataRef, $chunkSize ) = @_;
  2287.     return ( 0, AZ_OK ) unless $chunkSize;
  2288.     my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
  2289.       or return ( 0, _ioError("reading data") );
  2290.     return ( $bytesRead, AZ_OK );
  2291. }
  2292.  
  2293. # If I already exist, extraction is a no-op.
  2294. sub extractToFileNamed    # Archive::Zip::NewFileMember
  2295. {
  2296.     my $self = shift;
  2297.     my $name = shift;    # local FS name
  2298.     if ( File::Spec->rel2abs($name) eq
  2299.         File::Spec->rel2abs( $self->externalFileName() ) and -r $name )
  2300.     {
  2301.         return AZ_OK;
  2302.     }
  2303.     else
  2304.     {
  2305.         return $self->SUPER::extractToFileNamed( $name, @_ );
  2306.     }
  2307. }
  2308.  
  2309. # ----------------------------------------------------------------------
  2310. # class Archive::Zip::ZipFileMember
  2311. # This represents a member in an existing zip file on disk.
  2312. # ----------------------------------------------------------------------
  2313.  
  2314. package Archive::Zip::ZipFileMember;
  2315. use vars qw( @ISA );
  2316. @ISA = qw ( Archive::Zip::FileMember );
  2317.  
  2318. BEGIN
  2319. {
  2320.     use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
  2321.       :UTILITY_METHODS );
  2322. }
  2323.  
  2324. # Create a new Archive::Zip::ZipFileMember
  2325. # given a filename and optional open file handle
  2326. sub _newFromZipFile    # Archive::Zip::ZipFileMember
  2327. {
  2328.     my $class            = shift;
  2329.     my $fh               = shift;
  2330.     my $externalFileName = shift;
  2331.     my $self             = $class->new(
  2332.         'crc32'                     => 0,
  2333.         'diskNumberStart'           => 0,
  2334.         'localHeaderRelativeOffset' => 0,
  2335.         'dataOffset' => 0,    # localHeaderRelativeOffset + header length
  2336.         @_
  2337.     );
  2338.     $self->{'externalFileName'} = $externalFileName;
  2339.     $self->{'fh'}               = $fh;
  2340.     return $self;
  2341. }
  2342.  
  2343. sub isDirectory    # Archive::Zip::FileMember
  2344. {
  2345.     my $self = shift;
  2346.     return ( substr( $self->fileName(), -1, 1 ) eq '/'
  2347.         and $self->uncompressedSize() == 0 );
  2348. }
  2349.  
  2350. # Because I'm going to delete the file handle, read the local file
  2351. # header if the file handle is seekable. If it isn't, I assume that
  2352. # I've already read the local header.
  2353. # Return ( $status, $self )
  2354.  
  2355. sub _become    # Archive::Zip::ZipFileMember
  2356. {
  2357.     my $self     = shift;
  2358.     my $newClass = shift;
  2359.     return $self if ref($self) eq $newClass;
  2360.  
  2361.     my $status = AZ_OK;
  2362.  
  2363.     if ( _isSeekable( $self->fh() ) )
  2364.     {
  2365.         my $here = $self->fh()->tell();
  2366.         $status =
  2367.           $self->fh()
  2368.           ->seek( $self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
  2369.             IO::Seekable::SEEK_SET );
  2370.         if ( !$status )
  2371.         {
  2372.             $self->fh()->seek($here);
  2373.             _ioError("seeking to local header");
  2374.             return $self;
  2375.         }
  2376.         $self->_readLocalFileHeader();
  2377.         $self->fh()->seek( $here, IO::Seekable::SEEK_SET );
  2378.     }
  2379.  
  2380.     delete( $self->{'diskNumberStart'} );
  2381.     delete( $self->{'localHeaderRelativeOffset'} );
  2382.     delete( $self->{'dataOffset'} );
  2383.  
  2384.     return $self->SUPER::_become($newClass);
  2385. }
  2386.  
  2387. sub diskNumberStart    # Archive::Zip::ZipFileMember
  2388. {
  2389.     shift->{'diskNumberStart'};
  2390. }
  2391.  
  2392. sub localHeaderRelativeOffset    # Archive::Zip::ZipFileMember
  2393. {
  2394.     shift->{'localHeaderRelativeOffset'};
  2395. }
  2396.  
  2397. sub dataOffset    # Archive::Zip::ZipFileMember
  2398. {
  2399.     shift->{'dataOffset'};
  2400. }
  2401.  
  2402. # Skip local file header, updating only extra field stuff.
  2403. # Assumes that fh is positioned before signature.
  2404. sub _skipLocalFileHeader    # Archive::Zip::ZipFileMember
  2405. {
  2406.     my $self = shift;
  2407.     my $header;
  2408.     my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
  2409.     if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH )
  2410.     {
  2411.         return _ioError("reading local file header");
  2412.     }
  2413.     my $fileNameLength;
  2414.     my $extraFieldLength;
  2415.     ( undef,    # $self->{'versionNeededToExtract'},
  2416.       undef,    # $self->{'bitFlag'},
  2417.       undef,    # $self->{'compressionMethod'},
  2418.       undef,    # $self->{'lastModFileDateTime'},
  2419.       undef,    # $crc32,
  2420.       undef,    # $compressedSize,
  2421.       undef,    # $uncompressedSize,
  2422.       $fileNameLength,
  2423.       $extraFieldLength )
  2424.       = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
  2425.  
  2426.     if ($fileNameLength)
  2427.     {
  2428.         $self->fh()->seek( $fileNameLength, IO::Seekable::SEEK_CUR )
  2429.           or return _ioError("skipping local file name");
  2430.     }
  2431.  
  2432.     if ($extraFieldLength)
  2433.     {
  2434.         $bytesRead =
  2435.           $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
  2436.         if ( $bytesRead != $extraFieldLength )
  2437.         {
  2438.             return _ioError("reading local extra field");
  2439.         }
  2440.     }
  2441.  
  2442.     $self->{'dataOffset'} = $self->fh()->tell();
  2443.  
  2444.     return AZ_OK;
  2445. }
  2446.  
  2447. # Read from a local file header into myself. Returns AZ_OK if successful.
  2448. # Assumes that fh is positioned after signature.
  2449. # Note that crc32, compressedSize, and uncompressedSize will be 0 if
  2450. # GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag.
  2451.  
  2452. sub _readLocalFileHeader    # Archive::Zip::ZipFileMember
  2453. {
  2454.     my $self = shift;
  2455.     my $header;
  2456.     my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
  2457.     if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH )
  2458.     {
  2459.         return _ioError("reading local file header");
  2460.     }
  2461.     my $fileNameLength;
  2462.     my $crc32;
  2463.     my $compressedSize;
  2464.     my $uncompressedSize;
  2465.     my $extraFieldLength;
  2466.     ( $self->{'versionNeededToExtract'}, $self->{'bitFlag'},
  2467.            $self->{'compressionMethod'}, $self->{'lastModFileDateTime'},
  2468.            $crc32,                       $compressedSize,
  2469.            $uncompressedSize,            $fileNameLength,
  2470.       $extraFieldLength )
  2471.       = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
  2472.  
  2473.     if ($fileNameLength)
  2474.     {
  2475.         my $fileName;
  2476.         $bytesRead = $self->fh()->read( $fileName, $fileNameLength );
  2477.         if ( $bytesRead != $fileNameLength )
  2478.         {
  2479.             return _ioError("reading local file name");
  2480.         }
  2481.         $self->fileName($fileName);
  2482.     }
  2483.  
  2484.     if ($extraFieldLength)
  2485.     {
  2486.         $bytesRead =
  2487.           $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
  2488.         if ( $bytesRead != $extraFieldLength )
  2489.         {
  2490.             return _ioError("reading local extra field");
  2491.         }
  2492.     }
  2493.  
  2494.     $self->{'dataOffset'} = $self->fh()->tell();
  2495.  
  2496.     # Don't trash these fields from the CD if we already have them.
  2497.     if ( not $self->hasDataDescriptor() )
  2498.     {
  2499.         $self->{'crc32'}            = $crc32;
  2500.         $self->{'compressedSize'}   = $compressedSize;
  2501.         $self->{'uncompressedSize'} = $uncompressedSize;
  2502.     }
  2503.  
  2504.     # We ignore data descriptors (we don't read them,
  2505.     # and we compute elsewhere whether we need to write them ).
  2506.     # And, we have the necessary data from the CD header.
  2507.     # So mark this entry as not having a data descriptor.
  2508.     $self->hasDataDescriptor(0);
  2509.  
  2510.     return AZ_OK;
  2511. }
  2512.  
  2513. # This will read the data descriptor, which is at the end of files that have
  2514. # GPBF_HAS_DATA_DESCRIPTOR_MASK set in their bitFlag.
  2515. # Note that you have to seek to the end of the compressed file to find this to
  2516. # read.
  2517. # sub _readDataDescriptor
  2518. # {
  2519. #     my $self = shift;
  2520. #     my $header;
  2521. #     $self->fh()->read( $header, DATA_DESCRIPTOR_LENGTH )
  2522. #         or return _ioError( "reading data descriptor" );
  2523. #     (
  2524. #         $self->{'crc32'},
  2525. #         $self->{'compressedSize'},
  2526. #         $self->{'uncompressedSize'}
  2527. #      ) = unpack( DATA_DESCRIPTOR_FORMAT, $header );
  2528. #     return AZ_OK;
  2529. # }
  2530.  
  2531. # Read a Central Directory header. Return AZ_OK on success.
  2532. # Assumes that fh is positioned right after the signature.
  2533.  
  2534. sub _readCentralDirectoryFileHeader    # Archive::Zip::ZipFileMember
  2535. {
  2536.     my $self      = shift;
  2537.     my $fh        = $self->fh();
  2538.     my $header    = '';
  2539.     my $bytesRead = $fh->read( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH );
  2540.     if ( $bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
  2541.     {
  2542.         return _ioError("reading central dir header");
  2543.     }
  2544.     my ( $fileNameLength, $extraFieldLength, $fileCommentLength );
  2545.     ( $self->{'versionMadeBy'},          $self->{'fileAttributeFormat'},
  2546.       $self->{'versionNeededToExtract'}, $self->{'bitFlag'},
  2547.       $self->{'compressionMethod'},      $self->{'lastModFileDateTime'},
  2548.       $self->{'crc32'},                  $self->{'compressedSize'},
  2549.       $self->{'uncompressedSize'},       $fileNameLength,
  2550.       $extraFieldLength,                 $fileCommentLength,
  2551.       $self->{'diskNumberStart'},        $self->{'internalFileAttributes'},
  2552.       $self->{'externalFileAttributes'}, $self->{'localHeaderRelativeOffset'} )
  2553.       = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
  2554.  
  2555.     if ($fileNameLength)
  2556.     {
  2557.         $bytesRead = $fh->read( $self->{'fileName'}, $fileNameLength );
  2558.         if ( $bytesRead != $fileNameLength )
  2559.         {
  2560.             _ioError("reading central dir filename");
  2561.         }
  2562.     }
  2563.     if ($extraFieldLength)
  2564.     {
  2565.         $bytesRead = $fh->read( $self->{'cdExtraField'}, $extraFieldLength );
  2566.         if ( $bytesRead != $extraFieldLength )
  2567.         {
  2568.             return _ioError("reading central dir extra field");
  2569.         }
  2570.     }
  2571.     if ($fileCommentLength)
  2572.     {
  2573.         $bytesRead = $fh->read( $self->{'fileComment'}, $fileCommentLength );
  2574.         if ( $bytesRead != $fileCommentLength )
  2575.         {
  2576.             return _ioError("reading central dir file comment");
  2577.         }
  2578.     }
  2579.  
  2580.     $self->desiredCompressionMethod( $self->compressionMethod() );
  2581.  
  2582.     return AZ_OK;
  2583. }
  2584.  
  2585. sub rewindData    # Archive::Zip::ZipFileMember
  2586. {
  2587.     my $self = shift;
  2588.  
  2589.     my $status = $self->SUPER::rewindData(@_);
  2590.     return $status unless $status == AZ_OK;
  2591.  
  2592.     return AZ_IO_ERROR unless $self->fh();
  2593.  
  2594.     $self->fh()->clearerr();
  2595.  
  2596.     # Seek to local file header.
  2597.     # The only reason that I'm doing this this way is that the extraField
  2598.     # length seems to be different between the CD header and the LF header.
  2599.     $self->fh()
  2600.       ->seek( $self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
  2601.         IO::Seekable::SEEK_SET )
  2602.       or return _ioError("seeking to local header");
  2603.  
  2604.     # skip local file header
  2605.     $status = $self->_skipLocalFileHeader();
  2606.     return $status unless $status == AZ_OK;
  2607.  
  2608.     # Seek to beginning of file data
  2609.     $self->fh()->seek( $self->dataOffset(), IO::Seekable::SEEK_SET )
  2610.       or return _ioError("seeking to beginning of file data");
  2611.  
  2612.     return AZ_OK;
  2613. }
  2614.  
  2615. # Return bytes read. Note that first parameter is a ref to a buffer.
  2616. # my $data;
  2617. # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
  2618. sub _readRawChunk    # Archive::Zip::ZipFileMember
  2619. {
  2620.     my ( $self, $dataRef, $chunkSize ) = @_;
  2621.     return ( 0, AZ_OK ) unless $chunkSize;
  2622.     my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
  2623.       or return ( 0, _ioError("reading data") );
  2624.     return ( $bytesRead, AZ_OK );
  2625. }
  2626.  
  2627. # ----------------------------------------------------------------------
  2628. # class Archive::Zip::StringMember ( concrete )
  2629. # A Zip member whose data lives in a string
  2630. # ----------------------------------------------------------------------
  2631.  
  2632. package Archive::Zip::StringMember;
  2633. use vars qw( @ISA );
  2634. @ISA = qw ( Archive::Zip::Member );
  2635.  
  2636. BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES ) }
  2637.  
  2638. # Create a new string member. Default is COMPRESSION_STORED.
  2639. # Can take a ref to a string as well.
  2640. sub _newFromString    # Archive::Zip::StringMember
  2641. {
  2642.     my $class  = shift;
  2643.     my $string = shift;
  2644.     my $name   = shift;
  2645.     my $self   = $class->new(@_);
  2646.     $self->contents($string);
  2647.     $self->fileName($name) if defined($name);
  2648.  
  2649.     # Set the file date to now
  2650.     $self->setLastModFileDateTimeFromUnix( time() );
  2651.     $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
  2652.     return $self;
  2653. }
  2654.  
  2655. sub _become    # Archive::Zip::StringMember
  2656. {
  2657.     my $self     = shift;
  2658.     my $newClass = shift;
  2659.     return $self if ref($self) eq $newClass;
  2660.     delete( $self->{'contents'} );
  2661.     return $self->SUPER::_become($newClass);
  2662. }
  2663.  
  2664. # Get or set my contents. Note that we do not call the superclass
  2665. # version of this, because it calls us.
  2666. sub contents    # Archive::Zip::StringMember
  2667. {
  2668.     my $self   = shift;
  2669.     my $string = shift;
  2670.     if ( defined($string) )
  2671.     {
  2672.         $self->{'contents'} = ( ref($string) eq 'SCALAR' ) ? $$string : $string;
  2673.         $self->{'uncompressedSize'} = $self->{'compressedSize'} =
  2674.           length( $self->{'contents'} );
  2675.         $self->{'compressionMethod'} = COMPRESSION_STORED;
  2676.     }
  2677.     return $self->{'contents'};
  2678. }
  2679.  
  2680. # Return bytes read. Note that first parameter is a ref to a buffer.
  2681. # my $data;
  2682. # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
  2683. sub _readRawChunk    # Archive::Zip::StringMember
  2684. {
  2685.     my ( $self, $dataRef, $chunkSize ) = @_;
  2686.     $$dataRef = substr( $self->contents(), $self->_readOffset(), $chunkSize );
  2687.     return ( length($$dataRef), AZ_OK );
  2688. }
  2689.  
  2690. 1;
  2691. __END__
  2692.  
  2693.  
  2694. # vim: ts=4 sw=4 tw=80 wrap
  2695.