releasing/cbrtools/perl/Archive/Zip.pm
changeset 602 3145852acc89
equal deleted inserted replaced
600:6d08f4a05d93 602:3145852acc89
       
     1 #! perl -w
       
     2 # $Revision: 1.39 $
       
     3 
       
     4 # Copyright (c) 2000 Ned Konz. All rights reserved.  This program is free
       
     5 # software; you can redistribute it and/or modify it under the same terms
       
     6 # as Perl itself.
       
     7 
       
     8 =head1 NAME
       
     9 
       
    10 Archive::Zip - Provide an interface to ZIP archive files.
       
    11 
       
    12 =head1 SYNOPSIS
       
    13 
       
    14  use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
       
    15 
       
    16  my $zip = Archive::Zip->new();
       
    17  my $member = $zip->addDirectory( 'dirname/' );
       
    18  $member = $zip->addString( 'This is a test', 'stringMember.txt' );
       
    19  $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
       
    20  $member = $zip->addFile( 'xyz.pl', 'AnotherName.pl' );
       
    21 
       
    22  die 'write error' if $zip->writeToFileNamed( 'someZip.zip' ) != AZ_OK;
       
    23 
       
    24  $zip = Archive::Zip->new();
       
    25  die 'read error' if $zip->read( 'someZip.zip' ) != AZ_OK;
       
    26 
       
    27  $member = $zip->memberNamed( 'stringMember.txt' );
       
    28  $member->desiredCompressionMethod( COMPRESSION_STORED );
       
    29 
       
    30  die 'write error' if $zip->writeToFileNamed( 'someOtherZip.zip' ) != AZ_OK;
       
    31 
       
    32 =head1 DESCRIPTION
       
    33 
       
    34 The Archive::Zip module allows a Perl program to create,
       
    35 manipulate, read, and write Zip archive files.
       
    36 
       
    37 Zip archives can be created, or you can read from existing zip files.
       
    38 Once created, they can be written to files, streams, or strings.
       
    39 
       
    40 Members can be added, removed, extracted, replaced, rearranged,
       
    41 and enumerated.
       
    42 They can also be renamed or have their dates, comments,
       
    43 or other attributes queried or modified.
       
    44 Their data can be compressed or uncompressed as needed.
       
    45 Members can be created from members in existing Zip files,
       
    46 or from existing directories, files, or strings.
       
    47 
       
    48 This module uses the L<Compress::Zlib|Compress::Zlib> library
       
    49 to read and write the compressed streams inside the files.
       
    50 
       
    51 =head1 EXPORTS
       
    52 
       
    53 =over 4
       
    54 
       
    55 =item :CONSTANTS
       
    56 
       
    57 Exports the following constants:
       
    58 
       
    59 FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
       
    60 GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
       
    61 COMPRESSION_STORED COMPRESSION_DEFLATED
       
    62 IFA_TEXT_FILE_MASK IFA_TEXT_FILE IFA_BINARY_FILE
       
    63 COMPRESSION_LEVEL_NONE
       
    64 COMPRESSION_LEVEL_DEFAULT
       
    65 COMPRESSION_LEVEL_FASTEST
       
    66 COMPRESSION_LEVEL_BEST_COMPRESSION
       
    67 
       
    68 =item :MISC_CONSTANTS
       
    69 
       
    70 Exports the following constants (only necessary for extending the module):
       
    71 
       
    72 FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST
       
    73 FA_OS2_HPFS FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
       
    74 GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
       
    75 GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
       
    76 GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
       
    77 DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
       
    78 DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
       
    79 COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
       
    80 COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
       
    81 COMPRESSION_DEFLATED_ENHANCED
       
    82 COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED
       
    83 
       
    84 =item :ERROR_CODES
       
    85 
       
    86 Explained below. Returned from most methods.
       
    87 
       
    88 AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR
       
    89 
       
    90 =back
       
    91 
       
    92 =head1 OBJECT MODEL
       
    93 
       
    94 =head2 Inheritance
       
    95 
       
    96  Exporter
       
    97     Archive::Zip                            Common base class, has defs.
       
    98         Archive::Zip::Archive               A Zip archive.
       
    99         Archive::Zip::Member                Abstract superclass for all members.
       
   100             Archive::Zip::StringMember      Member made from a string
       
   101             Archive::Zip::FileMember        Member made from an external file
       
   102                 Archive::Zip::ZipFileMember Member that lives in a zip file
       
   103                 Archive::Zip::NewFileMember Member whose data is in a file
       
   104             Archive::Zip::DirectoryMember   Member that is a directory
       
   105 
       
   106 =cut
       
   107 
       
   108 # ----------------------------------------------------------------------
       
   109 # class Archive::Zip
       
   110 # Note that the package Archive::Zip exists only for exporting and
       
   111 # sharing constants. Everything else is in another package
       
   112 # in this file.
       
   113 # Creation of a new Archive::Zip object actually creates a new object
       
   114 # of class Archive::Zip::Archive.
       
   115 # ----------------------------------------------------------------------
       
   116 
       
   117 package Archive::Zip;
       
   118 require 5.003_96;
       
   119 use strict;
       
   120 
       
   121 use Carp ();
       
   122 use IO::File ();
       
   123 use IO::Seekable ();
       
   124 use Compress::Zlib ();
       
   125 use POSIX qw(_exit);
       
   126 
       
   127 use vars qw( @ISA @EXPORT_OK %EXPORT_TAGS $VERSION $ChunkSize $ErrorHandler );
       
   128 
       
   129 if ($Compress::Zlib::VERSION < 1.06)
       
   130 {
       
   131     if ($] < 5.006001)
       
   132     {
       
   133        print STDERR "Your current perl libraries are too old; please upgrade to Perl 5.6.1\n";
       
   134     }
       
   135     else
       
   136     {
       
   137        print STDERR "There is a problem with your perl run time environment.\n An old version of Zlib is in use,\n please check your perl installation (5.6.1 or later) and your perl libraries\n"; 
       
   138     }
       
   139     STDERR->flush;
       
   140     POSIX:_exit(1);
       
   141 }
       
   142 
       
   143 # This is the size we'll try to read, write, and (de)compress.
       
   144 # You could set it to something different if you had lots of memory
       
   145 # and needed more speed.
       
   146 $ChunkSize = 32768;
       
   147 
       
   148 $ErrorHandler = \&Carp::carp;
       
   149 
       
   150 # BEGIN block is necessary here so that other modules can use the constants.
       
   151 BEGIN
       
   152 {
       
   153 	require Exporter;
       
   154 
       
   155 	$VERSION = "0.11";
       
   156 	@ISA = qw( Exporter );
       
   157 
       
   158 	my @ConstantNames = qw( FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
       
   159 	GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
       
   160 	COMPRESSION_STORED COMPRESSION_DEFLATED COMPRESSION_LEVEL_NONE
       
   161 	COMPRESSION_LEVEL_DEFAULT COMPRESSION_LEVEL_FASTEST
       
   162 	COMPRESSION_LEVEL_BEST_COMPRESSION IFA_TEXT_FILE_MASK IFA_TEXT_FILE
       
   163 	IFA_BINARY_FILE );
       
   164 
       
   165 	my @MiscConstantNames = qw( FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST
       
   166 	FA_OS2_HPFS FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
       
   167 	GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
       
   168 	GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
       
   169 	GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
       
   170 	DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
       
   171 	DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
       
   172 	COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
       
   173 	COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
       
   174 	COMPRESSION_DEFLATED_ENHANCED
       
   175 	COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED );
       
   176 
       
   177 	my @ErrorCodeNames = qw( AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR
       
   178 	AZ_IO_ERROR );
       
   179 
       
   180 	my @PKZipConstantNames = qw( SIGNATURE_FORMAT SIGNATURE_LENGTH
       
   181 	LOCAL_FILE_HEADER_SIGNATURE LOCAL_FILE_HEADER_FORMAT
       
   182 	LOCAL_FILE_HEADER_LENGTH DATA_DESCRIPTOR_FORMAT DATA_DESCRIPTOR_LENGTH
       
   183 	CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
       
   184 	CENTRAL_DIRECTORY_FILE_HEADER_FORMAT CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
       
   185 	END_OF_CENTRAL_DIRECTORY_SIGNATURE
       
   186 	END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING END_OF_CENTRAL_DIRECTORY_FORMAT
       
   187 	END_OF_CENTRAL_DIRECTORY_LENGTH );
       
   188 
       
   189 	my @UtilityMethodNames = qw( _error _ioError _formatError
       
   190 		_subclassResponsibility _binmode _isSeekable _newFileHandle);
       
   191 
       
   192 	@EXPORT_OK = ( 'computeCRC32' );
       
   193 	%EXPORT_TAGS = ( 'CONSTANTS' => \@ConstantNames,
       
   194 			'MISC_CONSTANTS' => \@MiscConstantNames,
       
   195 			'ERROR_CODES' => \@ErrorCodeNames,
       
   196 			# The following two sets are for internal use only
       
   197 			'PKZIP_CONSTANTS' => \@PKZipConstantNames,
       
   198 			'UTILITY_METHODS' => \@UtilityMethodNames );
       
   199 
       
   200 	# Add all the constant names and error code names to @EXPORT_OK
       
   201 	Exporter::export_ok_tags( 'CONSTANTS', 'ERROR_CODES',
       
   202 		'PKZIP_CONSTANTS', 'UTILITY_METHODS', 'MISC_CONSTANTS' );
       
   203 }
       
   204 
       
   205 # ------------------------- begin exportable error codes -------------------
       
   206 
       
   207 =head1 ERROR CODES
       
   208 
       
   209 Many of the methods in Archive::Zip return error codes.
       
   210 These are implemented as inline subroutines, using the C<use constant> pragma.
       
   211 They can be imported into your namespace using the C<:CONSTANT>
       
   212 tag:
       
   213 
       
   214     use Archive::Zip qw( :CONSTANTS );
       
   215     ...
       
   216     die "whoops!" if $zip->read( 'myfile.zip' ) != AZ_OK;
       
   217 
       
   218 =over 4
       
   219 
       
   220 =item AZ_OK (0)
       
   221 
       
   222 Everything is fine.
       
   223 
       
   224 =item AZ_STREAM_END (1)
       
   225 
       
   226 The read stream (or central directory) ended normally.
       
   227 
       
   228 =item AZ_ERROR (2)
       
   229 
       
   230 There was some generic kind of error.
       
   231 
       
   232 =item AZ_FORMAT_ERROR (3)
       
   233 
       
   234 There is a format error in a ZIP file being read.
       
   235 
       
   236 =item AZ_IO_ERROR (4)
       
   237 
       
   238 There was an IO error.
       
   239 
       
   240 =back
       
   241 
       
   242 =cut
       
   243 
       
   244 use constant AZ_OK			=> 0;
       
   245 use constant AZ_STREAM_END	=> 1;
       
   246 use constant AZ_ERROR		=> 2;
       
   247 use constant AZ_FORMAT_ERROR => 3;
       
   248 use constant AZ_IO_ERROR	=> 4;
       
   249 
       
   250 # ------------------------- end exportable error codes ---------------------
       
   251 # ------------------------- begin exportable constants ---------------------
       
   252 
       
   253 # File types
       
   254 # Values of Archive::Zip::Member->fileAttributeFormat()
       
   255 
       
   256 use constant FA_MSDOS		=> 0;
       
   257 use constant FA_UNIX		=> 3;
       
   258 
       
   259 # general-purpose bit flag masks
       
   260 # Found in Archive::Zip::Member->bitFlag()
       
   261 
       
   262 use constant GPBF_ENCRYPTED_MASK						=> 1 << 0;
       
   263 use constant GPBF_DEFLATING_COMPRESSION_MASK			=> 3 << 1;
       
   264 use constant GPBF_HAS_DATA_DESCRIPTOR_MASK				=> 1 << 3;
       
   265 
       
   266 # deflating compression types, if compressionMethod == COMPRESSION_DEFLATED
       
   267 # ( Archive::Zip::Member->bitFlag() & GPBF_DEFLATING_COMPRESSION_MASK )
       
   268 
       
   269 use constant DEFLATING_COMPRESSION_NORMAL		=> 0 << 1;
       
   270 use constant DEFLATING_COMPRESSION_MAXIMUM		=> 1 << 1;
       
   271 use constant DEFLATING_COMPRESSION_FAST			=> 2 << 1;
       
   272 use constant DEFLATING_COMPRESSION_SUPER_FAST	=> 3 << 1;
       
   273 
       
   274 # compression method
       
   275 
       
   276 =head1 COMPRESSION
       
   277 
       
   278 Archive::Zip allows each member of a ZIP file to be compressed (using
       
   279 the Deflate algorithm) or uncompressed. Other compression algorithms
       
   280 that some versions of ZIP have been able to produce are not supported.
       
   281 
       
   282 Each member has two compression methods: the one it's stored as (this
       
   283 is always COMPRESSION_STORED for string and external file members),
       
   284 and the one you desire for the member in the zip file.
       
   285 These can be different, of course, so you can make a zip member that
       
   286 is not compressed out of one that is, and vice versa.
       
   287 You can inquire about the current compression and set
       
   288 the desired compression method:
       
   289 
       
   290     my $member = $zip->memberNamed( 'xyz.txt' );
       
   291     $member->compressionMethod();    # return current compression
       
   292     # set to read uncompressed
       
   293     $member->desiredCompressionMethod( COMPRESSION_STORED );
       
   294     # set to read compressed
       
   295     $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
       
   296 
       
   297 There are two different compression methods:
       
   298 
       
   299 =over 4
       
   300 
       
   301 =item COMPRESSION_STORED
       
   302 
       
   303 file is stored (no compression)
       
   304 
       
   305 =item COMPRESSION_DEFLATED
       
   306 
       
   307 file is Deflated
       
   308 
       
   309 =back
       
   310 
       
   311 =head2 Compression Levels
       
   312 
       
   313 If a member's desiredCompressionMethod is COMPRESSION_DEFLATED,
       
   314 you can choose different compression levels. This choice may
       
   315 affect the speed of compression and decompression, as well as
       
   316 the size of the compressed member data.
       
   317 
       
   318     $member->desiredCompressionLevel( 9 );
       
   319 
       
   320 The levels given can be:
       
   321 
       
   322 =over 4
       
   323 
       
   324 =item 0 or COMPRESSION_LEVEL_NONE
       
   325 
       
   326 This is the same as saying
       
   327 
       
   328     $member->desiredCompressionMethod( COMPRESSION_STORED );
       
   329 
       
   330 =item 1 .. 9
       
   331 
       
   332 1 gives the best speed and worst compression, and 9 gives the best
       
   333 compression and worst speed.
       
   334 
       
   335 =item COMPRESSION_LEVEL_FASTEST
       
   336 
       
   337 This is a synonym for level 1.
       
   338 
       
   339 =item COMPRESSION_LEVEL_BEST_COMPRESSION
       
   340 
       
   341 This is a synonym for level 9.
       
   342 
       
   343 =item COMPRESSION_LEVEL_DEFAULT
       
   344 
       
   345 This gives a good compromise between speed and compression, and is
       
   346 currently equivalent to 6 (this is in the zlib code).
       
   347 
       
   348 This is the level that will be used if not specified.
       
   349 
       
   350 =back
       
   351 
       
   352 =cut
       
   353 
       
   354 # these two are the only ones supported in this module
       
   355 use constant COMPRESSION_STORED => 0;	# file is stored (no compression)
       
   356 use constant COMPRESSION_DEFLATED => 8;	# file is Deflated
       
   357 
       
   358 use constant COMPRESSION_LEVEL_NONE => 0;
       
   359 use constant COMPRESSION_LEVEL_DEFAULT => -1;
       
   360 use constant COMPRESSION_LEVEL_FASTEST => 1;
       
   361 use constant COMPRESSION_LEVEL_BEST_COMPRESSION => 9;
       
   362 
       
   363 # internal file attribute bits
       
   364 # Found in Archive::Zip::Member::internalFileAttributes()
       
   365 
       
   366 use constant IFA_TEXT_FILE_MASK	=> 1;
       
   367 use constant IFA_TEXT_FILE		=> 1;	# file is apparently text
       
   368 use constant IFA_BINARY_FILE	=> 0;
       
   369 
       
   370 # PKZIP file format miscellaneous constants (for internal use only)
       
   371 use constant SIGNATURE_FORMAT => "V";
       
   372 use constant SIGNATURE_LENGTH => 4;
       
   373 
       
   374 use constant LOCAL_FILE_HEADER_SIGNATURE	=> 0x04034b50;
       
   375 use constant LOCAL_FILE_HEADER_FORMAT		=> "v3 V4 v2";
       
   376 use constant LOCAL_FILE_HEADER_LENGTH		=> 26;
       
   377 
       
   378 use constant DATA_DESCRIPTOR_FORMAT	=> "V3";
       
   379 use constant DATA_DESCRIPTOR_LENGTH	=> 12;
       
   380 
       
   381 use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE => 0x02014b50;
       
   382 use constant CENTRAL_DIRECTORY_FILE_HEADER_FORMAT => "C2 v3 V4 v5 V2";
       
   383 use constant CENTRAL_DIRECTORY_FILE_HEADER_LENGTH => 42;
       
   384 
       
   385 use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE => 0x06054b50;
       
   386 use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING => pack( "V",
       
   387 	END_OF_CENTRAL_DIRECTORY_SIGNATURE );
       
   388 use constant END_OF_CENTRAL_DIRECTORY_FORMAT => "v4 V2 v";
       
   389 use constant END_OF_CENTRAL_DIRECTORY_LENGTH => 18;
       
   390 
       
   391 use constant FA_AMIGA		=> 1;
       
   392 use constant FA_VAX_VMS		=> 2;
       
   393 use constant FA_VM_CMS		=> 4;
       
   394 use constant FA_ATARI_ST	=> 5;
       
   395 use constant FA_OS2_HPFS	=> 6;
       
   396 use constant FA_MACINTOSH	=> 7;
       
   397 use constant FA_Z_SYSTEM	=> 8;
       
   398 use constant FA_CPM			=> 9;
       
   399 use constant FA_WINDOWS_NTFS => 10;
       
   400 
       
   401 use constant GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK	=> 1 << 1;
       
   402 use constant GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK	=> 1 << 2;
       
   403 use constant GPBF_IS_COMPRESSED_PATCHED_DATA_MASK		=> 1 << 5;
       
   404 
       
   405 # the rest of these are not supported in this module
       
   406 use constant COMPRESSION_SHRUNK => 1;	# file is Shrunk
       
   407 use constant COMPRESSION_REDUCED_1 => 2;# file is Reduced CF=1
       
   408 use constant COMPRESSION_REDUCED_2 => 3;# file is Reduced CF=2
       
   409 use constant COMPRESSION_REDUCED_3 => 4;# file is Reduced CF=3
       
   410 use constant COMPRESSION_REDUCED_4 => 5;# file is Reduced CF=4
       
   411 use constant COMPRESSION_IMPLODED => 6;	# file is Imploded
       
   412 use constant COMPRESSION_TOKENIZED => 7;# reserved for Tokenizing compr.
       
   413 use constant COMPRESSION_DEFLATED_ENHANCED => 9; # reserved for enh. Deflating
       
   414 use constant COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED => 10;
       
   415 
       
   416 # ------------------------- end of exportable constants ---------------------
       
   417 
       
   418 =head1  Archive::Zip methods
       
   419 
       
   420 The Archive::Zip class (and its invisible subclass Archive::Zip::Archive)
       
   421 implement generic zip file functionality.
       
   422 
       
   423 Creating a new Archive::Zip object actually makes an Archive::Zip::Archive
       
   424 object, but you don't have to worry about this unless you're subclassing.
       
   425 
       
   426 =cut
       
   427 
       
   428 =head2 Constructor
       
   429 
       
   430 =over 4
       
   431 
       
   432 =cut
       
   433 
       
   434 use constant ZIPARCHIVECLASS 	=> 'Archive::Zip::Archive';
       
   435 use constant ZIPMEMBERCLASS		=> 'Archive::Zip::Member';
       
   436 
       
   437 #--------------------------------
       
   438 
       
   439 =item new( [$fileName] )
       
   440 
       
   441 Make a new, empty zip archive.
       
   442 
       
   443     my $zip = Archive::Zip->new();
       
   444 
       
   445 If an additional argument is passed, new() will call read() to read the
       
   446 contents of an archive:
       
   447 
       
   448     my $zip = Archive::Zip->new( 'xyz.zip' );
       
   449 
       
   450 If a filename argument is passed and the read fails for any reason, new
       
   451 will return undef. For this reason, it may be better to call read
       
   452 separately.
       
   453 
       
   454 =cut
       
   455 
       
   456 sub new	# Archive::Zip
       
   457 {
       
   458 	my $class = shift;
       
   459 	return $class->ZIPARCHIVECLASS->new( @_ );
       
   460 }
       
   461 
       
   462 =back
       
   463 
       
   464 =head2  Utility Methods
       
   465 
       
   466 These Archive::Zip methods may be called as functions or as object
       
   467 methods. Do not call them as class methods:
       
   468 
       
   469     $zip = Archive::Zip->new();
       
   470     $crc = Archive::Zip::computeCRC32( 'ghijkl' );    # OK
       
   471     $crc = $zip->computeCRC32( 'ghijkl' );            # also OK
       
   472 
       
   473     $crc = Archive::Zip->computeCRC32( 'ghijkl' );    # NOT OK
       
   474 
       
   475 =over 4
       
   476 
       
   477 =cut
       
   478 
       
   479 #--------------------------------
       
   480 
       
   481 =item Archive::Zip::computeCRC32( $string [, $crc] )
       
   482 
       
   483 This is a utility function that uses the Compress::Zlib CRC
       
   484 routine to compute a CRC-32.
       
   485 
       
   486 You can get the CRC of a string:
       
   487 
       
   488     $crc = Archive::Zip::computeCRC32( $string );
       
   489 
       
   490 Or you can compute the running CRC:
       
   491 
       
   492     $crc = 0;
       
   493     $crc = Archive::Zip::computeCRC32( 'abcdef', $crc );
       
   494     $crc = Archive::Zip::computeCRC32( 'ghijkl', $crc );
       
   495 
       
   496 =cut
       
   497 
       
   498 sub computeCRC32	# Archive::Zip
       
   499 {
       
   500 	my $data = shift;
       
   501 	$data = shift if ref( $data );	# allow calling as an obj method
       
   502 	my $crc = shift;
       
   503 	return Compress::Zlib::crc32( $data, $crc );
       
   504 }
       
   505 
       
   506 #--------------------------------
       
   507 
       
   508 =item Archive::Zip::setChunkSize( $number )
       
   509 
       
   510 Change chunk size used for reading and writing.
       
   511 Currently, this defaults to 32K.
       
   512 This is not exportable, so you must call it like:
       
   513 
       
   514     Archive::Zip::setChunkSize( 4096 );
       
   515 
       
   516 or as a method on a zip (though this is a global setting).
       
   517 Returns old chunk size.
       
   518 
       
   519 =cut
       
   520 
       
   521 sub setChunkSize	# Archive::Zip
       
   522 {
       
   523 	my $chunkSize = shift;
       
   524 	$chunkSize = shift if ref( $chunkSize );	# object method on zip?
       
   525 	my $oldChunkSize = $Archive::Zip::ChunkSize;
       
   526 	$Archive::Zip::ChunkSize = $chunkSize;
       
   527 	return $oldChunkSize;
       
   528 }
       
   529 
       
   530 #--------------------------------
       
   531 
       
   532 =item Archive::Zip::setErrorHandler( \&subroutine )
       
   533 
       
   534 Change the subroutine called with error strings.
       
   535 This defaults to \&Carp::carp, but you may want to change
       
   536 it to get the error strings.
       
   537 
       
   538 This is not exportable, so you must call it like:
       
   539 
       
   540     Archive::Zip::setErrorHandler( \&myErrorHandler );
       
   541 
       
   542 If no error handler is passed, resets handler to default.
       
   543 
       
   544 Returns old error handler.
       
   545 
       
   546 Note that if you call Carp::carp or a similar routine
       
   547 or if you're chaining to the default error handler
       
   548 from your error handler, you may want to increment the number
       
   549 of caller levels that are skipped (do not just set it to a number):
       
   550 
       
   551     $Carp::CarpLevel++;
       
   552 
       
   553 =cut
       
   554 
       
   555 sub setErrorHandler (&)	# Archive::Zip
       
   556 {
       
   557 	my $errorHandler = shift;
       
   558 	$errorHandler = \&Carp::carp if ! defined( $errorHandler );
       
   559 	my $oldErrorHandler = $Archive::Zip::ErrorHandler;
       
   560 	$Archive::Zip::ErrorHandler = $errorHandler;
       
   561 	return $oldErrorHandler;
       
   562 }
       
   563 
       
   564 sub _printError	# Archive::Zip
       
   565 {
       
   566 	my $string = join( ' ', @_, "\n" );
       
   567 	my $oldCarpLevel = $Carp::CarpLevel;
       
   568 	$Carp::CarpLevel += 2;
       
   569 	&{ $ErrorHandler }( $string );
       
   570 	$Carp::CarpLevel = $oldCarpLevel;
       
   571 }
       
   572 
       
   573 # This is called on format errors.
       
   574 sub _formatError	# Archive::Zip
       
   575 {
       
   576 	shift if ref( $_[0] );
       
   577 	_printError( 'format error:', @_ );
       
   578 	return AZ_FORMAT_ERROR;
       
   579 }
       
   580 
       
   581 # This is called on IO errors.
       
   582 sub _ioError	# Archive::Zip
       
   583 {
       
   584 	shift if ref( $_[0] );
       
   585 	_printError( 'IO error:', @_, ':', $! );
       
   586 	return AZ_IO_ERROR;
       
   587 }
       
   588 
       
   589 # This is called on generic errors.
       
   590 sub _error	# Archive::Zip
       
   591 {
       
   592 	shift if ref( $_[0] );
       
   593 	_printError( 'error:', @_ );
       
   594 	return AZ_ERROR;
       
   595 }
       
   596 
       
   597 # Called when a subclass should have implemented
       
   598 # something but didn't
       
   599 sub _subclassResponsibility 	# Archive::Zip
       
   600 {
       
   601 	Carp::croak( "subclass Responsibility\n" );
       
   602 }
       
   603 
       
   604 # Try to set the given file handle or object into binary mode.
       
   605 sub _binmode	# Archive::Zip
       
   606 {
       
   607 	my $fh = shift;
       
   608 	return $fh->can( 'binmode' )
       
   609 		?	$fh->binmode()
       
   610 		:	binmode( $fh );
       
   611 }
       
   612 
       
   613 # Attempt to guess whether file handle is seekable.
       
   614 sub _isSeekable	# Archive::Zip
       
   615 {
       
   616 	my $fh = shift;
       
   617 	my ($p0, $p1);
       
   618 	my $seekable = 
       
   619 		( $p0 = $fh->tell() ) >= 0
       
   620 		&& $fh->seek( 1, IO::Seekable::SEEK_CUR )
       
   621 		&& ( $p1 = $fh->tell() ) >= 0
       
   622 		&& $p1 == $p0 + 1
       
   623 		&& $fh->seek( -1, IO::Seekable::SEEK_CUR )
       
   624 		&& $fh->tell() == $p0;
       
   625 	return $seekable;
       
   626 }
       
   627 
       
   628 # Return an opened IO::Handle
       
   629 # my ( $status, fh ) = _newFileHandle( 'fileName', 'w' );
       
   630 # Can take a filename, file handle, or ref to GLOB
       
   631 # Or, if given something that is a ref but not an IO::Handle,
       
   632 # passes back the same thing.
       
   633 sub _newFileHandle	# Archive::Zip
       
   634 {
       
   635 	my $fd = shift;
       
   636 	my $status = 1;
       
   637 	my $handle = IO::File->new();
       
   638 
       
   639 	if ( ref( $fd ) )
       
   640 	{
       
   641 		if ( $fd->isa( 'IO::Handle' ) or $fd->isa( 'GLOB' ) )
       
   642 		{
       
   643 			$status = $handle->fdopen( $fd, @_ );
       
   644 		}
       
   645 		else
       
   646 		{
       
   647 			$handle = $fd;
       
   648 		}
       
   649 	}
       
   650 	else
       
   651 	{
       
   652 		$status = $handle->open( $fd, @_ );
       
   653 	}
       
   654 
       
   655 	return ( $status, $handle );
       
   656 }
       
   657 
       
   658 =back
       
   659 
       
   660 =cut
       
   661 
       
   662 # ----------------------------------------------------------------------
       
   663 # class Archive::Zip::Archive (concrete)
       
   664 # Generic ZIP archive.
       
   665 # ----------------------------------------------------------------------
       
   666 package Archive::Zip::Archive;
       
   667 use File::Path;
       
   668 use File::Basename;
       
   669 
       
   670 use vars qw( @ISA );
       
   671 @ISA = qw( Archive::Zip );
       
   672 
       
   673 BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
       
   674 	:UTILITY_METHODS ) }
       
   675 
       
   676 #--------------------------------
       
   677 # Note that this returns undef on read errors, else new zip object.
       
   678 
       
   679 sub new	# Archive::Zip::Archive
       
   680 {
       
   681 	my $class = shift;
       
   682 	my $self = bless( {
       
   683 		'diskNumber' => 0,
       
   684 		'diskNumberWithStartOfCentralDirectory' => 0,
       
   685 		'numberOfCentralDirectoriesOnThisDisk' => 0, # shld be # of members
       
   686 		'numberOfCentralDirectories' => 0,	# shld be # of members
       
   687 		'centralDirectorySize' => 0,	# must re-compute on write
       
   688 		'centralDirectoryOffsetWRTStartingDiskNumber' => 0,	# must re-compute
       
   689 		'zipfileComment' => ''
       
   690 		}, $class );
       
   691 	$self->{'members'} = [];
       
   692 	if ( @_ )
       
   693 	{
       
   694 		my $status = $self->read( @_ );
       
   695 		return $status == AZ_OK ? $self : undef;
       
   696 	}
       
   697 	return $self;
       
   698 }
       
   699 
       
   700 =head2 Accessors
       
   701 
       
   702 =over 4
       
   703 
       
   704 =cut
       
   705 
       
   706 #--------------------------------
       
   707 
       
   708 =item members()
       
   709 
       
   710 Return a copy of my members array
       
   711 
       
   712     my @members = $zip->members();
       
   713 
       
   714 =cut
       
   715 
       
   716 sub members	# Archive::Zip::Archive
       
   717 { @{ shift->{'members'} } }
       
   718 
       
   719 #--------------------------------
       
   720 
       
   721 =item numberOfMembers()
       
   722 
       
   723 Return the number of members I have
       
   724 
       
   725 =cut
       
   726 
       
   727 sub numberOfMembers	# Archive::Zip::Archive
       
   728 { scalar( shift->members() ) }
       
   729 
       
   730 #--------------------------------
       
   731 
       
   732 =item memberNames()
       
   733 
       
   734 Return a list of the (internal) file names of my members
       
   735 
       
   736 =cut
       
   737 
       
   738 sub memberNames	# Archive::Zip::Archive
       
   739 {
       
   740 	my $self = shift;
       
   741 	return map { $_->fileName() } $self->members();
       
   742 }
       
   743 
       
   744 #--------------------------------
       
   745 
       
   746 =item memberNamed( $string )
       
   747 
       
   748 Return ref to member whose filename equals given filename or undef
       
   749 
       
   750 =cut
       
   751 
       
   752 sub memberNamed	# Archive::Zip::Archive
       
   753 {
       
   754 	my ( $self, $fileName ) = @_;
       
   755 	my ( $retval ) = grep { $_->fileName() eq $fileName } $self->members();
       
   756 	return $retval;
       
   757 }
       
   758 
       
   759 #--------------------------------
       
   760 
       
   761 =item membersMatching( $regex )
       
   762 
       
   763 Return array of members whose filenames match given regular
       
   764 expression in list context.
       
   765 Returns number of matching members in scalar context.
       
   766 
       
   767     my @textFileMembers = $zip->membersMatching( '.*\.txt' );
       
   768     # or
       
   769     my $numberOfTextFiles = $zip->membersMatching( '.*\.txt' );
       
   770 
       
   771 =cut
       
   772 
       
   773 sub membersMatching	# Archive::Zip::Archive
       
   774 {
       
   775 	my ( $self, $pattern ) = @_;
       
   776 	return grep { $_->fileName() =~ /$pattern/ } $self->members();
       
   777 }
       
   778 
       
   779 #--------------------------------
       
   780 
       
   781 =item diskNumber()
       
   782 
       
   783 Return the disk that I start on.
       
   784 Not used for writing zips, but might be interesting if you read a zip in.
       
   785 This had better be 0, as Archive::Zip does not handle multi-volume archives.
       
   786 
       
   787 =cut
       
   788 
       
   789 sub diskNumber	# Archive::Zip::Archive
       
   790 { shift->{'diskNumber'} }
       
   791 
       
   792 #--------------------------------
       
   793 
       
   794 =item diskNumberWithStartOfCentralDirectory()
       
   795 
       
   796 Return the disk number that holds the beginning of the central directory.
       
   797 Not used for writing zips, but might be interesting if you read a zip in.
       
   798 This had better be 0, as Archive::Zip does not handle multi-volume archives.
       
   799 
       
   800 =cut
       
   801 
       
   802 sub diskNumberWithStartOfCentralDirectory	# Archive::Zip::Archive
       
   803 { shift->{'diskNumberWithStartOfCentralDirectory'} }
       
   804 
       
   805 #--------------------------------
       
   806 
       
   807 =item numberOfCentralDirectoriesOnThisDisk()
       
   808 
       
   809 Return the number of CD structures on this disk.
       
   810 Not used for writing zips, but might be interesting if you read a zip in.
       
   811 
       
   812 =cut
       
   813 
       
   814 sub numberOfCentralDirectoriesOnThisDisk	# Archive::Zip::Archive
       
   815 { shift->{'numberOfCentralDirectoriesOnThisDisk'} }
       
   816 
       
   817 #--------------------------------
       
   818 
       
   819 =item numberOfCentralDirectories()
       
   820 
       
   821 Return the number of CD structures in the whole zip.
       
   822 Not used for writing zips, but might be interesting if you read a zip in.
       
   823 
       
   824 =cut
       
   825 
       
   826 sub numberOfCentralDirectories	# Archive::Zip::Archive
       
   827 { shift->{'numberOfCentralDirectories'} }
       
   828 
       
   829 #--------------------------------
       
   830 
       
   831 =item centralDirectorySize()
       
   832 
       
   833 Returns central directory size, as read from an external zip file.
       
   834 Not used for writing zips, but might be interesting if you read a zip in.
       
   835 
       
   836 =cut
       
   837 
       
   838 sub centralDirectorySize	# Archive::Zip::Archive
       
   839 { shift->{'centralDirectorySize'} }
       
   840 
       
   841 #--------------------------------
       
   842 
       
   843 =item centralDirectoryOffsetWRTStartingDiskNumber()
       
   844 
       
   845 Returns the offset into the zip file where the CD begins.
       
   846 Not used for writing zips, but might be interesting if you read a zip in.
       
   847 
       
   848 =cut
       
   849 
       
   850 sub centralDirectoryOffsetWRTStartingDiskNumber	# Archive::Zip::Archive
       
   851 { shift->{'centralDirectoryOffsetWRTStartingDiskNumber'} }
       
   852 
       
   853 #--------------------------------
       
   854 
       
   855 =item zipfileComment( [$string] )
       
   856 
       
   857 Get or set the zipfile comment.
       
   858 Returns the old comment.
       
   859 
       
   860     print $zip->zipfileComment();
       
   861     $zip->zipfileComment( 'New Comment' );
       
   862 
       
   863 =cut
       
   864 
       
   865 sub zipfileComment	# Archive::Zip::Archive
       
   866 {
       
   867 	my $self = shift;
       
   868 	my $comment = $self->{'zipfileComment'};
       
   869 	if ( @_ )
       
   870 	{
       
   871 		$self->{'zipfileComment'} = shift;
       
   872 	}
       
   873 	return $comment;
       
   874 }
       
   875 
       
   876 =back
       
   877 
       
   878 =head2 Member Operations
       
   879 
       
   880 Various operations on a zip file modify members.
       
   881 When a member is passed as an argument, you can either use a reference
       
   882 to the member itself, or the name of a member. Of course, using the
       
   883 name requires that names be unique within a zip (this is not enforced).
       
   884 
       
   885 =over 4
       
   886 
       
   887 =cut
       
   888 
       
   889 #--------------------------------
       
   890 
       
   891 =item removeMember( $memberOrName )
       
   892 
       
   893 Remove and return the given member, or match its name and remove it.
       
   894 Returns undef if member name doesn't exist in this Zip.
       
   895 No-op if member does not belong to this zip.
       
   896 
       
   897 =cut
       
   898 
       
   899 sub removeMember	# Archive::Zip::Archive
       
   900 {
       
   901 	my ( $self, $member ) = @_;
       
   902 	$member = $self->memberNamed( $member ) if ! ref( $member );
       
   903 	return undef if ! $member;
       
   904 	my @newMembers = grep { $_ != $member } $self->members();
       
   905 	$self->{'members'} = \@newMembers;
       
   906 	return $member;
       
   907 }
       
   908 
       
   909 #--------------------------------
       
   910 
       
   911 =item replaceMember( $memberOrName, $newMember )
       
   912 
       
   913 Remove and return the given member, or match its name and remove it.
       
   914 Replace with new member.
       
   915 Returns undef if member name doesn't exist in this Zip.
       
   916 
       
   917     my $member1 = $zip->removeMember( 'xyz' );
       
   918     my $member2 = $zip->replaceMember( 'abc', $member1 );
       
   919     # now, $member2 (named 'abc') is not in $zip,
       
   920     # and $member1 (named 'xyz') is, having taken $member2's place.
       
   921 
       
   922 =cut
       
   923 
       
   924 sub replaceMember	# Archive::Zip::Archive
       
   925 {
       
   926 	my ( $self, $oldMember, $newMember ) = @_;
       
   927 	$oldMember = $self->memberNamed( $oldMember ) if ! ref( $oldMember );
       
   928 	return undef if ! $oldMember;
       
   929 	my @newMembers
       
   930 		= map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
       
   931 	$self->{'members'} = \@newMembers;
       
   932 	return $oldMember;
       
   933 }
       
   934 
       
   935 #--------------------------------
       
   936 
       
   937 =item extractMember( $memberOrName [, $extractedName ] )
       
   938 
       
   939 Extract the given member, or match its name and extract it.
       
   940 Returns undef if member doesn't exist in this Zip.
       
   941 If optional second arg is given, use it as the name of the
       
   942 extracted member. Otherwise, the internal filename of the member is used
       
   943 as the name of the extracted file or directory.
       
   944 
       
   945 All necessary directories will be created.
       
   946 
       
   947 Returns C<AZ_OK> on success.
       
   948 
       
   949 =cut
       
   950 
       
   951 sub extractMember	# Archive::Zip::Archive
       
   952 {
       
   953 	my $self = shift;
       
   954 	my $member = shift;
       
   955 	$member = $self->memberNamed( $member ) if ! ref( $member );
       
   956 	return _error( 'member not found' ) if !$member;
       
   957 	my $name = shift;
       
   958 	$name = $member->fileName() if not $name;
       
   959 	my $dirName = dirname( $name );
       
   960 	mkpath( $dirName ) if ( ! -d $dirName );
       
   961 	return _ioError( "can't create dir $dirName" ) if ( ! -d $dirName );
       
   962 	return $member->extractToFileNamed( $name, @_ );
       
   963 }
       
   964 
       
   965 #--------------------------------
       
   966 
       
   967 =item extractMemberWithoutPaths( $memberOrName [, $extractedName ] )
       
   968 
       
   969 Extract the given member, or match its name and extract it.
       
   970 Does not use path information (extracts into the current directory).
       
   971 Returns undef if member doesn't exist in this Zip.
       
   972 If optional second arg is given, use it as the name of the
       
   973 extracted member (its paths will be deleted too).
       
   974 Otherwise, the internal filename of the member (minus paths) is used
       
   975 as the name of the extracted file or directory.
       
   976 
       
   977 Returns C<AZ_OK> on success.
       
   978 
       
   979 =cut
       
   980 
       
   981 sub extractMemberWithoutPaths	# Archive::Zip::Archive
       
   982 {
       
   983 	my $self = shift;
       
   984 	my $member = shift;
       
   985 	$member = $self->memberNamed( $member ) if ! ref( $member );
       
   986 	return _error( 'member not found' ) if !$member;
       
   987 	my $name = shift;
       
   988 	$name = $member->fileName() if not $name;
       
   989 	$name = basename( $name );
       
   990 	return $member->extractToFileNamed( $name, @_ );
       
   991 }
       
   992 
       
   993 #--------------------------------
       
   994 
       
   995 =item addMember( $member )
       
   996 
       
   997 Append a member (possibly from another zip file) to the zip file.
       
   998 Returns the new member.
       
   999 Generally, you will use addFile(), addDirectory(), addString(), or read()
       
  1000 to add members.
       
  1001 
       
  1002     # Move member named 'abc' to end of zip:
       
  1003     my $member = $zip->removeMember( 'abc' );
       
  1004     $zip->addMember( $member );
       
  1005 
       
  1006 =cut
       
  1007 
       
  1008 sub addMember	# Archive::Zip::Archive
       
  1009 {
       
  1010 	my ( $self, $newMember ) = @_;
       
  1011 	push( @{ $self->{'members'} }, $newMember ) if $newMember;
       
  1012 	return $newMember;
       
  1013 }
       
  1014 
       
  1015 #--------------------------------
       
  1016 
       
  1017 =item addFile( $fileName [, $newName ] )
       
  1018 
       
  1019 Append a member whose data comes from an external file,
       
  1020 returning the member or undef.
       
  1021 The member will have its file name set to the name of the external
       
  1022 file, and its desiredCompressionMethod set to COMPRESSION_DEFLATED.
       
  1023 The file attributes and last modification time will be set from the file.
       
  1024 
       
  1025 If the name given does not represent a readable plain file or symbolic link,
       
  1026 undef will be returned.
       
  1027 
       
  1028 The text mode bit will be set if the contents appears to be text (as returned
       
  1029 by the C<-T> perl operator).
       
  1030 
       
  1031 The optional second argument sets the internal file name to
       
  1032 something different than the given $fileName.
       
  1033 
       
  1034 =cut
       
  1035 
       
  1036 sub addFile	# Archive::Zip::Archive
       
  1037 {
       
  1038 	my $self = shift;
       
  1039 	my $fileName = shift;
       
  1040 	my $newName = shift;
       
  1041 	my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName );
       
  1042 	if (defined($newMember))
       
  1043 	{
       
  1044 		$self->addMember( $newMember );
       
  1045 		$newMember->fileName( $newName ) if defined( $newName );
       
  1046 	}
       
  1047 	return $newMember;
       
  1048 }
       
  1049 
       
  1050 #--------------------------------
       
  1051 
       
  1052 =item addString( $stringOrStringRef [, $name] )
       
  1053 
       
  1054 Append a member created from the given string or string reference.
       
  1055 The name is given by the optional second argument.
       
  1056 Returns the new member.
       
  1057 
       
  1058 The last modification time will be set to now,
       
  1059 and the file attributes will be set to permissive defaults.
       
  1060 
       
  1061     my $member = $zip->addString( 'This is a test', 'test.txt' );
       
  1062 
       
  1063 =cut
       
  1064 
       
  1065 sub addString	# Archive::Zip::Archive
       
  1066 {
       
  1067 	my $self = shift;
       
  1068 	my $newMember = $self->ZIPMEMBERCLASS->newFromString( @_ );
       
  1069 	return $self->addMember( $newMember );
       
  1070 }
       
  1071 
       
  1072 #--------------------------------
       
  1073 
       
  1074 =item addDirectory( $directoryName [, $fileName ] )
       
  1075 
       
  1076 Append a member created from the given directory name.
       
  1077 The directory name does not have to name an existing directory.
       
  1078 If the named directory exists, the file modification time and permissions
       
  1079 are set from the existing directory, otherwise they are set to now and
       
  1080 permissive default permissions.
       
  1081 The optional second argument sets the name of the archive member
       
  1082 (which defaults to $directoryName)
       
  1083 
       
  1084 Returns the new member.
       
  1085 
       
  1086 =cut
       
  1087 
       
  1088 sub addDirectory	# Archive::Zip::Archive
       
  1089 {
       
  1090 	my ( $self, $name, $newName ) = @_;
       
  1091 	my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name );
       
  1092 	$self->addMember( $newMember );
       
  1093 	$newMember->fileName( $newName ) if defined( $newName );
       
  1094 	return $newMember;
       
  1095 }
       
  1096 
       
  1097 #--------------------------------
       
  1098 
       
  1099 =item contents( $memberOrMemberName [, $newContents ] )
       
  1100 
       
  1101 Returns the uncompressed data for a particular member, or undef.
       
  1102 
       
  1103     print "xyz.txt contains " . $zip->contents( 'xyz.txt' );
       
  1104 
       
  1105 Also can change the contents of a member:
       
  1106 
       
  1107     $zip->contents( 'xyz.txt', 'This is the new contents' );
       
  1108 
       
  1109 =cut
       
  1110 
       
  1111 sub contents	# Archive::Zip::Archive
       
  1112 {
       
  1113 	my ( $self, $member, $newContents ) = @_;
       
  1114 	$member = $self->memberNamed( $member ) if ! ref( $member );
       
  1115 	return undef if ! $member;
       
  1116 	return $member->contents( $newContents );
       
  1117 }
       
  1118 
       
  1119 #--------------------------------
       
  1120 
       
  1121 =item writeToFileNamed( $fileName )
       
  1122 
       
  1123 Write a zip archive to named file.
       
  1124 Returns C<AZ_OK> on success.
       
  1125 
       
  1126 Note that if you use the same name as an existing
       
  1127 zip file that you read in, you will clobber ZipFileMembers.
       
  1128 So instead, write to a different file name, then delete
       
  1129 the original.
       
  1130 
       
  1131     my $status = $zip->writeToFileNamed( 'xx.zip' );
       
  1132     die "error somewhere" if $status != AZ_OK;
       
  1133 
       
  1134 =cut
       
  1135 
       
  1136 sub writeToFileNamed	# Archive::Zip::Archive
       
  1137 {
       
  1138 	my $self = shift;
       
  1139 	my $fileName = shift;
       
  1140 	foreach my $member ( $self->members() )
       
  1141 	{
       
  1142 		if ( $member->_usesFileNamed( $fileName ) )
       
  1143 		{
       
  1144 			return _error("$fileName is needed by member " 
       
  1145 					. $member->fileName() 
       
  1146 					. "; try renaming output file");
       
  1147 		}
       
  1148 	}
       
  1149 	my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
       
  1150 	return _ioError( "Can't open $fileName for write" ) if !$status;
       
  1151 	my $retval = $self->writeToFileHandle( $fh, 1 );
       
  1152 	$fh->close();
       
  1153 	return $retval;
       
  1154 }
       
  1155 
       
  1156 #--------------------------------
       
  1157 
       
  1158 =item writeToFileHandle( $fileHandle [, $seekable] )
       
  1159 
       
  1160 Write a zip archive to a file handle.
       
  1161 Return AZ_OK on success.
       
  1162 
       
  1163 The optional second arg tells whether or not to try to seek backwards
       
  1164 to re-write headers.
       
  1165 If not provided, it is set by testing seekability. This could fail
       
  1166 on some operating systems, though.
       
  1167 
       
  1168     my $fh = IO::File->new( 'someFile.zip', 'w' );
       
  1169     $zip->writeToFileHandle( $fh );
       
  1170 
       
  1171 If you pass a file handle that is not seekable (like if you're writing
       
  1172 to a pipe or a socket), pass a false as the second argument:
       
  1173 
       
  1174     my $fh = IO::File->new( '| cat > somefile.zip', 'w' );
       
  1175     $zip->writeToFileHandle( $fh, 0 );   # fh is not seekable
       
  1176 
       
  1177 =cut
       
  1178 
       
  1179 sub writeToFileHandle	# Archive::Zip::Archive
       
  1180 {
       
  1181 	my $self = shift;
       
  1182 	my $fh = shift;
       
  1183 	my $fhIsSeekable = @_ ? shift : _isSeekable( $fh );
       
  1184 	_binmode( $fh );
       
  1185 
       
  1186 	my $offset = 0;
       
  1187 	foreach my $member ( $self->members() )
       
  1188 	{
       
  1189 		$member->{'writeLocalHeaderRelativeOffset'} = $offset;
       
  1190 		my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable );
       
  1191 		$member->endRead();
       
  1192 		return $retval if $retval != AZ_OK;
       
  1193 		$offset += $member->_localHeaderSize() + $member->_writeOffset();
       
  1194 		$offset += $member->hasDataDescriptor() ? DATA_DESCRIPTOR_LENGTH : 0;
       
  1195 	}
       
  1196 	$self->{'writeCentralDirectoryOffset'} = $offset;
       
  1197 	return $self->_writeCentralDirectory( $fh );
       
  1198 }
       
  1199 
       
  1200 # Returns next signature from given file handle, leaves
       
  1201 # file handle positioned afterwards.
       
  1202 # In list context, returns ($status, $signature)
       
  1203 
       
  1204 sub _readSignature	# Archive::Zip::Archive
       
  1205 {
       
  1206 	my $self = shift;
       
  1207 	my $fh = shift;
       
  1208 	my $fileName = shift;
       
  1209 	my $signatureData;
       
  1210 	$fh->read( $signatureData, SIGNATURE_LENGTH )
       
  1211 		or return _ioError( "reading header signature" );
       
  1212 	my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
       
  1213 	my $status = AZ_OK;
       
  1214 	if ( $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
       
  1215 			and $signature != LOCAL_FILE_HEADER_SIGNATURE
       
  1216 			and $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE )
       
  1217 	{
       
  1218 		$status = _formatError(
       
  1219 			sprintf( "bad signature: 0x%08x at offset %d in file \"%s\"",
       
  1220 				$signature, $fh->tell() - SIGNATURE_LENGTH, $fileName ) );
       
  1221 	}
       
  1222 
       
  1223 	return ( $status, $signature );
       
  1224 }
       
  1225 
       
  1226 # Used only during writing
       
  1227 sub _writeCentralDirectoryOffset	# Archive::Zip::Archive
       
  1228 { shift->{'writeCentralDirectoryOffset'} }
       
  1229 
       
  1230 sub _writeEOCDOffset	# Archive::Zip::Archive
       
  1231 { shift->{'writeEOCDOffset'} }
       
  1232 
       
  1233 # Expects to have _writeEOCDOffset() set
       
  1234 sub _writeEndOfCentralDirectory	# Archive::Zip::Archive
       
  1235 {
       
  1236 	my ( $self, $fh ) = @_;
       
  1237 
       
  1238 	$fh->write( END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING, SIGNATURE_LENGTH )
       
  1239 		or return _ioError( 'writing EOCD Signature' );
       
  1240 
       
  1241 	my $header = pack( END_OF_CENTRAL_DIRECTORY_FORMAT,
       
  1242 		0,	# {'diskNumber'},
       
  1243 		0,	# {'diskNumberWithStartOfCentralDirectory'},
       
  1244 		$self->numberOfMembers(),	# {'numberOfCentralDirectoriesOnThisDisk'},
       
  1245 		$self->numberOfMembers(),	# {'numberOfCentralDirectories'},
       
  1246 		$self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
       
  1247 		$self->_writeCentralDirectoryOffset(),
       
  1248 		length( $self->zipfileComment() )
       
  1249 	 );
       
  1250 	$fh->write( $header, END_OF_CENTRAL_DIRECTORY_LENGTH )
       
  1251 		or return _ioError( 'writing EOCD header' );
       
  1252 	if ( length( $self->zipfileComment() ))
       
  1253 	{
       
  1254 		$fh->write( $self->zipfileComment(), length( $self->zipfileComment() ))
       
  1255 			or return _ioError( 'writing zipfile comment' );
       
  1256 	}
       
  1257 	return AZ_OK;
       
  1258 }
       
  1259 
       
  1260 sub _writeCentralDirectory	# Archive::Zip::Archive
       
  1261 {
       
  1262 	my ( $self, $fh ) = @_;
       
  1263 
       
  1264 	my $offset = $self->_writeCentralDirectoryOffset();
       
  1265 	foreach my $member ( $self->members() )
       
  1266 	{
       
  1267 		my $status = $member->_writeCentralDirectoryFileHeader( $fh );
       
  1268 		return $status if $status != AZ_OK;
       
  1269 		$offset += $member->_centralDirectoryHeaderSize();
       
  1270 	}
       
  1271 	$self->{'writeEOCDOffset'} = $offset;
       
  1272 	return $self->_writeEndOfCentralDirectory( $fh );
       
  1273 }
       
  1274 
       
  1275 #--------------------------------
       
  1276 
       
  1277 =item read( $fileName )
       
  1278 
       
  1279 Read zipfile headers from a zip file, appending new members.
       
  1280 Returns C<AZ_OK> or error code.
       
  1281 
       
  1282     my $zipFile = Archive::Zip->new();
       
  1283     my $status = $zipFile->read( '/some/FileName.zip' );
       
  1284 
       
  1285 =cut
       
  1286 
       
  1287 sub read	# Archive::Zip::Archive
       
  1288 {
       
  1289 	my $self = shift;
       
  1290 	my $fileName = shift;
       
  1291 	return _error( 'No filename given' ) if ! $fileName;
       
  1292 	my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
       
  1293 	return _ioError( "opening $fileName for read" ) if !$status;
       
  1294 	_binmode( $fh );
       
  1295 
       
  1296 	$status = $self->_findEndOfCentralDirectory( $fh );
       
  1297 	return $status if $status != AZ_OK;
       
  1298 
       
  1299 	my $eocdPosition = $fh->tell();
       
  1300 
       
  1301 	$status = $self->_readEndOfCentralDirectory( $fh );
       
  1302 	return $status if $status != AZ_OK;
       
  1303 
       
  1304 	$fh->seek( $eocdPosition - $self->centralDirectorySize(),
       
  1305 		IO::Seekable::SEEK_SET )
       
  1306 			or return _ioError( "Can't seek $fileName" );
       
  1307 
       
  1308 	for ( ;; )
       
  1309 	{
       
  1310 		my $newMember = 
       
  1311 			$self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName );
       
  1312 		my $signature;
       
  1313 		( $status, $signature ) = $self->_readSignature( $fh, $fileName );
       
  1314 		return $status if $status != AZ_OK;
       
  1315 		last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
       
  1316 		$status = $newMember->_readCentralDirectoryFileHeader();
       
  1317 		return $status if $status != AZ_OK;
       
  1318 		$status = $newMember->endRead();
       
  1319 		return $status if $status != AZ_OK;
       
  1320 		$newMember->_becomeDirectoryIfNecessary();
       
  1321 		push( @{ $self->{'members'} }, $newMember );
       
  1322 	}
       
  1323 
       
  1324 	$fh->close();
       
  1325 	return AZ_OK;
       
  1326 }
       
  1327 
       
  1328 # Read EOCD, starting from position before signature.
       
  1329 # Return AZ_OK on success.
       
  1330 sub _readEndOfCentralDirectory	# Archive::Zip::Archive
       
  1331 {
       
  1332 	my $self = shift;
       
  1333 	my $fh = shift;
       
  1334 
       
  1335 	# Skip past signature
       
  1336 	$fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
       
  1337 		or return _ioError( "Can't seek past EOCD signature" );
       
  1338 
       
  1339 	my $header = '';
       
  1340 	$fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH )
       
  1341 		or return _ioError( "reading end of central directory" );
       
  1342 
       
  1343 	my $zipfileCommentLength;
       
  1344 	(
       
  1345 		$self->{'diskNumber'},
       
  1346 		$self->{'diskNumberWithStartOfCentralDirectory'},
       
  1347 		$self->{'numberOfCentralDirectoriesOnThisDisk'},
       
  1348 		$self->{'numberOfCentralDirectories'},
       
  1349 		$self->{'centralDirectorySize'},
       
  1350 		$self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
       
  1351 		$zipfileCommentLength
       
  1352 	 ) = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
       
  1353 
       
  1354 	if ( $zipfileCommentLength )
       
  1355 	{
       
  1356 		my $zipfileComment = '';
       
  1357 		$fh->read( $zipfileComment, $zipfileCommentLength )
       
  1358 			or return _ioError( "reading zipfile comment" );
       
  1359 		$self->{'zipfileComment'} = $zipfileComment;
       
  1360 	}
       
  1361 
       
  1362 	return AZ_OK;
       
  1363 }
       
  1364 
       
  1365 # Seek in my file to the end, then read backwards until we find the
       
  1366 # signature of the central directory record. Leave the file positioned right
       
  1367 # before the signature. Returns AZ_OK if success.
       
  1368 sub _findEndOfCentralDirectory	# Archive::Zip::Archive
       
  1369 {
       
  1370 	my $self = shift;
       
  1371 	my $fh = shift;
       
  1372 	my $data = '';
       
  1373 	$fh->seek( 0, IO::Seekable::SEEK_END )
       
  1374 		or return _ioError( "seeking to end" );
       
  1375 
       
  1376 	my $fileLength = $fh->tell();
       
  1377 	if ( $fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4 )
       
  1378 	{
       
  1379 		return _formatError( "file is too short" )
       
  1380 	}
       
  1381 
       
  1382 	my $seekOffset = 0;
       
  1383 	my $pos = -1;
       
  1384 	for ( ;; )
       
  1385 	{
       
  1386 		$seekOffset += 512;
       
  1387 		$seekOffset = $fileLength if ( $seekOffset > $fileLength );
       
  1388 		$fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
       
  1389 			or return _ioError( "seek failed" );
       
  1390 		$fh->read( $data, $seekOffset )
       
  1391 			or return _ioError( "read failed" );
       
  1392 		$pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
       
  1393 		last if ( $pos > 0
       
  1394 			or $seekOffset == $fileLength
       
  1395 			or $seekOffset >= $Archive::Zip::ChunkSize );
       
  1396 	}
       
  1397 
       
  1398 	if ( $pos >= 0 )
       
  1399 	{
       
  1400 		$fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
       
  1401 			or return _ioError( "seeking to EOCD" );
       
  1402 		return AZ_OK;
       
  1403 	}
       
  1404 	else
       
  1405 	{
       
  1406 		return _formatError( "can't find EOCD signature" );
       
  1407 	}
       
  1408 }
       
  1409 
       
  1410 =back
       
  1411 
       
  1412 =head1 MEMBER OPERATIONS
       
  1413 
       
  1414 =head2 Class Methods
       
  1415 
       
  1416 Several constructors allow you to construct members without adding
       
  1417 them to a zip archive.
       
  1418 
       
  1419 These work the same as the addFile(), addDirectory(), and addString()
       
  1420 zip instance methods described above, but they don't add the new members
       
  1421 to a zip.
       
  1422 
       
  1423 =over 4
       
  1424 
       
  1425 =cut
       
  1426 
       
  1427 # ----------------------------------------------------------------------
       
  1428 # class Archive::Zip::Member
       
  1429 # A generic member of an archive ( abstract )
       
  1430 # ----------------------------------------------------------------------
       
  1431 package Archive::Zip::Member;
       
  1432 use vars qw( @ISA );
       
  1433 @ISA = qw ( Archive::Zip );
       
  1434 
       
  1435 BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
       
  1436 	:UTILITY_METHODS ) }
       
  1437 
       
  1438 use Time::Local ();
       
  1439 use Compress::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
       
  1440 use File::Path;
       
  1441 use File::Basename;
       
  1442 
       
  1443 use constant ZIPFILEMEMBERCLASS	=> 'Archive::Zip::ZipFileMember';
       
  1444 use constant NEWFILEMEMBERCLASS	=> 'Archive::Zip::NewFileMember';
       
  1445 use constant STRINGMEMBERCLASS	=> 'Archive::Zip::StringMember';
       
  1446 use constant DIRECTORYMEMBERCLASS	=> 'Archive::Zip::DirectoryMember';
       
  1447 
       
  1448 # Unix perms for default creation of files/dirs.
       
  1449 use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
       
  1450 use constant DEFAULT_FILE_PERMISSIONS => 0100666;
       
  1451 use constant DIRECTORY_ATTRIB => 040000;
       
  1452 use constant FILE_ATTRIB => 0100000;
       
  1453 
       
  1454 # Returns self if successful, else undef
       
  1455 # Assumes that fh is positioned at beginning of central directory file header.
       
  1456 # Leaves fh positioned immediately after file header or EOCD signature.
       
  1457 sub _newFromZipFile # Archive::Zip::Member
       
  1458 {
       
  1459 	my $class = shift;
       
  1460 	my $self = $class->ZIPFILEMEMBERCLASS->_newFromZipFile( @_ );
       
  1461 	return $self;
       
  1462 }
       
  1463 
       
  1464 #--------------------------------
       
  1465 
       
  1466 =item Archive::Zip::Member->newFromString( $stringOrStringRef [, $fileName] )
       
  1467 
       
  1468 Construct a new member from the given string. Returns undef on error.
       
  1469 
       
  1470     my $member = Archive::Zip::Member->newFromString( 'This is a test',
       
  1471                                                      'xyz.txt' );
       
  1472 
       
  1473 =cut
       
  1474 
       
  1475 sub newFromString	# Archive::Zip::Member
       
  1476 {
       
  1477 	my $class = shift;
       
  1478 	my $self = $class->STRINGMEMBERCLASS->_newFromString( @_ );
       
  1479 	return $self;
       
  1480 }
       
  1481 
       
  1482 #--------------------------------
       
  1483 
       
  1484 =item newFromFile( $fileName )
       
  1485 
       
  1486 Construct a new member from the given file. Returns undef on error.
       
  1487 
       
  1488     my $member = Archive::Zip::Member->newFromFile( 'xyz.txt' );
       
  1489 
       
  1490 =cut
       
  1491 
       
  1492 sub newFromFile	# Archive::Zip::Member
       
  1493 {
       
  1494 	my $class = shift;
       
  1495 	my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed( @_ );
       
  1496 	return $self;
       
  1497 }
       
  1498 
       
  1499 #--------------------------------
       
  1500 
       
  1501 =item newDirectoryNamed( $directoryName )
       
  1502 
       
  1503 Construct a new member from the given directory.
       
  1504 Returns undef on error.
       
  1505 
       
  1506     my $member = Archive::Zip::Member->newDirectoryNamed( 'CVS/' );
       
  1507 
       
  1508 =cut
       
  1509 
       
  1510 sub newDirectoryNamed # Archive::Zip::Member
       
  1511 {
       
  1512 	my $class = shift;
       
  1513 	my $self = $class->DIRECTORYMEMBERCLASS->_newNamed( @_ );
       
  1514 	return $self;
       
  1515 }
       
  1516 
       
  1517 sub new	# Archive::Zip::Member
       
  1518 {
       
  1519 	my $class = shift;
       
  1520 	my $self = {
       
  1521 		'lastModFileDateTime' => 0,
       
  1522 		'fileAttributeFormat' => FA_UNIX,
       
  1523 		'versionMadeBy' => 20,
       
  1524 		'versionNeededToExtract' => 20,
       
  1525 		'bitFlag' => 0,
       
  1526 		'compressionMethod' => COMPRESSION_STORED,
       
  1527 		'desiredCompressionMethod' => COMPRESSION_STORED,
       
  1528 		'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE,
       
  1529 		'internalFileAttributes' => 0,
       
  1530 		'externalFileAttributes' => 0,	# set later
       
  1531 		'fileName' => '',
       
  1532 		'cdExtraField' => '',
       
  1533 		'localExtraField' => '',
       
  1534 		'fileComment' => '',
       
  1535 		'crc32' => 0,
       
  1536 		'compressedSize' => 0,
       
  1537 		'uncompressedSize' => 0,
       
  1538 		@_
       
  1539 	};
       
  1540 	bless( $self, $class );
       
  1541 	$self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
       
  1542 	return $self;
       
  1543 }
       
  1544 
       
  1545 sub _becomeDirectoryIfNecessary	# Archive::Zip::Member
       
  1546 {
       
  1547 	my $self = shift;
       
  1548 	$self->_become( DIRECTORYMEMBERCLASS )
       
  1549 		if $self->isDirectory();
       
  1550 	return $self;
       
  1551 }
       
  1552 
       
  1553 # Morph into given class (do whatever cleanup I need to do)
       
  1554 sub _become	# Archive::Zip::Member
       
  1555 {
       
  1556 	return bless( $_[0], $_[1] );
       
  1557 }
       
  1558 
       
  1559 =back
       
  1560 
       
  1561 =head2 Simple accessors
       
  1562 
       
  1563 These methods get (and/or set) member attribute values.
       
  1564 
       
  1565 =over 4
       
  1566 
       
  1567 =cut
       
  1568 
       
  1569 #--------------------------------
       
  1570 
       
  1571 =item versionMadeBy()
       
  1572 
       
  1573 Gets the field from my member header.
       
  1574 
       
  1575 =cut
       
  1576 
       
  1577 sub versionMadeBy	# Archive::Zip::Member
       
  1578 { shift->{'versionMadeBy'} }
       
  1579 
       
  1580 #--------------------------------
       
  1581 
       
  1582 =item fileAttributeFormat( [$format] )
       
  1583 
       
  1584 Gets or sets the field from the member header.
       
  1585 These are C<FA_*> values.
       
  1586 
       
  1587 =cut
       
  1588 
       
  1589 sub fileAttributeFormat	# Archive::Zip::Member
       
  1590 {
       
  1591 	( $#_ > 0 ) ? ( $_[0]->{'fileAttributeFormat'} = $_[1] )
       
  1592 		: $_[0]->{'fileAttributeFormat'}
       
  1593 }
       
  1594 
       
  1595 #--------------------------------
       
  1596 
       
  1597 =item versionNeededToExtract()
       
  1598 
       
  1599 Gets the field from my member header.
       
  1600 
       
  1601 =cut
       
  1602 
       
  1603 sub versionNeededToExtract	# Archive::Zip::Member
       
  1604 { shift->{'versionNeededToExtract'} }
       
  1605 
       
  1606 #--------------------------------
       
  1607 
       
  1608 =item bitFlag()
       
  1609 
       
  1610 Gets the general purpose bit field from my member header.
       
  1611 This is where the C<GPBF_*> bits live.
       
  1612 
       
  1613 =cut
       
  1614 
       
  1615 sub bitFlag	# Archive::Zip::Member
       
  1616 { shift->{'bitFlag'} }
       
  1617 
       
  1618 #--------------------------------
       
  1619 
       
  1620 =item compressionMethod()
       
  1621 
       
  1622 Returns my compression method. This is the method that is
       
  1623 currently being used to compress my data.
       
  1624 
       
  1625 This will be COMPRESSION_STORED for added string or file members,
       
  1626 or any of the C<COMPRESSION_*> values for members from a zip file.
       
  1627 However, this module can only handle members whose data is in
       
  1628 COMPRESSION_STORED or COMPRESSION_DEFLATED format.
       
  1629 
       
  1630 =cut
       
  1631 
       
  1632 sub compressionMethod	# Archive::Zip::Member
       
  1633 { shift->{'compressionMethod'} }
       
  1634 
       
  1635 #--------------------------------
       
  1636 
       
  1637 =item desiredCompressionMethod( [$method] )
       
  1638 
       
  1639 Get or set my desiredCompressionMethod
       
  1640 This is the method that will be used to write.
       
  1641 Returns prior desiredCompressionMethod.
       
  1642 
       
  1643 Only COMPRESSION_DEFLATED or COMPRESSION_STORED are valid arguments.
       
  1644 
       
  1645 Changing to COMPRESSION_STORED will change my desiredCompressionLevel
       
  1646 to 0; changing to COMPRESSION_DEFLATED will change my
       
  1647 desiredCompressionLevel to COMPRESSION_LEVEL_DEFAULT.
       
  1648 
       
  1649 =cut
       
  1650 
       
  1651 sub desiredCompressionMethod	# Archive::Zip::Member
       
  1652 {
       
  1653 	my $self = shift;
       
  1654 	my $newDesiredCompressionMethod = shift;
       
  1655 	my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
       
  1656 	if ( defined( $newDesiredCompressionMethod ))
       
  1657 	{
       
  1658 		$self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
       
  1659 		if ( $newDesiredCompressionMethod == COMPRESSION_STORED )
       
  1660 		{
       
  1661 			$self->{'desiredCompressionLevel'} = 0;
       
  1662 		}
       
  1663 		elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED )
       
  1664 		{
       
  1665 			$self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
       
  1666 		}
       
  1667 	}
       
  1668 	return $oldDesiredCompressionMethod;
       
  1669 }
       
  1670 
       
  1671 #--------------------------------
       
  1672 
       
  1673 =item desiredCompressionLevel( [$method] )
       
  1674 
       
  1675 Get or set my desiredCompressionLevel
       
  1676 This is the method that will be used to write.
       
  1677 Returns prior desiredCompressionLevel.
       
  1678 
       
  1679 Valid arguments are 0 through 9, COMPRESSION_LEVEL_NONE,
       
  1680 COMPRESSION_LEVEL_DEFAULT, COMPRESSION_LEVEL_BEST_COMPRESSION, and
       
  1681 COMPRESSION_LEVEL_FASTEST.
       
  1682 
       
  1683 0 or COMPRESSION_LEVEL_NONE will change the desiredCompressionMethod
       
  1684 to COMPRESSION_STORED. All other arguments will change the
       
  1685 desiredCompressionMethod to COMPRESSION_DEFLATED.
       
  1686 
       
  1687 =cut
       
  1688 
       
  1689 sub desiredCompressionLevel	# Archive::Zip::Member
       
  1690 {
       
  1691 	my $self = shift;
       
  1692 	my $newDesiredCompressionLevel = shift;
       
  1693 	my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
       
  1694 	if ( defined( $newDesiredCompressionLevel ))
       
  1695 	{
       
  1696 		$self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
       
  1697 		$self->{'desiredCompressionMethod'} = ( $newDesiredCompressionLevel
       
  1698 			? COMPRESSION_DEFLATED
       
  1699 			: COMPRESSION_STORED );
       
  1700 	}
       
  1701 	return $oldDesiredCompressionLevel;
       
  1702 }
       
  1703 
       
  1704 #--------------------------------
       
  1705 
       
  1706 =item fileName()
       
  1707 
       
  1708 Get or set my internal filename.
       
  1709 Returns the (possibly new) filename.
       
  1710 
       
  1711 Names will have backslashes converted to forward slashes,
       
  1712 and will have multiple consecutive slashes converted to single ones.
       
  1713 
       
  1714 =cut
       
  1715 
       
  1716 sub fileName	# Archive::Zip::Member
       
  1717 {
       
  1718 	my $self = shift;
       
  1719 	my $newName = shift;
       
  1720 	if ( $newName )
       
  1721 	{
       
  1722 		$newName =~ s{[\\/]+}{/}g;	# deal with dos/windoze problems
       
  1723 		$self->{'fileName'} = $newName;
       
  1724 	}
       
  1725 	return $self->{'fileName'}
       
  1726 }
       
  1727 
       
  1728 #--------------------------------
       
  1729 
       
  1730 =item lastModFileDateTime()
       
  1731 
       
  1732 Return my last modification date/time stamp in MS-DOS format.
       
  1733 
       
  1734 =cut
       
  1735 
       
  1736 sub lastModFileDateTime	# Archive::Zip::Member
       
  1737 { shift->{'lastModFileDateTime'} }
       
  1738 
       
  1739 #--------------------------------
       
  1740 
       
  1741 =item lastModTime()
       
  1742 
       
  1743 Return my last modification date/time stamp,
       
  1744 converted to unix localtime format.
       
  1745 
       
  1746     print "Mod Time: " . scalar( localtime( $member->lastModTime() ) );
       
  1747 
       
  1748 =cut
       
  1749 
       
  1750 sub lastModTime	# Archive::Zip::Member
       
  1751 {
       
  1752 	my $self = shift;
       
  1753 	return _dosToUnixTime( $self->lastModFileDateTime() );
       
  1754 }
       
  1755 
       
  1756 #--------------------------------
       
  1757 
       
  1758 =item setLastModFileDateTimeFromUnix()
       
  1759 
       
  1760 Set my lastModFileDateTime from the given unix time.
       
  1761 
       
  1762     $member->setLastModFileDateTimeFromUnix( time() );
       
  1763 
       
  1764 =cut
       
  1765 
       
  1766 sub setLastModFileDateTimeFromUnix	# Archive::Zip::Member
       
  1767 {
       
  1768 	my $self = shift;
       
  1769 	my $time_t = shift;
       
  1770 	$self->{'lastModFileDateTime'} = _unixToDosTime( $time_t );
       
  1771 }
       
  1772 
       
  1773 # Convert DOS date/time format to unix time_t format
       
  1774 # NOT AN OBJECT METHOD!
       
  1775 sub _dosToUnixTime	# Archive::Zip::Member
       
  1776 {
       
  1777 	my $dt = shift;
       
  1778 
       
  1779 	my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
       
  1780 	my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
       
  1781 	my $mday = ( ( $dt >> 16 ) & 0x1f );
       
  1782 
       
  1783 	my $hour = ( ( $dt >> 11 ) & 0x1f );
       
  1784 	my $min  = ( ( $dt >> 5 ) & 0x3f );
       
  1785 	my $sec  = ( ( $dt << 1 ) & 0x3e );
       
  1786 
       
  1787 	my $time_t = Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year );
       
  1788 	return $time_t;
       
  1789 }
       
  1790 
       
  1791 #--------------------------------
       
  1792 
       
  1793 =item internalFileAttributes()
       
  1794 
       
  1795 Return the internal file attributes field from the zip header.
       
  1796 This is only set for members read from a zip file.
       
  1797 
       
  1798 =cut
       
  1799 
       
  1800 sub internalFileAttributes	# Archive::Zip::Member
       
  1801 { shift->{'internalFileAttributes'} }
       
  1802 
       
  1803 #--------------------------------
       
  1804 
       
  1805 =item externalFileAttributes()
       
  1806 
       
  1807 Return member attributes as read from the ZIP file.
       
  1808 Note that these are NOT UNIX!
       
  1809 
       
  1810 =cut
       
  1811 
       
  1812 sub externalFileAttributes	# Archive::Zip::Member
       
  1813 { shift->{'externalFileAttributes'} }
       
  1814 
       
  1815 # Convert UNIX permissions into proper value for zip file
       
  1816 # NOT A METHOD!
       
  1817 sub _mapPermissionsFromUnix	# Archive::Zip::Member
       
  1818 {
       
  1819 	my $perms = shift;
       
  1820 	return $perms << 16;
       
  1821 }
       
  1822 
       
  1823 # Convert ZIP permissions into Unix ones
       
  1824 # NOT A METHOD!
       
  1825 sub _mapPermissionsToUnix	# Archive::Zip::Member
       
  1826 {
       
  1827 	my $perms = shift;
       
  1828 	return $perms >> 16;
       
  1829 }
       
  1830 
       
  1831 #--------------------------------
       
  1832 
       
  1833 =item unixFileAttributes( [$newAttributes] )
       
  1834 
       
  1835 Get or set the member's file attributes using UNIX file attributes.
       
  1836 Returns old attributes.
       
  1837 
       
  1838     my $oldAttribs = $member->unixFileAttributes( 0666 );
       
  1839 
       
  1840 Note that the return value has more than just the file permissions,
       
  1841 so you will have to mask off the lowest bits for comparisions.
       
  1842 
       
  1843 =cut
       
  1844 
       
  1845 sub unixFileAttributes	# Archive::Zip::Member
       
  1846 {
       
  1847 	my $self = shift;
       
  1848 	my $oldPerms = _mapPermissionsToUnix( $self->{'externalFileAttributes'} );
       
  1849 	if ( @_ )
       
  1850 	{
       
  1851 		my $perms = shift;
       
  1852 		if ( $self->isDirectory() )
       
  1853 		{
       
  1854 			$perms &= ~FILE_ATTRIB;
       
  1855 			$perms |= DIRECTORY_ATTRIB;
       
  1856 		}
       
  1857 		else
       
  1858 		{
       
  1859 			$perms &= ~DIRECTORY_ATTRIB;
       
  1860 			$perms |= FILE_ATTRIB;
       
  1861 		}
       
  1862 		$self->{'externalFileAttributes'} = _mapPermissionsFromUnix( $perms);
       
  1863 	}
       
  1864 	return $oldPerms;
       
  1865 }
       
  1866 
       
  1867 #--------------------------------
       
  1868 
       
  1869 =item localExtraField( [$newField] )
       
  1870 
       
  1871 Gets or sets the extra field that was read from the local header.
       
  1872 This is not set for a member from a zip file until after the
       
  1873 member has been written out.
       
  1874 
       
  1875 The extra field must be in the proper format.
       
  1876 
       
  1877 =cut
       
  1878 
       
  1879 sub localExtraField	# Archive::Zip::Member
       
  1880 {
       
  1881 	( $#_ > 0 ) ? ( $_[0]->{'localExtraField'} = $_[1] )
       
  1882 		: $_[0]->{'localExtraField'}
       
  1883 }
       
  1884 
       
  1885 #--------------------------------
       
  1886 
       
  1887 =item cdExtraField( [$newField] )
       
  1888 
       
  1889 Gets or sets the extra field that was read from the central directory header.
       
  1890 
       
  1891 The extra field must be in the proper format.
       
  1892 
       
  1893 =cut
       
  1894 
       
  1895 sub cdExtraField	# Archive::Zip::Member
       
  1896 {
       
  1897 	( $#_ > 0 ) ? ( $_[0]->{'cdExtraField'} = $_[1] )
       
  1898 		: $_[0]->{'cdExtraField'}
       
  1899 }
       
  1900 
       
  1901 #--------------------------------
       
  1902 
       
  1903 =item extraFields()
       
  1904 
       
  1905 Return both local and CD extra fields, concatenated.
       
  1906 
       
  1907 =cut
       
  1908 
       
  1909 sub extraFields	# Archive::Zip::Member
       
  1910 {
       
  1911 	my $self = shift;
       
  1912 	return $self->localExtraField() . $self->cdExtraField();
       
  1913 }
       
  1914 
       
  1915 #--------------------------------
       
  1916 
       
  1917 =item fileComment( [$newComment] )
       
  1918 
       
  1919 Get or set the member's file comment.
       
  1920 
       
  1921 =cut
       
  1922 
       
  1923 sub fileComment	# Archive::Zip::Member
       
  1924 {
       
  1925 	( $#_ > 0 ) ? ( $_[0]->{'fileComment'} = $_[1] )
       
  1926 		: $_[0]->{'fileComment'}
       
  1927 }
       
  1928 
       
  1929 #--------------------------------
       
  1930 
       
  1931 =item hasDataDescriptor()
       
  1932 
       
  1933 Get or set the data descriptor flag.
       
  1934 If this is set, the local header will not necessarily
       
  1935 have the correct data sizes. Instead, a small structure
       
  1936 will be stored at the end of the member data with these
       
  1937 values.
       
  1938 
       
  1939 This should be transparent in normal operation.
       
  1940 
       
  1941 =cut
       
  1942 
       
  1943 sub hasDataDescriptor	# Archive::Zip::Member
       
  1944 {
       
  1945 	my $self = shift;
       
  1946 	if ( @_ )
       
  1947 	{
       
  1948 		my $shouldHave = shift;
       
  1949 		if ( $shouldHave )
       
  1950 		{
       
  1951 			$self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK
       
  1952 		}
       
  1953 		else
       
  1954 		{
       
  1955 			$self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
       
  1956 		}
       
  1957 	}
       
  1958 	return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK;
       
  1959 }
       
  1960 
       
  1961 #--------------------------------
       
  1962 
       
  1963 =item crc32()
       
  1964 
       
  1965 Return the CRC-32 value for this member.
       
  1966 This will not be set for members that were constructed from strings
       
  1967 or external files until after the member has been written.
       
  1968 
       
  1969 =cut
       
  1970 
       
  1971 sub crc32	# Archive::Zip::Member
       
  1972 { shift->{'crc32'} }
       
  1973 
       
  1974 #--------------------------------
       
  1975 
       
  1976 =item crc32String()
       
  1977 
       
  1978 Return the CRC-32 value for this member as an 8 character printable
       
  1979 hex string.  This will not be set for members that were constructed
       
  1980 from strings or external files until after the member has been written.
       
  1981 
       
  1982 =cut
       
  1983 
       
  1984 sub crc32String	# Archive::Zip::Member
       
  1985 { sprintf( "%08x", shift->{'crc32'} ); }
       
  1986 
       
  1987 #--------------------------------
       
  1988 
       
  1989 =item compressedSize()
       
  1990 
       
  1991 Return the compressed size for this member.
       
  1992 This will not be set for members that were constructed from strings
       
  1993 or external files until after the member has been written.
       
  1994 
       
  1995 =cut
       
  1996 
       
  1997 sub compressedSize	# Archive::Zip::Member
       
  1998 { shift->{'compressedSize'} }
       
  1999 
       
  2000 #--------------------------------
       
  2001 
       
  2002 =item uncompressedSize()
       
  2003 
       
  2004 Return the uncompressed size for this member.
       
  2005 
       
  2006 =cut
       
  2007 
       
  2008 sub uncompressedSize	# Archive::Zip::Member
       
  2009 { shift->{'uncompressedSize'} }
       
  2010 
       
  2011 #--------------------------------
       
  2012 
       
  2013 =item isEncrypted()
       
  2014 
       
  2015 Return true if this member is encrypted.
       
  2016 The Archive::Zip module does not currently create or extract
       
  2017 encrypted members.
       
  2018 
       
  2019 =cut
       
  2020 
       
  2021 sub isEncrypted	# Archive::Zip::Member
       
  2022 { shift->bitFlag() & GPBF_ENCRYPTED_MASK }
       
  2023 
       
  2024 
       
  2025 #--------------------------------
       
  2026 
       
  2027 =item isTextFile( [$flag] )
       
  2028 
       
  2029 Returns true if I am a text file.
       
  2030 Also can set the status if given an argument (then returns old state).
       
  2031 Note that this module does not currently do anything with this flag
       
  2032 upon extraction or storage.
       
  2033 That is, bytes are stored in native format whether or not they came
       
  2034 from a text file.
       
  2035 
       
  2036 =cut
       
  2037 
       
  2038 sub isTextFile	# Archive::Zip::Member
       
  2039 {
       
  2040 	my $self = shift;
       
  2041 	my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
       
  2042 	if ( @_ )
       
  2043 	{
       
  2044 		my $flag = shift;
       
  2045 		$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
       
  2046 		$self->{'internalFileAttributes'} |=
       
  2047 			( $flag ? IFA_TEXT_FILE : IFA_BINARY_FILE );
       
  2048 	}
       
  2049 	return $bit == IFA_TEXT_FILE;
       
  2050 }
       
  2051 
       
  2052 #--------------------------------
       
  2053 
       
  2054 =item isBinaryFile()
       
  2055 
       
  2056 Returns true if I am a binary file.
       
  2057 Also can set the status if given an argument (then returns old state).
       
  2058 Note that this module does not currently do anything with this flag
       
  2059 upon extraction or storage.
       
  2060 That is, bytes are stored in native format whether or not they came
       
  2061 from a text file.
       
  2062 
       
  2063 =cut
       
  2064 
       
  2065 sub isBinaryFile	# Archive::Zip::Member
       
  2066 {
       
  2067 	my $self = shift;
       
  2068 	my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
       
  2069 	if ( @_ )
       
  2070 	{
       
  2071 		my $flag = shift;
       
  2072 		$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
       
  2073 		$self->{'internalFileAttributes'} |=
       
  2074 			( $flag ? IFA_BINARY_FILE : IFA_TEXT_FILE );
       
  2075 	}
       
  2076 	return $bit == IFA_BINARY_FILE;
       
  2077 }
       
  2078 
       
  2079 #--------------------------------
       
  2080 
       
  2081 =item extractToFileNamed( $fileName )
       
  2082 
       
  2083 Extract me to a file with the given name.
       
  2084 The file will be created with default modes.
       
  2085 Directories will be created as needed.
       
  2086 
       
  2087 Returns AZ_OK on success.
       
  2088 
       
  2089 =cut
       
  2090 
       
  2091 sub extractToFileNamed	# Archive::Zip::Member
       
  2092 {
       
  2093 	my $self = shift;
       
  2094 	my $name = shift;
       
  2095 	return _error( "encryption unsupported" ) if $self->isEncrypted();
       
  2096 	mkpath( dirname( $name ) );	# croaks on error
       
  2097 	my ( $status, $fh ) = _newFileHandle( $name, 'w' );
       
  2098 	return _ioError( "Can't open file $name for write" ) if !$status;
       
  2099 	my $retval = $self->extractToFileHandle( $fh );
       
  2100 	$fh->close();
       
  2101 	return $retval;
       
  2102 }
       
  2103 
       
  2104 #--------------------------------
       
  2105 
       
  2106 =item isDirectory()
       
  2107 
       
  2108 Returns true if I am a directory.
       
  2109 
       
  2110 =cut
       
  2111 
       
  2112 sub isDirectory	# Archive::Zip::Member
       
  2113 { return 0 }
       
  2114 
       
  2115 # The following are used when copying data
       
  2116 sub _writeOffset	# Archive::Zip::Member
       
  2117 { shift->{'writeOffset'} }
       
  2118 
       
  2119 sub _readOffset	# Archive::Zip::Member
       
  2120 { shift->{'readOffset'} }
       
  2121 
       
  2122 sub _writeLocalHeaderRelativeOffset	# Archive::Zip::Member
       
  2123 { shift->{'writeLocalHeaderRelativeOffset'} }
       
  2124 
       
  2125 sub _dataEnded	# Archive::Zip::Member
       
  2126 { shift->{'dataEnded'} }
       
  2127 
       
  2128 sub _readDataRemaining	# Archive::Zip::Member
       
  2129 { shift->{'readDataRemaining'} }
       
  2130 
       
  2131 sub _inflater	# Archive::Zip::Member
       
  2132 { shift->{'inflater'} }
       
  2133 
       
  2134 sub _deflater	# Archive::Zip::Member
       
  2135 { shift->{'deflater'} }
       
  2136 
       
  2137 # Return the total size of my local header
       
  2138 sub _localHeaderSize	# Archive::Zip::Member
       
  2139 {
       
  2140 	my $self = shift;
       
  2141 	return SIGNATURE_LENGTH
       
  2142 		+ LOCAL_FILE_HEADER_LENGTH
       
  2143 		+ length( $self->fileName() )
       
  2144 		+ length( $self->localExtraField() )
       
  2145 }
       
  2146 
       
  2147 # Return the total size of my CD header
       
  2148 sub _centralDirectoryHeaderSize	# Archive::Zip::Member
       
  2149 {
       
  2150 	my $self = shift;
       
  2151 	return SIGNATURE_LENGTH
       
  2152 		+ CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
       
  2153 		+ length( $self->fileName() )
       
  2154 		+ length( $self->cdExtraField() )
       
  2155 		+ length( $self->fileComment() )
       
  2156 }
       
  2157 
       
  2158 # convert a unix time to DOS date/time
       
  2159 # NOT AN OBJECT METHOD!
       
  2160 sub _unixToDosTime	# Archive::Zip::Member
       
  2161 {
       
  2162 	my $time_t = shift;
       
  2163 	my ( $sec,$min,$hour,$mday,$mon,$year ) = localtime( $time_t );
       
  2164 	my $dt = 0;
       
  2165 	$dt += ( $sec >> 1 );
       
  2166 	$dt += ( $min << 5 );
       
  2167 	$dt += ( $hour << 11 );
       
  2168 	$dt += ( $mday << 16 );
       
  2169 	$dt += ( ( $mon + 1 ) << 21 );
       
  2170 	$dt += ( ( $year - 80 ) << 25 );
       
  2171 	return $dt;
       
  2172 }
       
  2173 
       
  2174 # Write my local header to a file handle.
       
  2175 # Stores the offset to the start of the header in my
       
  2176 # writeLocalHeaderRelativeOffset member.
       
  2177 # Returns AZ_OK on success.
       
  2178 sub _writeLocalFileHeader	# Archive::Zip::Member
       
  2179 {
       
  2180 	my $self = shift;
       
  2181 	my $fh = shift;
       
  2182 
       
  2183 	my $signatureData = pack( SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE );
       
  2184 	$fh->write( $signatureData, SIGNATURE_LENGTH )
       
  2185 		or return _ioError( "writing local header signature" );
       
  2186 
       
  2187 	my $header = pack( LOCAL_FILE_HEADER_FORMAT,
       
  2188 		$self->versionNeededToExtract(),
       
  2189 		$self->bitFlag(),
       
  2190 		$self->desiredCompressionMethod(),
       
  2191 		$self->lastModFileDateTime(),
       
  2192 		$self->crc32(),
       
  2193 		$self->compressedSize(),		# may need to be re-written later
       
  2194 		$self->uncompressedSize(),
       
  2195 		length( $self->fileName() ),
       
  2196 		length( $self->localExtraField() )
       
  2197 		 );
       
  2198 
       
  2199 	$fh->write( $header, LOCAL_FILE_HEADER_LENGTH )
       
  2200 		or return _ioError( "writing local header" );
       
  2201 	if ( length( $self->fileName() ))
       
  2202 	{
       
  2203 		$fh->write( $self->fileName(), length( $self->fileName() ))
       
  2204 			or return _ioError( "writing local header filename" );
       
  2205 	}
       
  2206 	if ( length( $self->localExtraField() ))
       
  2207 	{
       
  2208 		$fh->write( $self->localExtraField(), length( $self->localExtraField() ))
       
  2209 			or return _ioError( "writing local header signature" );
       
  2210 	}
       
  2211 
       
  2212 	return AZ_OK;
       
  2213 }
       
  2214 
       
  2215 sub _writeCentralDirectoryFileHeader	# Archive::Zip::Member
       
  2216 {
       
  2217 	my $self = shift;
       
  2218 	my $fh = shift;
       
  2219 
       
  2220 	my $sigData = pack( SIGNATURE_FORMAT,
       
  2221 		CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE );
       
  2222 	$fh->write( $sigData, SIGNATURE_LENGTH )
       
  2223 		or return _ioError( "writing central directory header signature" );
       
  2224 
       
  2225 	my $fileNameLength = length( $self->fileName() );
       
  2226 	my $extraFieldLength = length( $self->cdExtraField() );
       
  2227 	my $fileCommentLength = length( $self->fileComment() );
       
  2228 
       
  2229 	my $header = pack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
       
  2230 		$self->versionMadeBy(),
       
  2231 		$self->fileAttributeFormat(),
       
  2232 		$self->versionNeededToExtract(),
       
  2233 		$self->bitFlag(),
       
  2234 		$self->desiredCompressionMethod(),
       
  2235 		$self->lastModFileDateTime(),
       
  2236 		$self->crc32(),			# these three fields should have been updated
       
  2237 		$self->_writeOffset(),	# by writing the data stream out
       
  2238 		$self->uncompressedSize(),	#
       
  2239 		$fileNameLength,
       
  2240 		$extraFieldLength,
       
  2241 		$fileCommentLength,
       
  2242 		0,						# {'diskNumberStart'},
       
  2243 		$self->internalFileAttributes(),
       
  2244 		$self->externalFileAttributes(),
       
  2245 		$self->_writeLocalHeaderRelativeOffset()
       
  2246 	 );
       
  2247 
       
  2248 	$fh->write( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
       
  2249 		or return _ioError( "writing central directory header" );
       
  2250 	if ( $fileNameLength )
       
  2251 	{
       
  2252 		$fh->write( $self->fileName(), $fileNameLength )
       
  2253 			or return _ioError( "writing central directory header signature" );
       
  2254 	}
       
  2255 	if ( $extraFieldLength )
       
  2256 	{
       
  2257 		$fh->write( $self->cdExtraField(), $extraFieldLength )
       
  2258 			or return _ioError( "writing central directory extra field" );
       
  2259 	}
       
  2260 	if ( $fileCommentLength )
       
  2261 	{
       
  2262 		$fh->write( $self->fileComment(), $fileCommentLength )
       
  2263 			or return _ioError( "writing central directory file comment" );
       
  2264 	}
       
  2265 
       
  2266 	return AZ_OK;
       
  2267 }
       
  2268 
       
  2269 # This writes a data descriptor to the given file handle.
       
  2270 # Assumes that crc32, writeOffset, and uncompressedSize are
       
  2271 # set correctly (they should be after a write).
       
  2272 # Further, the local file header should have the
       
  2273 # GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
       
  2274 sub _writeDataDescriptor	# Archive::Zip::Member
       
  2275 {
       
  2276 	my $self = shift;
       
  2277 	my $fh = shift;
       
  2278 	my $header = pack( DATA_DESCRIPTOR_FORMAT,
       
  2279 		$self->crc32(),
       
  2280 		$self->_writeOffset(),
       
  2281 		$self->uncompressedSize()
       
  2282 	 );
       
  2283 
       
  2284 	$fh->write( $header, DATA_DESCRIPTOR_LENGTH )
       
  2285 		or return _ioError( "writing data descriptor" );
       
  2286 	return AZ_OK;
       
  2287 }
       
  2288 
       
  2289 # Re-writes the local file header with new crc32 and compressedSize fields.
       
  2290 # To be called after writing the data stream.
       
  2291 # Assumes that filename and extraField sizes didn't change since last written.
       
  2292 sub _refreshLocalFileHeader	# Archive::Zip::Member
       
  2293 {
       
  2294 	my $self = shift;
       
  2295 	my $fh = shift;
       
  2296 
       
  2297 	my $here = $fh->tell();
       
  2298 	$fh->seek( $self->_writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH,
       
  2299 		IO::Seekable::SEEK_SET )
       
  2300 			or return _ioError( "seeking to rewrite local header" );
       
  2301 
       
  2302 	my $header = pack( LOCAL_FILE_HEADER_FORMAT,
       
  2303 		$self->versionNeededToExtract(),
       
  2304 		$self->bitFlag(),
       
  2305 		$self->desiredCompressionMethod(),
       
  2306 		$self->lastModFileDateTime(),
       
  2307 		$self->crc32(),
       
  2308 		$self->_writeOffset(),
       
  2309 		$self->uncompressedSize(),
       
  2310 		length( $self->fileName() ),
       
  2311 		length( $self->localExtraField() )
       
  2312 		 );
       
  2313 
       
  2314 	$fh->write( $header, LOCAL_FILE_HEADER_LENGTH )
       
  2315 		or return _ioError( "re-writing local header" );
       
  2316 	$fh->seek( $here, IO::Seekable::SEEK_SET )
       
  2317 			or return _ioError( "seeking after rewrite of local header" );
       
  2318 
       
  2319 	return AZ_OK;
       
  2320 }
       
  2321 
       
  2322 =back
       
  2323 
       
  2324 =head2 Low-level member data reading
       
  2325 
       
  2326 It is possible to use lower-level routines to access member
       
  2327 data streams, rather than the extract* methods and contents().
       
  2328 
       
  2329 For instance, here is how to print the uncompressed contents
       
  2330 of a member in chunks using these methods:
       
  2331 
       
  2332     my ( $member, $status, $bufferRef );
       
  2333     $member = $zip->memberNamed( 'xyz.txt' );
       
  2334     $member->desiredCompressionMethod( COMPRESSION_STORED );
       
  2335     $status = $member->rewindData();
       
  2336     die "error $status" if $status != AZ_OK;
       
  2337     while ( ! $member->readIsDone() )
       
  2338     {
       
  2339         ( $bufferRef, $status ) = $member->readChunk();
       
  2340         die "error $status" if $status != AZ_OK;
       
  2341         # do something with $bufferRef:
       
  2342         print $$bufferRef;
       
  2343     }
       
  2344     $member->endRead();
       
  2345 
       
  2346 =over 4
       
  2347 
       
  2348 =cut
       
  2349 
       
  2350 #--------------------------------
       
  2351 
       
  2352 =item readChunk( [$chunkSize] )
       
  2353 
       
  2354 This reads the next chunk of given size from the member's data stream and
       
  2355 compresses or uncompresses it as necessary, returning a reference to the bytes
       
  2356 read and a status.
       
  2357 If size argument is not given, defaults to global set by
       
  2358 Archive::Zip::setChunkSize.
       
  2359 Status is AZ_OK on success. Returns C<( \$bytes, $status)>.
       
  2360 
       
  2361     my ( $outRef, $status ) = $self->readChunk();
       
  2362     print $$outRef if $status != AZ_OK;
       
  2363 
       
  2364 =cut
       
  2365 
       
  2366 sub readChunk	# Archive::Zip::Member
       
  2367 {
       
  2368 	my ( $self, $chunkSize ) = @_;
       
  2369 
       
  2370 	if ( $self->readIsDone() )
       
  2371 	{
       
  2372 		$self->endRead();
       
  2373 		my $dummy = '';
       
  2374 		return ( \$dummy, AZ_STREAM_END );
       
  2375 	}
       
  2376 
       
  2377 	$chunkSize = $Archive::Zip::ChunkSize if not defined( $chunkSize );
       
  2378 	$chunkSize = $self->_readDataRemaining()
       
  2379 		if $chunkSize > $self->_readDataRemaining();
       
  2380 
       
  2381 	my $buffer = '';
       
  2382 	my $outputRef;
       
  2383 	my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
       
  2384 	return ( \$buffer, $status) if $status != AZ_OK;
       
  2385 
       
  2386 	$self->{'readDataRemaining'} -= $bytesRead;
       
  2387 	$self->{'readOffset'} += $bytesRead;
       
  2388 
       
  2389 	if ( $self->compressionMethod() == COMPRESSION_STORED )
       
  2390 	{
       
  2391 		$self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
       
  2392 	}
       
  2393 
       
  2394 	( $outputRef, $status) = &{$self->{'chunkHandler'}}( $self, \$buffer );
       
  2395 	$self->{'writeOffset'} += length( $$outputRef );
       
  2396 
       
  2397 	$self->endRead()
       
  2398 		if $self->readIsDone();
       
  2399 
       
  2400 	return ( $outputRef, $status);
       
  2401 }
       
  2402 
       
  2403 # Read the next raw chunk of my data. Subclasses MUST implement.
       
  2404 #	my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
       
  2405 sub _readRawChunk	# Archive::Zip::Member
       
  2406 {
       
  2407 	my $self = shift;
       
  2408 	return $self->_subclassResponsibility();
       
  2409 }
       
  2410 
       
  2411 # A place holder to catch rewindData errors if someone ignores
       
  2412 # the error code.
       
  2413 sub _noChunk	# Archive::Zip::Member
       
  2414 {
       
  2415 	my $self = shift;
       
  2416 	return ( \undef, _error( "trying to copy chunk when init failed" ));
       
  2417 }
       
  2418 
       
  2419 # Basically a no-op so that I can have a consistent interface.
       
  2420 # ( $outputRef, $status) = $self->_copyChunk( \$buffer );
       
  2421 sub _copyChunk	# Archive::Zip::Member
       
  2422 {
       
  2423 	my ( $self, $dataRef ) = @_;
       
  2424 	return ( $dataRef, AZ_OK );
       
  2425 }
       
  2426 
       
  2427 
       
  2428 # ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
       
  2429 sub _deflateChunk	# Archive::Zip::Member
       
  2430 {
       
  2431 	my ( $self, $buffer ) = @_;
       
  2432 	my ( $out, $status ) = $self->_deflater()->deflate( $buffer );
       
  2433 
       
  2434 	if ( $self->_readDataRemaining() == 0 )
       
  2435 	{
       
  2436 		my $extraOutput;
       
  2437 		( $extraOutput, $status ) = $self->_deflater()->flush();
       
  2438 		$out .= $extraOutput;
       
  2439 		$self->endRead();
       
  2440 		return ( \$out, AZ_STREAM_END );
       
  2441 	}
       
  2442 	elsif ( $status == Z_OK )
       
  2443 	{
       
  2444 		return ( \$out, AZ_OK );
       
  2445 	}
       
  2446 	else
       
  2447 	{
       
  2448 		$self->endRead();
       
  2449 		my $retval = _error( 'deflate error', $status);
       
  2450 		my $dummy = '';
       
  2451 		return ( \$dummy, $retval );
       
  2452 	}
       
  2453 }
       
  2454 
       
  2455 # ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
       
  2456 sub _inflateChunk	# Archive::Zip::Member
       
  2457 {
       
  2458 	my ( $self, $buffer ) = @_;
       
  2459 	my ( $out, $status ) = $self->_inflater()->inflate( $buffer );
       
  2460 	my $retval;
       
  2461 	$self->endRead() if ( $status != Z_OK );
       
  2462 	if ( $status == Z_OK || $status == Z_STREAM_END )
       
  2463 	{
       
  2464 		$retval = ( $status == Z_STREAM_END )
       
  2465 			? AZ_STREAM_END : AZ_OK;
       
  2466 		return ( \$out, $retval );
       
  2467 	}
       
  2468 	else
       
  2469 	{
       
  2470 		$retval = _error( 'inflate error', $status);
       
  2471 		my $dummy = '';
       
  2472 		return ( \$dummy, $retval );
       
  2473 	}
       
  2474 }
       
  2475 
       
  2476 #--------------------------------
       
  2477 
       
  2478 =item rewindData()
       
  2479 
       
  2480 Rewind data and set up for reading data streams or writing zip files.
       
  2481 Can take options for C<inflateInit()> or C<deflateInit()>,
       
  2482 but this isn't likely to be necessary.
       
  2483 Subclass overrides should call this method.
       
  2484 Returns C<AZ_OK> on success.
       
  2485 
       
  2486 =cut
       
  2487 
       
  2488 sub rewindData	# Archive::Zip::Member
       
  2489 {
       
  2490 	my $self = shift;
       
  2491 	my $status;
       
  2492 
       
  2493 	# set to trap init errors
       
  2494 	$self->{'chunkHandler'} = $self->can( '_noChunk' );
       
  2495 
       
  2496 	# Work around WinZip defect with 0-length DEFLATED files
       
  2497 	$self->desiredCompressionMethod( COMPRESSION_STORED )
       
  2498 		if $self->uncompressedSize() == 0;
       
  2499 
       
  2500 	# assume that we're going to read the whole file, and compute the CRC anew.
       
  2501 	$self->{'crc32'} = 0 if ( $self->compressionMethod() == COMPRESSION_STORED );
       
  2502 
       
  2503 	# These are the only combinations of methods we deal with right now.
       
  2504 	if ( $self->compressionMethod() == COMPRESSION_STORED
       
  2505 			and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
       
  2506 	{
       
  2507 		( $self->{'deflater'}, $status ) = Compress::Zlib::deflateInit(
       
  2508 			'-Level' => $self->desiredCompressionLevel(),
       
  2509 			'-WindowBits' => - MAX_WBITS(), # necessary magic
       
  2510 			@_ );	# pass additional options
       
  2511 		return _error( 'deflateInit error:', $status ) if $status != Z_OK;
       
  2512 		$self->{'chunkHandler'} = $self->can( '_deflateChunk' );
       
  2513 	}
       
  2514 	elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
       
  2515 			and $self->desiredCompressionMethod() == COMPRESSION_STORED )
       
  2516 	{
       
  2517 		( $self->{'inflater'}, $status ) = Compress::Zlib::inflateInit(
       
  2518 			'-WindowBits' => - MAX_WBITS(), # necessary magic
       
  2519 			@_ );	# pass additional options
       
  2520 		return _error( 'inflateInit error:', $status ) if $status != Z_OK;
       
  2521 		$self->{'chunkHandler'} = $self->can( '_inflateChunk' );
       
  2522 	}
       
  2523 	elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() )
       
  2524 	{
       
  2525 		$self->{'chunkHandler'} = $self->can( '_copyChunk' );
       
  2526 	}
       
  2527 	else
       
  2528 	{
       
  2529 		return _error(
       
  2530 			sprintf( "Unsupported compression combination: read %d, write %d",
       
  2531 				$self->compressionMethod(),
       
  2532 				$self->desiredCompressionMethod() )
       
  2533 		 );
       
  2534 	}
       
  2535 
       
  2536 	$self->{'dataEnded'} = 0;
       
  2537 	$self->{'readDataRemaining'} = $self->compressedSize();
       
  2538 	$self->{'readOffset'} = 0;
       
  2539 
       
  2540 	return AZ_OK;
       
  2541 }
       
  2542 
       
  2543 #--------------------------------
       
  2544 
       
  2545 =item endRead()
       
  2546 
       
  2547 Reset the read variables and free the inflater or deflater.
       
  2548 Must be called to close files, etc.
       
  2549 
       
  2550 Returns AZ_OK on success.
       
  2551 
       
  2552 =cut
       
  2553 
       
  2554 sub endRead	# Archive::Zip::Member
       
  2555 {
       
  2556 	my $self = shift;
       
  2557 	delete $self->{'inflater'};
       
  2558 	delete $self->{'deflater'};
       
  2559 	$self->{'dataEnded'} = 1;
       
  2560 	$self->{'readDataRemaining'} = 0;
       
  2561 	return AZ_OK;
       
  2562 }
       
  2563 
       
  2564 #--------------------------------
       
  2565 
       
  2566 =item readIsDone()
       
  2567 
       
  2568 Return true if the read has run out of data or errored out.
       
  2569 
       
  2570 =cut
       
  2571 
       
  2572 sub readIsDone	# Archive::Zip::Member
       
  2573 {
       
  2574 	my $self = shift;
       
  2575 	return ( $self->_dataEnded() or ! $self->_readDataRemaining() );
       
  2576 }
       
  2577 
       
  2578 #--------------------------------
       
  2579 
       
  2580 =item contents()
       
  2581 
       
  2582 Return the entire uncompressed member data or undef in scalar context.
       
  2583 When called in array context, returns C<( $string, $status )>; status
       
  2584 will be AZ_OK on success:
       
  2585 
       
  2586     my $string = $member->contents();
       
  2587     # or
       
  2588     my ( $string, $status ) = $member->contents();
       
  2589     die "error $status" if $status != AZ_OK;
       
  2590 
       
  2591 Can also be used to set the contents of a member (this may change
       
  2592 the class of the member):
       
  2593 
       
  2594     $member->contents( "this is my new contents" );
       
  2595 
       
  2596 =cut
       
  2597 
       
  2598 sub contents	# Archive::Zip::Member
       
  2599 {
       
  2600 	my $self = shift;
       
  2601 	my $newContents = shift;
       
  2602 	if ( defined( $newContents ) )
       
  2603 	{
       
  2604 		$self->_become( STRINGMEMBERCLASS );
       
  2605 		return $self->contents( $newContents );
       
  2606 	}
       
  2607 	else
       
  2608 	{
       
  2609 		my $oldCompression = 
       
  2610 			$self->desiredCompressionMethod( COMPRESSION_STORED );
       
  2611 		my $status = $self->rewindData( @_ );
       
  2612 		if ( $status != AZ_OK )
       
  2613 		{
       
  2614 			$self->endRead();
       
  2615 			return $status;
       
  2616 		}
       
  2617 		my $retval = '';
       
  2618 		while ( $status == AZ_OK )
       
  2619 		{
       
  2620 			my $ref;
       
  2621 			( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
       
  2622 			# did we get it in one chunk?
       
  2623 			if ( length( $$ref ) == $self->uncompressedSize() )
       
  2624 			{ $retval = $$ref }
       
  2625 			else
       
  2626 			{ $retval .= $$ref }
       
  2627 		}
       
  2628 		$self->desiredCompressionMethod( $oldCompression );
       
  2629 		$self->endRead();
       
  2630 		$status = AZ_OK if $status == AZ_STREAM_END;
       
  2631 		$retval = undef if $status != AZ_OK;
       
  2632 		return wantarray ? ( $retval, $status ) : $retval;
       
  2633 	}
       
  2634 }
       
  2635 
       
  2636 #--------------------------------
       
  2637 
       
  2638 =item extractToFileHandle( $fh )
       
  2639 
       
  2640 Extract (and uncompress, if necessary) my contents to the given file handle.
       
  2641 Return AZ_OK on success.
       
  2642 
       
  2643 =cut
       
  2644 
       
  2645 sub extractToFileHandle	# Archive::Zip::Member
       
  2646 {
       
  2647 	my $self = shift;
       
  2648 	return _error( "encryption unsupported" ) if $self->isEncrypted();
       
  2649 	my $fh = shift;
       
  2650 	_binmode( $fh );
       
  2651 	my $oldCompression = $self->desiredCompressionMethod( COMPRESSION_STORED );
       
  2652 	my $status = $self->rewindData( @_ );
       
  2653 	$status = $self->_writeData( $fh ) if $status == AZ_OK;
       
  2654 	$self->desiredCompressionMethod( $oldCompression );
       
  2655 	$self->endRead();
       
  2656 	return $status;
       
  2657 }
       
  2658 
       
  2659 # write local header and data stream to file handle
       
  2660 sub _writeToFileHandle	# Archive::Zip::Member
       
  2661 {
       
  2662 	my $self = shift;
       
  2663 	my $fh = shift;
       
  2664 	my $fhIsSeekable = shift;
       
  2665 
       
  2666 	# Determine if I need to write a data descriptor
       
  2667 	# I need to do this if I can't refresh the header
       
  2668 	# and I don't know compressed size or crc32 fields.
       
  2669 	my $headerFieldsUnknown = ( ( $self->uncompressedSize() > 0 )
       
  2670 		and ( $self->compressionMethod() == COMPRESSION_STORED
       
  2671 			or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED ) );
       
  2672 
       
  2673 	my $shouldWriteDataDescriptor =
       
  2674 		( $headerFieldsUnknown and not $fhIsSeekable );
       
  2675 
       
  2676 	$self->hasDataDescriptor( 1 )
       
  2677 		if ( $shouldWriteDataDescriptor );
       
  2678 
       
  2679 	$self->{'writeOffset'} = 0;
       
  2680 
       
  2681 	my $status = $self->rewindData();
       
  2682 	( $status = $self->_writeLocalFileHeader( $fh ) )
       
  2683 		if $status == AZ_OK;
       
  2684 	( $status = $self->_writeData( $fh ) )
       
  2685 		if $status == AZ_OK;
       
  2686 	if ( $status == AZ_OK )
       
  2687 	{
       
  2688 		if ( $self->hasDataDescriptor() )
       
  2689 		{
       
  2690 			$status = $self->_writeDataDescriptor( $fh );
       
  2691 		}
       
  2692 		elsif ( $headerFieldsUnknown )
       
  2693 		{
       
  2694 			$status = $self->_refreshLocalFileHeader( $fh );
       
  2695 		}
       
  2696 	}
       
  2697 
       
  2698 	return $status;
       
  2699 }
       
  2700 
       
  2701 # Copy my (possibly compressed) data to given file handle.
       
  2702 # Returns C<AZ_OK> on success
       
  2703 sub _writeData	# Archive::Zip::Member
       
  2704 {
       
  2705 	my $self = shift;
       
  2706 	my $writeFh = shift;
       
  2707 
       
  2708 	return AZ_OK if ( $self->uncompressedSize() == 0 );
       
  2709 	my $status;
       
  2710 	my $chunkSize = $Archive::Zip::ChunkSize;
       
  2711 	while ( $self->_readDataRemaining() > 0 )
       
  2712 	{
       
  2713 		my $outRef;
       
  2714 		( $outRef, $status ) = $self->readChunk( $chunkSize );
       
  2715 		return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );
       
  2716 
       
  2717 		$writeFh->write( $$outRef, length( $$outRef ) )
       
  2718 			or return _ioError( "write error during copy" );
       
  2719 
       
  2720 		last if $status == AZ_STREAM_END;
       
  2721 	}
       
  2722 	return AZ_OK;
       
  2723 }
       
  2724 
       
  2725 
       
  2726 # Return true if I depend on the named file
       
  2727 sub _usesFileNamed
       
  2728 {
       
  2729 	return 0;
       
  2730 }
       
  2731 
       
  2732 # ----------------------------------------------------------------------
       
  2733 # class Archive::Zip::DirectoryMember
       
  2734 # ----------------------------------------------------------------------
       
  2735 
       
  2736 package Archive::Zip::DirectoryMember;
       
  2737 use File::Path;
       
  2738 
       
  2739 use vars qw( @ISA );
       
  2740 @ISA = qw ( Archive::Zip::Member );
       
  2741 BEGIN { use Archive::Zip qw( :ERROR_CODES :UTILITY_METHODS ) }
       
  2742 
       
  2743 sub _newNamed	# Archive::Zip::DirectoryMember
       
  2744 {
       
  2745 	my $class = shift;
       
  2746 	my $name = shift;
       
  2747 	my $self = $class->new( @_ );
       
  2748 	$self->fileName( $name );
       
  2749 	if ( -d $name )
       
  2750 	{
       
  2751 		my @stat = stat( _ );
       
  2752 		$self->unixFileAttributes( $stat[2] );
       
  2753 		$self->setLastModFileDateTimeFromUnix( $stat[9] );
       
  2754 	}
       
  2755 	else
       
  2756 	{
       
  2757 		$self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
       
  2758 		$self->setLastModFileDateTimeFromUnix( time() );
       
  2759 	}
       
  2760 	return $self;
       
  2761 }
       
  2762 
       
  2763 sub isDirectory	# Archive::Zip::DirectoryMember
       
  2764 { return 1; }
       
  2765 
       
  2766 sub extractToFileNamed	# Archive::Zip::DirectoryMember
       
  2767 {
       
  2768 	my $self = shift;
       
  2769 	my $name = shift;
       
  2770 	my $attribs = $self->unixFileAttributes() & 07777;
       
  2771 	mkpath( $name, 0, $attribs );	# croaks on error
       
  2772 	return AZ_OK;
       
  2773 }
       
  2774 
       
  2775 sub fileName	# Archive::Zip::DirectoryMember
       
  2776 {
       
  2777 	my $self = shift;
       
  2778 	my $newName = shift;
       
  2779 	$newName =~ s{/?$}{/} if defined( $newName );
       
  2780 	return $self->SUPER::fileName( $newName );
       
  2781 }
       
  2782 
       
  2783 =back
       
  2784 
       
  2785 =head1 Archive::Zip::FileMember methods
       
  2786 
       
  2787 The Archive::Zip::FileMember class extends Archive::Zip::Member.
       
  2788 It is the base class for both ZipFileMember and NewFileMember classes.
       
  2789 This class adds an C<externalFileName> and an C<fh> member to keep
       
  2790 track of the external file.
       
  2791 
       
  2792 =over 4
       
  2793 
       
  2794 =cut
       
  2795 
       
  2796 # ----------------------------------------------------------------------
       
  2797 # class Archive::Zip::FileMember
       
  2798 # Base class for classes that have file handles
       
  2799 # to external files
       
  2800 # ----------------------------------------------------------------------
       
  2801 
       
  2802 package Archive::Zip::FileMember;
       
  2803 use vars qw( @ISA );
       
  2804 @ISA = qw ( Archive::Zip::Member );
       
  2805 BEGIN { use Archive::Zip qw( :UTILITY_METHODS ) }
       
  2806 
       
  2807 #--------------------------------
       
  2808 
       
  2809 =item externalFileName()
       
  2810 
       
  2811 Return my external filename.
       
  2812 
       
  2813 =cut
       
  2814 
       
  2815 sub externalFileName	# Archive::Zip::FileMember
       
  2816 { shift->{'externalFileName'} }
       
  2817 
       
  2818 #--------------------------------
       
  2819 
       
  2820 # Return true if I depend on the named file
       
  2821 sub _usesFileNamed
       
  2822 {
       
  2823 	my $self = shift;
       
  2824 	my $fileName = shift;
       
  2825 	return $self->externalFileName eq $fileName;
       
  2826 }
       
  2827 
       
  2828 =item fh()
       
  2829 
       
  2830 Return my read file handle.
       
  2831 Automatically opens file if necessary.
       
  2832 
       
  2833 =cut
       
  2834 
       
  2835 sub fh	# Archive::Zip::FileMember
       
  2836 {
       
  2837 	my $self = shift;
       
  2838 	$self->_openFile() if ! $self->{'fh'};
       
  2839 	return $self->{'fh'};
       
  2840 }
       
  2841 
       
  2842 # opens my file handle from my file name
       
  2843 sub _openFile	# Archive::Zip::FileMember
       
  2844 {
       
  2845 	my $self = shift;
       
  2846 	my ( $status, $fh ) = _newFileHandle( $self->externalFileName(), 'r' );
       
  2847 	if ( !$status )
       
  2848 	{
       
  2849 		_ioError( "Can't open", $self->externalFileName() );
       
  2850 		return undef;
       
  2851 	}
       
  2852 	$self->{'fh'} = $fh;
       
  2853 	_binmode( $fh );
       
  2854 	return $fh;
       
  2855 }
       
  2856 
       
  2857 # Closes my file handle
       
  2858 sub _closeFile	# Archive::Zip::FileMember
       
  2859 {
       
  2860 	my $self = shift;
       
  2861 	$self->{'fh'} = undef;
       
  2862 }
       
  2863 
       
  2864 # Make sure I close my file handle
       
  2865 sub endRead	# Archive::Zip::FileMember
       
  2866 {
       
  2867 	my $self = shift;
       
  2868 	$self->_closeFile();
       
  2869 	return $self->SUPER::endRead( @_ );
       
  2870 }
       
  2871 
       
  2872 sub _become	# Archive::Zip::FileMember
       
  2873 {
       
  2874 	my $self = shift;
       
  2875 	my $newClass = shift;
       
  2876 	return $self if ref( $self ) eq $newClass;
       
  2877 	delete( $self->{'externalFileName'} );
       
  2878 	delete( $self->{'fh'} );
       
  2879 	return $self->SUPER::_become( $newClass );
       
  2880 }
       
  2881 
       
  2882 # ----------------------------------------------------------------------
       
  2883 # class Archive::Zip::NewFileMember
       
  2884 # Used when adding a pre-existing file to an archive
       
  2885 # ----------------------------------------------------------------------
       
  2886 
       
  2887 package Archive::Zip::NewFileMember;
       
  2888 use vars qw( @ISA );
       
  2889 @ISA = qw ( Archive::Zip::FileMember );
       
  2890 
       
  2891 BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :UTILITY_METHODS ) }
       
  2892 
       
  2893 # Given a file name, set up for eventual writing.
       
  2894 sub _newFromFileNamed	# Archive::Zip::NewFileMember
       
  2895 {
       
  2896 	my $class = shift;
       
  2897 	my $fileName = shift;
       
  2898 	return undef if ! ( -r $fileName && ( -f _ || -l _ ) );
       
  2899 	my $self = $class->new( @_ );
       
  2900 	$self->fileName( $fileName );
       
  2901 	$self->{'externalFileName'} = $fileName;
       
  2902 	$self->{'compressionMethod'} = COMPRESSION_STORED;
       
  2903 	my @stat = stat( _ );
       
  2904 	$self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
       
  2905 	$self->desiredCompressionMethod( ( $self->compressedSize() > 0 )
       
  2906 		? COMPRESSION_DEFLATED
       
  2907 		: COMPRESSION_STORED );
       
  2908 	$self->unixFileAttributes( $stat[2] );
       
  2909 	$self->setLastModFileDateTimeFromUnix( $stat[9] );
       
  2910 	$self->isTextFile( -T _ );
       
  2911 	return $self;
       
  2912 }
       
  2913 
       
  2914 sub rewindData	# Archive::Zip::NewFileMember
       
  2915 {
       
  2916 	my $self = shift;
       
  2917 
       
  2918 	my $status = $self->SUPER::rewindData( @_ );
       
  2919 	return $status if $status != AZ_OK;
       
  2920 
       
  2921 	return AZ_IO_ERROR if ! $self->fh();
       
  2922 	$self->fh()->clearerr();
       
  2923 	$self->fh()->seek( 0, IO::Seekable::SEEK_SET )
       
  2924 		or return _ioError( "rewinding", $self->externalFileName() );
       
  2925 	return AZ_OK;
       
  2926 }
       
  2927 
       
  2928 # Return bytes read. Note that first parameter is a ref to a buffer.
       
  2929 # my $data;
       
  2930 # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
       
  2931 sub _readRawChunk	# Archive::Zip::NewFileMember
       
  2932 {
       
  2933 	my ( $self, $dataRef, $chunkSize ) = @_;
       
  2934 	return ( 0, AZ_OK ) if ( ! $chunkSize );
       
  2935 	my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
       
  2936 		or return ( 0, _ioError( "reading data" ) );
       
  2937 	return ( $bytesRead, AZ_OK );
       
  2938 }
       
  2939 
       
  2940 # If I already exist, extraction is a no-op.
       
  2941 sub extractToFileNamed	# Archive::Zip::NewFileMember
       
  2942 {
       
  2943 	my $self = shift;
       
  2944 	my $name = shift;
       
  2945 	if ( $name eq $self->fileName() and -r $name )
       
  2946 	{
       
  2947 		return AZ_OK;
       
  2948 	}
       
  2949 	else
       
  2950 	{
       
  2951 		return $self->SUPER::extractToFileNamed( $name, @_ );
       
  2952 	}
       
  2953 }
       
  2954 
       
  2955 =back
       
  2956 
       
  2957 =head1 Archive::Zip::ZipFileMember methods
       
  2958 
       
  2959 The Archive::Zip::ZipFileMember class represents members that have
       
  2960 been read from external zip files.
       
  2961 
       
  2962 =over 4
       
  2963 
       
  2964 =cut
       
  2965 
       
  2966 # ----------------------------------------------------------------------
       
  2967 # class Archive::Zip::ZipFileMember
       
  2968 # This represents a member in an existing zip file on disk.
       
  2969 # ----------------------------------------------------------------------
       
  2970 
       
  2971 package Archive::Zip::ZipFileMember;
       
  2972 use vars qw( @ISA );
       
  2973 @ISA = qw ( Archive::Zip::FileMember );
       
  2974 
       
  2975 BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
       
  2976 	:UTILITY_METHODS ) }
       
  2977 
       
  2978 # Create a new Archive::Zip::ZipFileMember
       
  2979 # given a filename and optional open file handle
       
  2980 sub _newFromZipFile	# Archive::Zip::ZipFileMember
       
  2981 {
       
  2982 	my $class = shift;
       
  2983 	my $fh = shift;
       
  2984 	my $externalFileName = shift;
       
  2985 	my $self = $class->new(
       
  2986 		'crc32' => 0,
       
  2987 		'diskNumberStart' => 0,
       
  2988 		'localHeaderRelativeOffset' => 0,
       
  2989 		'dataOffset' =>  0,	# localHeaderRelativeOffset + header length
       
  2990 		@_
       
  2991 	 );
       
  2992 	$self->{'externalFileName'} = $externalFileName;
       
  2993 	$self->{'fh'} = $fh;
       
  2994 	return $self;
       
  2995 }
       
  2996 
       
  2997 sub isDirectory	# Archive::Zip::FileMember
       
  2998 {
       
  2999 	my $self = shift;
       
  3000 	return ( substr( $self->fileName(), -1, 1 ) eq '/'
       
  3001 		and $self->uncompressedSize() == 0 );
       
  3002 }
       
  3003 
       
  3004 # Because I'm going to delete the file handle, read the local file
       
  3005 # header if the file handle is seekable. If it isn't, I assume that
       
  3006 # I've already read the local header.
       
  3007 # Return ( $status, $self )
       
  3008 
       
  3009 sub _become	# Archive::Zip::ZipFileMember
       
  3010 {
       
  3011 	my $self = shift;
       
  3012 	my $newClass = shift;
       
  3013 	return $self if ref( $self ) eq $newClass;
       
  3014 
       
  3015 	my $status = AZ_OK;
       
  3016 
       
  3017 	if ( _isSeekable( $self->fh() ) )
       
  3018 	{
       
  3019 		my $here = $self->fh()->tell();
       
  3020 		$status = $self->fh()->seek(
       
  3021 			$self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
       
  3022 			IO::Seekable::SEEK_SET );
       
  3023 		if ( ! $status )
       
  3024 		{
       
  3025 			$self->fh()->seek( $here );
       
  3026 			_ioError( "seeking to local header" );
       
  3027 			return $self;
       
  3028 		}
       
  3029 		$self->_readLocalFileHeader();
       
  3030 		$self->fh()->seek( $here, IO::Seekable::SEEK_SET );
       
  3031 	}
       
  3032 
       
  3033 	delete( $self->{'diskNumberStart'} );
       
  3034 	delete( $self->{'localHeaderRelativeOffset'} );
       
  3035 	delete( $self->{'dataOffset'} );
       
  3036 
       
  3037 	return $self->SUPER::_become( $newClass );
       
  3038 }
       
  3039 
       
  3040 #--------------------------------
       
  3041 
       
  3042 =item diskNumberStart()
       
  3043 
       
  3044 Returns the disk number that my local header resides
       
  3045 in. Had better be 0.
       
  3046 
       
  3047 =cut
       
  3048 
       
  3049 sub diskNumberStart	# Archive::Zip::ZipFileMember
       
  3050 { shift->{'diskNumberStart'} }
       
  3051 
       
  3052 #--------------------------------
       
  3053 
       
  3054 =item localHeaderRelativeOffset()
       
  3055 
       
  3056 Returns the offset into the zip file where my local header is.
       
  3057 
       
  3058 =cut
       
  3059 
       
  3060 sub localHeaderRelativeOffset	# Archive::Zip::ZipFileMember
       
  3061 { shift->{'localHeaderRelativeOffset'} }
       
  3062 
       
  3063 #--------------------------------
       
  3064 
       
  3065 =item dataOffset()
       
  3066 
       
  3067 Returns the offset from the beginning of the zip file to
       
  3068 my data.
       
  3069 
       
  3070 =cut
       
  3071 
       
  3072 sub dataOffset	# Archive::Zip::ZipFileMember
       
  3073 { shift->{'dataOffset'} }
       
  3074 
       
  3075 # Skip local file header, updating only extra field stuff.
       
  3076 # Assumes that fh is positioned before signature.
       
  3077 sub _skipLocalFileHeader	# Archive::Zip::ZipFileMember
       
  3078 {
       
  3079 	my $self = shift;
       
  3080 	my $header;
       
  3081 	$self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH )
       
  3082 		or return _ioError( "reading local file header" );
       
  3083 	my $fileNameLength;
       
  3084 	my $extraFieldLength;
       
  3085 	(	undef, 	# $self->{'versionNeededToExtract'},
       
  3086 		undef,	# $self->{'bitFlag'},
       
  3087 		undef,	# $self->{'compressionMethod'},
       
  3088 		undef,	# $self->{'lastModFileDateTime'},
       
  3089 		undef,	# $crc32,
       
  3090 		undef,	# $compressedSize,
       
  3091 		undef,	# $uncompressedSize,
       
  3092 		$fileNameLength,
       
  3093 		$extraFieldLength ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
       
  3094 
       
  3095 	if ( $fileNameLength )
       
  3096 	{
       
  3097 		$self->fh()->seek( $fileNameLength, IO::Seekable::SEEK_CUR )
       
  3098 			or return _ioError( "skipping local file name" );
       
  3099 	}
       
  3100 
       
  3101 	if ( $extraFieldLength )
       
  3102 	{
       
  3103 		$self->fh()->read( $self->{'localExtraField'}, $extraFieldLength )
       
  3104 			or return _ioError( "reading local extra field" );
       
  3105 	}
       
  3106 
       
  3107 	$self->{'dataOffset'} = $self->fh()->tell();
       
  3108 
       
  3109 	return AZ_OK;
       
  3110 }
       
  3111 
       
  3112 # Read from a local file header into myself. Returns AZ_OK if successful.
       
  3113 # Assumes that fh is positioned after signature.
       
  3114 # Note that crc32, compressedSize, and uncompressedSize will be 0 if
       
  3115 # GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag.
       
  3116 
       
  3117 sub _readLocalFileHeader	# Archive::Zip::ZipFileMember
       
  3118 {
       
  3119 	my $self = shift;
       
  3120 	my $header;
       
  3121 	$self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH )
       
  3122 		or return _ioError( "reading local file header" );
       
  3123 	my $fileNameLength;
       
  3124 	my $crc32;
       
  3125 	my $compressedSize;
       
  3126 	my $uncompressedSize;
       
  3127 	my $extraFieldLength;
       
  3128 	(	$self->{'versionNeededToExtract'},
       
  3129 		$self->{'bitFlag'},
       
  3130 		$self->{'compressionMethod'},
       
  3131 		$self->{'lastModFileDateTime'},
       
  3132 		$crc32,
       
  3133 		$compressedSize,
       
  3134 		$uncompressedSize,
       
  3135 		$fileNameLength,
       
  3136 		$extraFieldLength ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
       
  3137 
       
  3138 	if ( $fileNameLength )
       
  3139 	{
       
  3140 		my $fileName;
       
  3141 		$self->fh()->read( $fileName, $fileNameLength )
       
  3142 			or return _ioError( "reading local file name" );
       
  3143 		$self->fileName( $fileName );
       
  3144 	}
       
  3145 
       
  3146 	if ( $extraFieldLength )
       
  3147 	{
       
  3148 		$self->fh()->read( $self->{'localExtraField'}, $extraFieldLength )
       
  3149 			or return _ioError( "reading local extra field" );
       
  3150 	}
       
  3151 
       
  3152 	$self->{'dataOffset'} = $self->fh()->tell();
       
  3153 
       
  3154 	# Don't trash these fields from the CD if we already have them.
       
  3155 	if ( not $self->hasDataDescriptor() )
       
  3156 	{
       
  3157 		$self->{'crc32'} = $crc32;
       
  3158 		$self->{'compressedSize'} = $compressedSize;
       
  3159 		$self->{'uncompressedSize'} = $uncompressedSize;
       
  3160 	}
       
  3161 
       
  3162 	# We ignore data descriptors (we don't read them,
       
  3163 	# and we compute elsewhere whether we need to write them ).
       
  3164 	# And, we have the necessary data from the CD header.
       
  3165 	# So mark this entry as not having a data descriptor.
       
  3166 	$self->hasDataDescriptor( 0 );
       
  3167 
       
  3168 	return AZ_OK;
       
  3169 }
       
  3170 
       
  3171 
       
  3172 # Read a Central Directory header. Return AZ_OK on success.
       
  3173 # Assumes that fh is positioned right after the signature.
       
  3174 
       
  3175 sub _readCentralDirectoryFileHeader	# Archive::Zip::ZipFileMember
       
  3176 {
       
  3177 	my $self = shift;
       
  3178 	my $fh = $self->fh();
       
  3179 	my $header = '';
       
  3180 	$fh->read( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
       
  3181 		or return _ioError( "reading central dir header" );
       
  3182 	my ( $fileNameLength, $extraFieldLength, $fileCommentLength );
       
  3183 	(
       
  3184 		$self->{'versionMadeBy'},
       
  3185 		$self->{'fileAttributeFormat'},
       
  3186 		$self->{'versionNeededToExtract'},
       
  3187 		$self->{'bitFlag'},
       
  3188 		$self->{'compressionMethod'},
       
  3189 		$self->{'lastModFileDateTime'},
       
  3190 		$self->{'crc32'},
       
  3191 		$self->{'compressedSize'},
       
  3192 		$self->{'uncompressedSize'},
       
  3193 		$fileNameLength,
       
  3194 		$extraFieldLength,
       
  3195 		$fileCommentLength,
       
  3196 		$self->{'diskNumberStart'},
       
  3197 		$self->{'internalFileAttributes'},
       
  3198 		$self->{'externalFileAttributes'},
       
  3199 		$self->{'localHeaderRelativeOffset'}
       
  3200 	 ) = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
       
  3201 
       
  3202 	if ( $fileNameLength )
       
  3203 	{
       
  3204 		$fh->read( $self->{'fileName'}, $fileNameLength )
       
  3205 			or return _ioError( "reading central dir filename" );
       
  3206 	}
       
  3207 	if ( $extraFieldLength )
       
  3208 	{
       
  3209 		$fh->read( $self->{'cdExtraField'}, $extraFieldLength )
       
  3210 			or return _ioError( "reading central dir extra field" );
       
  3211 	}
       
  3212 	if ( $fileCommentLength )
       
  3213 	{
       
  3214 		$fh->read( $self->{'fileComment'}, $fileCommentLength )
       
  3215 			or return _ioError( "reading central dir file comment" );
       
  3216 	}
       
  3217 
       
  3218 	$self->desiredCompressionMethod( $self->compressionMethod() );
       
  3219 
       
  3220 	return AZ_OK;
       
  3221 }
       
  3222 
       
  3223 sub rewindData	# Archive::Zip::ZipFileMember
       
  3224 {
       
  3225 	my $self = shift;
       
  3226 
       
  3227 	my $status = $self->SUPER::rewindData( @_ );
       
  3228 	return $status if $status != AZ_OK;
       
  3229 
       
  3230 	return AZ_IO_ERROR if ! $self->fh();
       
  3231 
       
  3232 	$self->fh()->clearerr();
       
  3233 
       
  3234 	# Seek to local file header.
       
  3235 	# The only reason that I'm doing this this way is that the extraField
       
  3236 	# length seems to be different between the CD header and the LF header.
       
  3237 	$self->fh()->seek( $self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
       
  3238 		IO::Seekable::SEEK_SET )
       
  3239 			or return _ioError( "seeking to local header" );
       
  3240 
       
  3241 	# skip local file header
       
  3242 	$status = $self->_skipLocalFileHeader();
       
  3243 	return $status if $status != AZ_OK;
       
  3244 
       
  3245 	# Seek to beginning of file data
       
  3246 	$self->fh()->seek( $self->dataOffset(), IO::Seekable::SEEK_SET )
       
  3247 		or return _ioError( "seeking to beginning of file data" );
       
  3248 
       
  3249 	return AZ_OK;
       
  3250 }
       
  3251 
       
  3252 # Return bytes read. Note that first parameter is a ref to a buffer.
       
  3253 # my $data;
       
  3254 # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
       
  3255 sub _readRawChunk	# Archive::Zip::ZipFileMember
       
  3256 {
       
  3257 	my ( $self, $dataRef, $chunkSize ) = @_;
       
  3258 	return ( 0, AZ_OK )
       
  3259 		if ( ! $chunkSize );
       
  3260 	my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
       
  3261 		or return ( 0, _ioError( "reading data" ) );
       
  3262 	return ( $bytesRead, AZ_OK );
       
  3263 }
       
  3264 
       
  3265 # ----------------------------------------------------------------------
       
  3266 # class Archive::Zip::StringMember ( concrete )
       
  3267 # A Zip member whose data lives in a string
       
  3268 # ----------------------------------------------------------------------
       
  3269 
       
  3270 package Archive::Zip::StringMember;
       
  3271 use vars qw( @ISA );
       
  3272 @ISA = qw ( Archive::Zip::Member );
       
  3273 
       
  3274 BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES ) }
       
  3275 
       
  3276 # Create a new string member. Default is COMPRESSION_STORED.
       
  3277 # Can take a ref to a string as well.
       
  3278 sub _newFromString	# Archive::Zip::StringMember
       
  3279 {
       
  3280 	my $class = shift;
       
  3281 	my $string = shift;
       
  3282 	my $name = shift;
       
  3283 	my $self = $class->new( @_ );
       
  3284 	$self->contents( $string );
       
  3285 	$self->fileName( $name ) if defined( $name );
       
  3286 	# Set the file date to now
       
  3287 	$self->setLastModFileDateTimeFromUnix( time() );
       
  3288 	$self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
       
  3289 	return $self;
       
  3290 }
       
  3291 
       
  3292 sub _become	# Archive::Zip::StringMember
       
  3293 {
       
  3294 	my $self = shift;
       
  3295 	my $newClass = shift;
       
  3296 	return $self if ref( $self ) eq $newClass;
       
  3297 	delete( $self->{'contents'} );
       
  3298 	return $self->SUPER::_become( $newClass );
       
  3299 }
       
  3300 
       
  3301 # Get or set my contents. Note that we do not call the superclass
       
  3302 # version of this, because it calls us.
       
  3303 sub contents    # Archive::Zip::StringMember
       
  3304 {
       
  3305 	my $self = shift;
       
  3306 	my $string = shift;
       
  3307 	if ( defined( $string ) )
       
  3308 	{
       
  3309 		$self->{'contents'} = ( ref( $string ) eq 'SCALAR' )
       
  3310 			? $$string
       
  3311 			: $string;
       
  3312 		$self->{'uncompressedSize'}
       
  3313 			= $self->{'compressedSize'}
       
  3314 			= length( $self->{'contents'} );
       
  3315 		$self->{'compressionMethod'} = COMPRESSION_STORED;
       
  3316 	}
       
  3317 	return $self->{'contents'};
       
  3318 }
       
  3319 
       
  3320 # Return bytes read. Note that first parameter is a ref to a buffer.
       
  3321 # my $data;
       
  3322 # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
       
  3323 sub _readRawChunk	# Archive::Zip::StringMember
       
  3324 {
       
  3325 	my ( $self, $dataRef, $chunkSize ) = @_;
       
  3326 	$$dataRef = substr( $self->contents(), $self->_readOffset(), $chunkSize );
       
  3327 	return ( length( $$dataRef ), AZ_OK );
       
  3328 }
       
  3329 
       
  3330 1;
       
  3331 __END__
       
  3332 
       
  3333 =back
       
  3334 
       
  3335 =head1 AUTHOR
       
  3336 
       
  3337 Ned Konz, perl@bike-nomad.com
       
  3338 
       
  3339 =head1 COPYRIGHT
       
  3340 
       
  3341 Copyright (c) 2000 Ned Konz. All rights reserved.  This program is free
       
  3342 software; you can redistribute it and/or modify it under the same terms
       
  3343 as Perl itself.
       
  3344 
       
  3345 =head1 SEE ALSO
       
  3346 
       
  3347 L<Compress::Zlib>
       
  3348 
       
  3349 =cut
       
  3350 
       
  3351 # vim: ts=4 sw=4 columns=80