--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/Archive/Zip.pm Wed Jun 30 11:35:58 2010 +0800
@@ -0,0 +1,3351 @@
+#! perl -w
+# $Revision: 1.39 $
+
+# Copyright (c) 2000 Ned Konz. All rights reserved. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+=head1 NAME
+
+Archive::Zip - Provide an interface to ZIP archive files.
+
+=head1 SYNOPSIS
+
+ use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
+
+ my $zip = Archive::Zip->new();
+ my $member = $zip->addDirectory( 'dirname/' );
+ $member = $zip->addString( 'This is a test', 'stringMember.txt' );
+ $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
+ $member = $zip->addFile( 'xyz.pl', 'AnotherName.pl' );
+
+ die 'write error' if $zip->writeToFileNamed( 'someZip.zip' ) != AZ_OK;
+
+ $zip = Archive::Zip->new();
+ die 'read error' if $zip->read( 'someZip.zip' ) != AZ_OK;
+
+ $member = $zip->memberNamed( 'stringMember.txt' );
+ $member->desiredCompressionMethod( COMPRESSION_STORED );
+
+ die 'write error' if $zip->writeToFileNamed( 'someOtherZip.zip' ) != AZ_OK;
+
+=head1 DESCRIPTION
+
+The Archive::Zip module allows a Perl program to create,
+manipulate, read, and write Zip archive files.
+
+Zip archives can be created, or you can read from existing zip files.
+Once created, they can be written to files, streams, or strings.
+
+Members can be added, removed, extracted, replaced, rearranged,
+and enumerated.
+They can also be renamed or have their dates, comments,
+or other attributes queried or modified.
+Their data can be compressed or uncompressed as needed.
+Members can be created from members in existing Zip files,
+or from existing directories, files, or strings.
+
+This module uses the L<Compress::Zlib|Compress::Zlib> library
+to read and write the compressed streams inside the files.
+
+=head1 EXPORTS
+
+=over 4
+
+=item :CONSTANTS
+
+Exports the following constants:
+
+FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
+GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
+COMPRESSION_STORED COMPRESSION_DEFLATED
+IFA_TEXT_FILE_MASK IFA_TEXT_FILE IFA_BINARY_FILE
+COMPRESSION_LEVEL_NONE
+COMPRESSION_LEVEL_DEFAULT
+COMPRESSION_LEVEL_FASTEST
+COMPRESSION_LEVEL_BEST_COMPRESSION
+
+=item :MISC_CONSTANTS
+
+Exports the following constants (only necessary for extending the module):
+
+FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST
+FA_OS2_HPFS FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
+GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
+GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
+GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
+DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
+DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
+COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
+COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
+COMPRESSION_DEFLATED_ENHANCED
+COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED
+
+=item :ERROR_CODES
+
+Explained below. Returned from most methods.
+
+AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR
+
+=back
+
+=head1 OBJECT MODEL
+
+=head2 Inheritance
+
+ Exporter
+ Archive::Zip Common base class, has defs.
+ Archive::Zip::Archive A Zip archive.
+ Archive::Zip::Member Abstract superclass for all members.
+ Archive::Zip::StringMember Member made from a string
+ Archive::Zip::FileMember Member made from an external file
+ Archive::Zip::ZipFileMember Member that lives in a zip file
+ Archive::Zip::NewFileMember Member whose data is in a file
+ Archive::Zip::DirectoryMember Member that is a directory
+
+=cut
+
+# ----------------------------------------------------------------------
+# class Archive::Zip
+# Note that the package Archive::Zip exists only for exporting and
+# sharing constants. Everything else is in another package
+# in this file.
+# Creation of a new Archive::Zip object actually creates a new object
+# of class Archive::Zip::Archive.
+# ----------------------------------------------------------------------
+
+package Archive::Zip;
+require 5.003_96;
+use strict;
+
+use Carp ();
+use IO::File ();
+use IO::Seekable ();
+use Compress::Zlib ();
+use POSIX qw(_exit);
+
+use vars qw( @ISA @EXPORT_OK %EXPORT_TAGS $VERSION $ChunkSize $ErrorHandler );
+
+if ($Compress::Zlib::VERSION < 1.06)
+{
+ if ($] < 5.006001)
+ {
+ print STDERR "Your current perl libraries are too old; please upgrade to Perl 5.6.1\n";
+ }
+ else
+ {
+ 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";
+ }
+ STDERR->flush;
+ POSIX:_exit(1);
+}
+
+# This is the size we'll try to read, write, and (de)compress.
+# You could set it to something different if you had lots of memory
+# and needed more speed.
+$ChunkSize = 32768;
+
+$ErrorHandler = \&Carp::carp;
+
+# BEGIN block is necessary here so that other modules can use the constants.
+BEGIN
+{
+ require Exporter;
+
+ $VERSION = "0.11";
+ @ISA = qw( Exporter );
+
+ my @ConstantNames = qw( FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
+ GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
+ COMPRESSION_STORED COMPRESSION_DEFLATED COMPRESSION_LEVEL_NONE
+ COMPRESSION_LEVEL_DEFAULT COMPRESSION_LEVEL_FASTEST
+ COMPRESSION_LEVEL_BEST_COMPRESSION IFA_TEXT_FILE_MASK IFA_TEXT_FILE
+ IFA_BINARY_FILE );
+
+ my @MiscConstantNames = qw( FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST
+ FA_OS2_HPFS FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
+ GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
+ GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
+ GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
+ DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
+ DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
+ COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
+ COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
+ COMPRESSION_DEFLATED_ENHANCED
+ COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED );
+
+ my @ErrorCodeNames = qw( AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR
+ AZ_IO_ERROR );
+
+ my @PKZipConstantNames = qw( SIGNATURE_FORMAT SIGNATURE_LENGTH
+ LOCAL_FILE_HEADER_SIGNATURE LOCAL_FILE_HEADER_FORMAT
+ LOCAL_FILE_HEADER_LENGTH DATA_DESCRIPTOR_FORMAT DATA_DESCRIPTOR_LENGTH
+ CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
+ CENTRAL_DIRECTORY_FILE_HEADER_FORMAT CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+ END_OF_CENTRAL_DIRECTORY_SIGNATURE
+ END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING END_OF_CENTRAL_DIRECTORY_FORMAT
+ END_OF_CENTRAL_DIRECTORY_LENGTH );
+
+ my @UtilityMethodNames = qw( _error _ioError _formatError
+ _subclassResponsibility _binmode _isSeekable _newFileHandle);
+
+ @EXPORT_OK = ( 'computeCRC32' );
+ %EXPORT_TAGS = ( 'CONSTANTS' => \@ConstantNames,
+ 'MISC_CONSTANTS' => \@MiscConstantNames,
+ 'ERROR_CODES' => \@ErrorCodeNames,
+ # The following two sets are for internal use only
+ 'PKZIP_CONSTANTS' => \@PKZipConstantNames,
+ 'UTILITY_METHODS' => \@UtilityMethodNames );
+
+ # Add all the constant names and error code names to @EXPORT_OK
+ Exporter::export_ok_tags( 'CONSTANTS', 'ERROR_CODES',
+ 'PKZIP_CONSTANTS', 'UTILITY_METHODS', 'MISC_CONSTANTS' );
+}
+
+# ------------------------- begin exportable error codes -------------------
+
+=head1 ERROR CODES
+
+Many of the methods in Archive::Zip return error codes.
+These are implemented as inline subroutines, using the C<use constant> pragma.
+They can be imported into your namespace using the C<:CONSTANT>
+tag:
+
+ use Archive::Zip qw( :CONSTANTS );
+ ...
+ die "whoops!" if $zip->read( 'myfile.zip' ) != AZ_OK;
+
+=over 4
+
+=item AZ_OK (0)
+
+Everything is fine.
+
+=item AZ_STREAM_END (1)
+
+The read stream (or central directory) ended normally.
+
+=item AZ_ERROR (2)
+
+There was some generic kind of error.
+
+=item AZ_FORMAT_ERROR (3)
+
+There is a format error in a ZIP file being read.
+
+=item AZ_IO_ERROR (4)
+
+There was an IO error.
+
+=back
+
+=cut
+
+use constant AZ_OK => 0;
+use constant AZ_STREAM_END => 1;
+use constant AZ_ERROR => 2;
+use constant AZ_FORMAT_ERROR => 3;
+use constant AZ_IO_ERROR => 4;
+
+# ------------------------- end exportable error codes ---------------------
+# ------------------------- begin exportable constants ---------------------
+
+# File types
+# Values of Archive::Zip::Member->fileAttributeFormat()
+
+use constant FA_MSDOS => 0;
+use constant FA_UNIX => 3;
+
+# general-purpose bit flag masks
+# Found in Archive::Zip::Member->bitFlag()
+
+use constant GPBF_ENCRYPTED_MASK => 1 << 0;
+use constant GPBF_DEFLATING_COMPRESSION_MASK => 3 << 1;
+use constant GPBF_HAS_DATA_DESCRIPTOR_MASK => 1 << 3;
+
+# deflating compression types, if compressionMethod == COMPRESSION_DEFLATED
+# ( Archive::Zip::Member->bitFlag() & GPBF_DEFLATING_COMPRESSION_MASK )
+
+use constant DEFLATING_COMPRESSION_NORMAL => 0 << 1;
+use constant DEFLATING_COMPRESSION_MAXIMUM => 1 << 1;
+use constant DEFLATING_COMPRESSION_FAST => 2 << 1;
+use constant DEFLATING_COMPRESSION_SUPER_FAST => 3 << 1;
+
+# compression method
+
+=head1 COMPRESSION
+
+Archive::Zip allows each member of a ZIP file to be compressed (using
+the Deflate algorithm) or uncompressed. Other compression algorithms
+that some versions of ZIP have been able to produce are not supported.
+
+Each member has two compression methods: the one it's stored as (this
+is always COMPRESSION_STORED for string and external file members),
+and the one you desire for the member in the zip file.
+These can be different, of course, so you can make a zip member that
+is not compressed out of one that is, and vice versa.
+You can inquire about the current compression and set
+the desired compression method:
+
+ my $member = $zip->memberNamed( 'xyz.txt' );
+ $member->compressionMethod(); # return current compression
+ # set to read uncompressed
+ $member->desiredCompressionMethod( COMPRESSION_STORED );
+ # set to read compressed
+ $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
+
+There are two different compression methods:
+
+=over 4
+
+=item COMPRESSION_STORED
+
+file is stored (no compression)
+
+=item COMPRESSION_DEFLATED
+
+file is Deflated
+
+=back
+
+=head2 Compression Levels
+
+If a member's desiredCompressionMethod is COMPRESSION_DEFLATED,
+you can choose different compression levels. This choice may
+affect the speed of compression and decompression, as well as
+the size of the compressed member data.
+
+ $member->desiredCompressionLevel( 9 );
+
+The levels given can be:
+
+=over 4
+
+=item 0 or COMPRESSION_LEVEL_NONE
+
+This is the same as saying
+
+ $member->desiredCompressionMethod( COMPRESSION_STORED );
+
+=item 1 .. 9
+
+1 gives the best speed and worst compression, and 9 gives the best
+compression and worst speed.
+
+=item COMPRESSION_LEVEL_FASTEST
+
+This is a synonym for level 1.
+
+=item COMPRESSION_LEVEL_BEST_COMPRESSION
+
+This is a synonym for level 9.
+
+=item COMPRESSION_LEVEL_DEFAULT
+
+This gives a good compromise between speed and compression, and is
+currently equivalent to 6 (this is in the zlib code).
+
+This is the level that will be used if not specified.
+
+=back
+
+=cut
+
+# these two are the only ones supported in this module
+use constant COMPRESSION_STORED => 0; # file is stored (no compression)
+use constant COMPRESSION_DEFLATED => 8; # file is Deflated
+
+use constant COMPRESSION_LEVEL_NONE => 0;
+use constant COMPRESSION_LEVEL_DEFAULT => -1;
+use constant COMPRESSION_LEVEL_FASTEST => 1;
+use constant COMPRESSION_LEVEL_BEST_COMPRESSION => 9;
+
+# internal file attribute bits
+# Found in Archive::Zip::Member::internalFileAttributes()
+
+use constant IFA_TEXT_FILE_MASK => 1;
+use constant IFA_TEXT_FILE => 1; # file is apparently text
+use constant IFA_BINARY_FILE => 0;
+
+# PKZIP file format miscellaneous constants (for internal use only)
+use constant SIGNATURE_FORMAT => "V";
+use constant SIGNATURE_LENGTH => 4;
+
+use constant LOCAL_FILE_HEADER_SIGNATURE => 0x04034b50;
+use constant LOCAL_FILE_HEADER_FORMAT => "v3 V4 v2";
+use constant LOCAL_FILE_HEADER_LENGTH => 26;
+
+use constant DATA_DESCRIPTOR_FORMAT => "V3";
+use constant DATA_DESCRIPTOR_LENGTH => 12;
+
+use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE => 0x02014b50;
+use constant CENTRAL_DIRECTORY_FILE_HEADER_FORMAT => "C2 v3 V4 v5 V2";
+use constant CENTRAL_DIRECTORY_FILE_HEADER_LENGTH => 42;
+
+use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE => 0x06054b50;
+use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING => pack( "V",
+ END_OF_CENTRAL_DIRECTORY_SIGNATURE );
+use constant END_OF_CENTRAL_DIRECTORY_FORMAT => "v4 V2 v";
+use constant END_OF_CENTRAL_DIRECTORY_LENGTH => 18;
+
+use constant FA_AMIGA => 1;
+use constant FA_VAX_VMS => 2;
+use constant FA_VM_CMS => 4;
+use constant FA_ATARI_ST => 5;
+use constant FA_OS2_HPFS => 6;
+use constant FA_MACINTOSH => 7;
+use constant FA_Z_SYSTEM => 8;
+use constant FA_CPM => 9;
+use constant FA_WINDOWS_NTFS => 10;
+
+use constant GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK => 1 << 1;
+use constant GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK => 1 << 2;
+use constant GPBF_IS_COMPRESSED_PATCHED_DATA_MASK => 1 << 5;
+
+# the rest of these are not supported in this module
+use constant COMPRESSION_SHRUNK => 1; # file is Shrunk
+use constant COMPRESSION_REDUCED_1 => 2;# file is Reduced CF=1
+use constant COMPRESSION_REDUCED_2 => 3;# file is Reduced CF=2
+use constant COMPRESSION_REDUCED_3 => 4;# file is Reduced CF=3
+use constant COMPRESSION_REDUCED_4 => 5;# file is Reduced CF=4
+use constant COMPRESSION_IMPLODED => 6; # file is Imploded
+use constant COMPRESSION_TOKENIZED => 7;# reserved for Tokenizing compr.
+use constant COMPRESSION_DEFLATED_ENHANCED => 9; # reserved for enh. Deflating
+use constant COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED => 10;
+
+# ------------------------- end of exportable constants ---------------------
+
+=head1 Archive::Zip methods
+
+The Archive::Zip class (and its invisible subclass Archive::Zip::Archive)
+implement generic zip file functionality.
+
+Creating a new Archive::Zip object actually makes an Archive::Zip::Archive
+object, but you don't have to worry about this unless you're subclassing.
+
+=cut
+
+=head2 Constructor
+
+=over 4
+
+=cut
+
+use constant ZIPARCHIVECLASS => 'Archive::Zip::Archive';
+use constant ZIPMEMBERCLASS => 'Archive::Zip::Member';
+
+#--------------------------------
+
+=item new( [$fileName] )
+
+Make a new, empty zip archive.
+
+ my $zip = Archive::Zip->new();
+
+If an additional argument is passed, new() will call read() to read the
+contents of an archive:
+
+ my $zip = Archive::Zip->new( 'xyz.zip' );
+
+If a filename argument is passed and the read fails for any reason, new
+will return undef. For this reason, it may be better to call read
+separately.
+
+=cut
+
+sub new # Archive::Zip
+{
+ my $class = shift;
+ return $class->ZIPARCHIVECLASS->new( @_ );
+}
+
+=back
+
+=head2 Utility Methods
+
+These Archive::Zip methods may be called as functions or as object
+methods. Do not call them as class methods:
+
+ $zip = Archive::Zip->new();
+ $crc = Archive::Zip::computeCRC32( 'ghijkl' ); # OK
+ $crc = $zip->computeCRC32( 'ghijkl' ); # also OK
+
+ $crc = Archive::Zip->computeCRC32( 'ghijkl' ); # NOT OK
+
+=over 4
+
+=cut
+
+#--------------------------------
+
+=item Archive::Zip::computeCRC32( $string [, $crc] )
+
+This is a utility function that uses the Compress::Zlib CRC
+routine to compute a CRC-32.
+
+You can get the CRC of a string:
+
+ $crc = Archive::Zip::computeCRC32( $string );
+
+Or you can compute the running CRC:
+
+ $crc = 0;
+ $crc = Archive::Zip::computeCRC32( 'abcdef', $crc );
+ $crc = Archive::Zip::computeCRC32( 'ghijkl', $crc );
+
+=cut
+
+sub computeCRC32 # Archive::Zip
+{
+ my $data = shift;
+ $data = shift if ref( $data ); # allow calling as an obj method
+ my $crc = shift;
+ return Compress::Zlib::crc32( $data, $crc );
+}
+
+#--------------------------------
+
+=item Archive::Zip::setChunkSize( $number )
+
+Change chunk size used for reading and writing.
+Currently, this defaults to 32K.
+This is not exportable, so you must call it like:
+
+ Archive::Zip::setChunkSize( 4096 );
+
+or as a method on a zip (though this is a global setting).
+Returns old chunk size.
+
+=cut
+
+sub setChunkSize # Archive::Zip
+{
+ my $chunkSize = shift;
+ $chunkSize = shift if ref( $chunkSize ); # object method on zip?
+ my $oldChunkSize = $Archive::Zip::ChunkSize;
+ $Archive::Zip::ChunkSize = $chunkSize;
+ return $oldChunkSize;
+}
+
+#--------------------------------
+
+=item Archive::Zip::setErrorHandler( \&subroutine )
+
+Change the subroutine called with error strings.
+This defaults to \&Carp::carp, but you may want to change
+it to get the error strings.
+
+This is not exportable, so you must call it like:
+
+ Archive::Zip::setErrorHandler( \&myErrorHandler );
+
+If no error handler is passed, resets handler to default.
+
+Returns old error handler.
+
+Note that if you call Carp::carp or a similar routine
+or if you're chaining to the default error handler
+from your error handler, you may want to increment the number
+of caller levels that are skipped (do not just set it to a number):
+
+ $Carp::CarpLevel++;
+
+=cut
+
+sub setErrorHandler (&) # Archive::Zip
+{
+ my $errorHandler = shift;
+ $errorHandler = \&Carp::carp if ! defined( $errorHandler );
+ my $oldErrorHandler = $Archive::Zip::ErrorHandler;
+ $Archive::Zip::ErrorHandler = $errorHandler;
+ return $oldErrorHandler;
+}
+
+sub _printError # Archive::Zip
+{
+ my $string = join( ' ', @_, "\n" );
+ my $oldCarpLevel = $Carp::CarpLevel;
+ $Carp::CarpLevel += 2;
+ &{ $ErrorHandler }( $string );
+ $Carp::CarpLevel = $oldCarpLevel;
+}
+
+# This is called on format errors.
+sub _formatError # Archive::Zip
+{
+ shift if ref( $_[0] );
+ _printError( 'format error:', @_ );
+ return AZ_FORMAT_ERROR;
+}
+
+# This is called on IO errors.
+sub _ioError # Archive::Zip
+{
+ shift if ref( $_[0] );
+ _printError( 'IO error:', @_, ':', $! );
+ return AZ_IO_ERROR;
+}
+
+# This is called on generic errors.
+sub _error # Archive::Zip
+{
+ shift if ref( $_[0] );
+ _printError( 'error:', @_ );
+ return AZ_ERROR;
+}
+
+# Called when a subclass should have implemented
+# something but didn't
+sub _subclassResponsibility # Archive::Zip
+{
+ Carp::croak( "subclass Responsibility\n" );
+}
+
+# Try to set the given file handle or object into binary mode.
+sub _binmode # Archive::Zip
+{
+ my $fh = shift;
+ return $fh->can( 'binmode' )
+ ? $fh->binmode()
+ : binmode( $fh );
+}
+
+# Attempt to guess whether file handle is seekable.
+sub _isSeekable # Archive::Zip
+{
+ my $fh = shift;
+ my ($p0, $p1);
+ my $seekable =
+ ( $p0 = $fh->tell() ) >= 0
+ && $fh->seek( 1, IO::Seekable::SEEK_CUR )
+ && ( $p1 = $fh->tell() ) >= 0
+ && $p1 == $p0 + 1
+ && $fh->seek( -1, IO::Seekable::SEEK_CUR )
+ && $fh->tell() == $p0;
+ return $seekable;
+}
+
+# Return an opened IO::Handle
+# my ( $status, fh ) = _newFileHandle( 'fileName', 'w' );
+# Can take a filename, file handle, or ref to GLOB
+# Or, if given something that is a ref but not an IO::Handle,
+# passes back the same thing.
+sub _newFileHandle # Archive::Zip
+{
+ my $fd = shift;
+ my $status = 1;
+ my $handle = IO::File->new();
+
+ if ( ref( $fd ) )
+ {
+ if ( $fd->isa( 'IO::Handle' ) or $fd->isa( 'GLOB' ) )
+ {
+ $status = $handle->fdopen( $fd, @_ );
+ }
+ else
+ {
+ $handle = $fd;
+ }
+ }
+ else
+ {
+ $status = $handle->open( $fd, @_ );
+ }
+
+ return ( $status, $handle );
+}
+
+=back
+
+=cut
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::Archive (concrete)
+# Generic ZIP archive.
+# ----------------------------------------------------------------------
+package Archive::Zip::Archive;
+use File::Path;
+use File::Basename;
+
+use vars qw( @ISA );
+@ISA = qw( Archive::Zip );
+
+BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
+ :UTILITY_METHODS ) }
+
+#--------------------------------
+# Note that this returns undef on read errors, else new zip object.
+
+sub new # Archive::Zip::Archive
+{
+ my $class = shift;
+ my $self = bless( {
+ 'diskNumber' => 0,
+ 'diskNumberWithStartOfCentralDirectory' => 0,
+ 'numberOfCentralDirectoriesOnThisDisk' => 0, # shld be # of members
+ 'numberOfCentralDirectories' => 0, # shld be # of members
+ 'centralDirectorySize' => 0, # must re-compute on write
+ 'centralDirectoryOffsetWRTStartingDiskNumber' => 0, # must re-compute
+ 'zipfileComment' => ''
+ }, $class );
+ $self->{'members'} = [];
+ if ( @_ )
+ {
+ my $status = $self->read( @_ );
+ return $status == AZ_OK ? $self : undef;
+ }
+ return $self;
+}
+
+=head2 Accessors
+
+=over 4
+
+=cut
+
+#--------------------------------
+
+=item members()
+
+Return a copy of my members array
+
+ my @members = $zip->members();
+
+=cut
+
+sub members # Archive::Zip::Archive
+{ @{ shift->{'members'} } }
+
+#--------------------------------
+
+=item numberOfMembers()
+
+Return the number of members I have
+
+=cut
+
+sub numberOfMembers # Archive::Zip::Archive
+{ scalar( shift->members() ) }
+
+#--------------------------------
+
+=item memberNames()
+
+Return a list of the (internal) file names of my members
+
+=cut
+
+sub memberNames # Archive::Zip::Archive
+{
+ my $self = shift;
+ return map { $_->fileName() } $self->members();
+}
+
+#--------------------------------
+
+=item memberNamed( $string )
+
+Return ref to member whose filename equals given filename or undef
+
+=cut
+
+sub memberNamed # Archive::Zip::Archive
+{
+ my ( $self, $fileName ) = @_;
+ my ( $retval ) = grep { $_->fileName() eq $fileName } $self->members();
+ return $retval;
+}
+
+#--------------------------------
+
+=item membersMatching( $regex )
+
+Return array of members whose filenames match given regular
+expression in list context.
+Returns number of matching members in scalar context.
+
+ my @textFileMembers = $zip->membersMatching( '.*\.txt' );
+ # or
+ my $numberOfTextFiles = $zip->membersMatching( '.*\.txt' );
+
+=cut
+
+sub membersMatching # Archive::Zip::Archive
+{
+ my ( $self, $pattern ) = @_;
+ return grep { $_->fileName() =~ /$pattern/ } $self->members();
+}
+
+#--------------------------------
+
+=item diskNumber()
+
+Return the disk that I start on.
+Not used for writing zips, but might be interesting if you read a zip in.
+This had better be 0, as Archive::Zip does not handle multi-volume archives.
+
+=cut
+
+sub diskNumber # Archive::Zip::Archive
+{ shift->{'diskNumber'} }
+
+#--------------------------------
+
+=item diskNumberWithStartOfCentralDirectory()
+
+Return the disk number that holds the beginning of the central directory.
+Not used for writing zips, but might be interesting if you read a zip in.
+This had better be 0, as Archive::Zip does not handle multi-volume archives.
+
+=cut
+
+sub diskNumberWithStartOfCentralDirectory # Archive::Zip::Archive
+{ shift->{'diskNumberWithStartOfCentralDirectory'} }
+
+#--------------------------------
+
+=item numberOfCentralDirectoriesOnThisDisk()
+
+Return the number of CD structures on this disk.
+Not used for writing zips, but might be interesting if you read a zip in.
+
+=cut
+
+sub numberOfCentralDirectoriesOnThisDisk # Archive::Zip::Archive
+{ shift->{'numberOfCentralDirectoriesOnThisDisk'} }
+
+#--------------------------------
+
+=item numberOfCentralDirectories()
+
+Return the number of CD structures in the whole zip.
+Not used for writing zips, but might be interesting if you read a zip in.
+
+=cut
+
+sub numberOfCentralDirectories # Archive::Zip::Archive
+{ shift->{'numberOfCentralDirectories'} }
+
+#--------------------------------
+
+=item centralDirectorySize()
+
+Returns central directory size, as read from an external zip file.
+Not used for writing zips, but might be interesting if you read a zip in.
+
+=cut
+
+sub centralDirectorySize # Archive::Zip::Archive
+{ shift->{'centralDirectorySize'} }
+
+#--------------------------------
+
+=item centralDirectoryOffsetWRTStartingDiskNumber()
+
+Returns the offset into the zip file where the CD begins.
+Not used for writing zips, but might be interesting if you read a zip in.
+
+=cut
+
+sub centralDirectoryOffsetWRTStartingDiskNumber # Archive::Zip::Archive
+{ shift->{'centralDirectoryOffsetWRTStartingDiskNumber'} }
+
+#--------------------------------
+
+=item zipfileComment( [$string] )
+
+Get or set the zipfile comment.
+Returns the old comment.
+
+ print $zip->zipfileComment();
+ $zip->zipfileComment( 'New Comment' );
+
+=cut
+
+sub zipfileComment # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $comment = $self->{'zipfileComment'};
+ if ( @_ )
+ {
+ $self->{'zipfileComment'} = shift;
+ }
+ return $comment;
+}
+
+=back
+
+=head2 Member Operations
+
+Various operations on a zip file modify members.
+When a member is passed as an argument, you can either use a reference
+to the member itself, or the name of a member. Of course, using the
+name requires that names be unique within a zip (this is not enforced).
+
+=over 4
+
+=cut
+
+#--------------------------------
+
+=item removeMember( $memberOrName )
+
+Remove and return the given member, or match its name and remove it.
+Returns undef if member name doesn't exist in this Zip.
+No-op if member does not belong to this zip.
+
+=cut
+
+sub removeMember # Archive::Zip::Archive
+{
+ my ( $self, $member ) = @_;
+ $member = $self->memberNamed( $member ) if ! ref( $member );
+ return undef if ! $member;
+ my @newMembers = grep { $_ != $member } $self->members();
+ $self->{'members'} = \@newMembers;
+ return $member;
+}
+
+#--------------------------------
+
+=item replaceMember( $memberOrName, $newMember )
+
+Remove and return the given member, or match its name and remove it.
+Replace with new member.
+Returns undef if member name doesn't exist in this Zip.
+
+ my $member1 = $zip->removeMember( 'xyz' );
+ my $member2 = $zip->replaceMember( 'abc', $member1 );
+ # now, $member2 (named 'abc') is not in $zip,
+ # and $member1 (named 'xyz') is, having taken $member2's place.
+
+=cut
+
+sub replaceMember # Archive::Zip::Archive
+{
+ my ( $self, $oldMember, $newMember ) = @_;
+ $oldMember = $self->memberNamed( $oldMember ) if ! ref( $oldMember );
+ return undef if ! $oldMember;
+ my @newMembers
+ = map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
+ $self->{'members'} = \@newMembers;
+ return $oldMember;
+}
+
+#--------------------------------
+
+=item extractMember( $memberOrName [, $extractedName ] )
+
+Extract the given member, or match its name and extract it.
+Returns undef if member doesn't exist in this Zip.
+If optional second arg is given, use it as the name of the
+extracted member. Otherwise, the internal filename of the member is used
+as the name of the extracted file or directory.
+
+All necessary directories will be created.
+
+Returns C<AZ_OK> on success.
+
+=cut
+
+sub extractMember # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $member = shift;
+ $member = $self->memberNamed( $member ) if ! ref( $member );
+ return _error( 'member not found' ) if !$member;
+ my $name = shift;
+ $name = $member->fileName() if not $name;
+ my $dirName = dirname( $name );
+ mkpath( $dirName ) if ( ! -d $dirName );
+ return _ioError( "can't create dir $dirName" ) if ( ! -d $dirName );
+ return $member->extractToFileNamed( $name, @_ );
+}
+
+#--------------------------------
+
+=item extractMemberWithoutPaths( $memberOrName [, $extractedName ] )
+
+Extract the given member, or match its name and extract it.
+Does not use path information (extracts into the current directory).
+Returns undef if member doesn't exist in this Zip.
+If optional second arg is given, use it as the name of the
+extracted member (its paths will be deleted too).
+Otherwise, the internal filename of the member (minus paths) is used
+as the name of the extracted file or directory.
+
+Returns C<AZ_OK> on success.
+
+=cut
+
+sub extractMemberWithoutPaths # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $member = shift;
+ $member = $self->memberNamed( $member ) if ! ref( $member );
+ return _error( 'member not found' ) if !$member;
+ my $name = shift;
+ $name = $member->fileName() if not $name;
+ $name = basename( $name );
+ return $member->extractToFileNamed( $name, @_ );
+}
+
+#--------------------------------
+
+=item addMember( $member )
+
+Append a member (possibly from another zip file) to the zip file.
+Returns the new member.
+Generally, you will use addFile(), addDirectory(), addString(), or read()
+to add members.
+
+ # Move member named 'abc' to end of zip:
+ my $member = $zip->removeMember( 'abc' );
+ $zip->addMember( $member );
+
+=cut
+
+sub addMember # Archive::Zip::Archive
+{
+ my ( $self, $newMember ) = @_;
+ push( @{ $self->{'members'} }, $newMember ) if $newMember;
+ return $newMember;
+}
+
+#--------------------------------
+
+=item addFile( $fileName [, $newName ] )
+
+Append a member whose data comes from an external file,
+returning the member or undef.
+The member will have its file name set to the name of the external
+file, and its desiredCompressionMethod set to COMPRESSION_DEFLATED.
+The file attributes and last modification time will be set from the file.
+
+If the name given does not represent a readable plain file or symbolic link,
+undef will be returned.
+
+The text mode bit will be set if the contents appears to be text (as returned
+by the C<-T> perl operator).
+
+The optional second argument sets the internal file name to
+something different than the given $fileName.
+
+=cut
+
+sub addFile # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fileName = shift;
+ my $newName = shift;
+ my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName );
+ if (defined($newMember))
+ {
+ $self->addMember( $newMember );
+ $newMember->fileName( $newName ) if defined( $newName );
+ }
+ return $newMember;
+}
+
+#--------------------------------
+
+=item addString( $stringOrStringRef [, $name] )
+
+Append a member created from the given string or string reference.
+The name is given by the optional second argument.
+Returns the new member.
+
+The last modification time will be set to now,
+and the file attributes will be set to permissive defaults.
+
+ my $member = $zip->addString( 'This is a test', 'test.txt' );
+
+=cut
+
+sub addString # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $newMember = $self->ZIPMEMBERCLASS->newFromString( @_ );
+ return $self->addMember( $newMember );
+}
+
+#--------------------------------
+
+=item addDirectory( $directoryName [, $fileName ] )
+
+Append a member created from the given directory name.
+The directory name does not have to name an existing directory.
+If the named directory exists, the file modification time and permissions
+are set from the existing directory, otherwise they are set to now and
+permissive default permissions.
+The optional second argument sets the name of the archive member
+(which defaults to $directoryName)
+
+Returns the new member.
+
+=cut
+
+sub addDirectory # Archive::Zip::Archive
+{
+ my ( $self, $name, $newName ) = @_;
+ my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name );
+ $self->addMember( $newMember );
+ $newMember->fileName( $newName ) if defined( $newName );
+ return $newMember;
+}
+
+#--------------------------------
+
+=item contents( $memberOrMemberName [, $newContents ] )
+
+Returns the uncompressed data for a particular member, or undef.
+
+ print "xyz.txt contains " . $zip->contents( 'xyz.txt' );
+
+Also can change the contents of a member:
+
+ $zip->contents( 'xyz.txt', 'This is the new contents' );
+
+=cut
+
+sub contents # Archive::Zip::Archive
+{
+ my ( $self, $member, $newContents ) = @_;
+ $member = $self->memberNamed( $member ) if ! ref( $member );
+ return undef if ! $member;
+ return $member->contents( $newContents );
+}
+
+#--------------------------------
+
+=item writeToFileNamed( $fileName )
+
+Write a zip archive to named file.
+Returns C<AZ_OK> on success.
+
+Note that if you use the same name as an existing
+zip file that you read in, you will clobber ZipFileMembers.
+So instead, write to a different file name, then delete
+the original.
+
+ my $status = $zip->writeToFileNamed( 'xx.zip' );
+ die "error somewhere" if $status != AZ_OK;
+
+=cut
+
+sub writeToFileNamed # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fileName = shift;
+ foreach my $member ( $self->members() )
+ {
+ if ( $member->_usesFileNamed( $fileName ) )
+ {
+ return _error("$fileName is needed by member "
+ . $member->fileName()
+ . "; try renaming output file");
+ }
+ }
+ my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
+ return _ioError( "Can't open $fileName for write" ) if !$status;
+ my $retval = $self->writeToFileHandle( $fh, 1 );
+ $fh->close();
+ return $retval;
+}
+
+#--------------------------------
+
+=item writeToFileHandle( $fileHandle [, $seekable] )
+
+Write a zip archive to a file handle.
+Return AZ_OK on success.
+
+The optional second arg tells whether or not to try to seek backwards
+to re-write headers.
+If not provided, it is set by testing seekability. This could fail
+on some operating systems, though.
+
+ my $fh = IO::File->new( 'someFile.zip', 'w' );
+ $zip->writeToFileHandle( $fh );
+
+If you pass a file handle that is not seekable (like if you're writing
+to a pipe or a socket), pass a false as the second argument:
+
+ my $fh = IO::File->new( '| cat > somefile.zip', 'w' );
+ $zip->writeToFileHandle( $fh, 0 ); # fh is not seekable
+
+=cut
+
+sub writeToFileHandle # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fh = shift;
+ my $fhIsSeekable = @_ ? shift : _isSeekable( $fh );
+ _binmode( $fh );
+
+ my $offset = 0;
+ foreach my $member ( $self->members() )
+ {
+ $member->{'writeLocalHeaderRelativeOffset'} = $offset;
+ my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable );
+ $member->endRead();
+ return $retval if $retval != AZ_OK;
+ $offset += $member->_localHeaderSize() + $member->_writeOffset();
+ $offset += $member->hasDataDescriptor() ? DATA_DESCRIPTOR_LENGTH : 0;
+ }
+ $self->{'writeCentralDirectoryOffset'} = $offset;
+ return $self->_writeCentralDirectory( $fh );
+}
+
+# Returns next signature from given file handle, leaves
+# file handle positioned afterwards.
+# In list context, returns ($status, $signature)
+
+sub _readSignature # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fh = shift;
+ my $fileName = shift;
+ my $signatureData;
+ $fh->read( $signatureData, SIGNATURE_LENGTH )
+ or return _ioError( "reading header signature" );
+ my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
+ my $status = AZ_OK;
+ if ( $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
+ and $signature != LOCAL_FILE_HEADER_SIGNATURE
+ and $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE )
+ {
+ $status = _formatError(
+ sprintf( "bad signature: 0x%08x at offset %d in file \"%s\"",
+ $signature, $fh->tell() - SIGNATURE_LENGTH, $fileName ) );
+ }
+
+ return ( $status, $signature );
+}
+
+# Used only during writing
+sub _writeCentralDirectoryOffset # Archive::Zip::Archive
+{ shift->{'writeCentralDirectoryOffset'} }
+
+sub _writeEOCDOffset # Archive::Zip::Archive
+{ shift->{'writeEOCDOffset'} }
+
+# Expects to have _writeEOCDOffset() set
+sub _writeEndOfCentralDirectory # Archive::Zip::Archive
+{
+ my ( $self, $fh ) = @_;
+
+ $fh->write( END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING, SIGNATURE_LENGTH )
+ or return _ioError( 'writing EOCD Signature' );
+
+ my $header = pack( END_OF_CENTRAL_DIRECTORY_FORMAT,
+ 0, # {'diskNumber'},
+ 0, # {'diskNumberWithStartOfCentralDirectory'},
+ $self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'},
+ $self->numberOfMembers(), # {'numberOfCentralDirectories'},
+ $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
+ $self->_writeCentralDirectoryOffset(),
+ length( $self->zipfileComment() )
+ );
+ $fh->write( $header, END_OF_CENTRAL_DIRECTORY_LENGTH )
+ or return _ioError( 'writing EOCD header' );
+ if ( length( $self->zipfileComment() ))
+ {
+ $fh->write( $self->zipfileComment(), length( $self->zipfileComment() ))
+ or return _ioError( 'writing zipfile comment' );
+ }
+ return AZ_OK;
+}
+
+sub _writeCentralDirectory # Archive::Zip::Archive
+{
+ my ( $self, $fh ) = @_;
+
+ my $offset = $self->_writeCentralDirectoryOffset();
+ foreach my $member ( $self->members() )
+ {
+ my $status = $member->_writeCentralDirectoryFileHeader( $fh );
+ return $status if $status != AZ_OK;
+ $offset += $member->_centralDirectoryHeaderSize();
+ }
+ $self->{'writeEOCDOffset'} = $offset;
+ return $self->_writeEndOfCentralDirectory( $fh );
+}
+
+#--------------------------------
+
+=item read( $fileName )
+
+Read zipfile headers from a zip file, appending new members.
+Returns C<AZ_OK> or error code.
+
+ my $zipFile = Archive::Zip->new();
+ my $status = $zipFile->read( '/some/FileName.zip' );
+
+=cut
+
+sub read # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fileName = shift;
+ return _error( 'No filename given' ) if ! $fileName;
+ my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
+ return _ioError( "opening $fileName for read" ) if !$status;
+ _binmode( $fh );
+
+ $status = $self->_findEndOfCentralDirectory( $fh );
+ return $status if $status != AZ_OK;
+
+ my $eocdPosition = $fh->tell();
+
+ $status = $self->_readEndOfCentralDirectory( $fh );
+ return $status if $status != AZ_OK;
+
+ $fh->seek( $eocdPosition - $self->centralDirectorySize(),
+ IO::Seekable::SEEK_SET )
+ or return _ioError( "Can't seek $fileName" );
+
+ for ( ;; )
+ {
+ my $newMember =
+ $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName );
+ my $signature;
+ ( $status, $signature ) = $self->_readSignature( $fh, $fileName );
+ return $status if $status != AZ_OK;
+ last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
+ $status = $newMember->_readCentralDirectoryFileHeader();
+ return $status if $status != AZ_OK;
+ $status = $newMember->endRead();
+ return $status if $status != AZ_OK;
+ $newMember->_becomeDirectoryIfNecessary();
+ push( @{ $self->{'members'} }, $newMember );
+ }
+
+ $fh->close();
+ return AZ_OK;
+}
+
+# Read EOCD, starting from position before signature.
+# Return AZ_OK on success.
+sub _readEndOfCentralDirectory # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fh = shift;
+
+ # Skip past signature
+ $fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
+ or return _ioError( "Can't seek past EOCD signature" );
+
+ my $header = '';
+ $fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH )
+ or return _ioError( "reading end of central directory" );
+
+ my $zipfileCommentLength;
+ (
+ $self->{'diskNumber'},
+ $self->{'diskNumberWithStartOfCentralDirectory'},
+ $self->{'numberOfCentralDirectoriesOnThisDisk'},
+ $self->{'numberOfCentralDirectories'},
+ $self->{'centralDirectorySize'},
+ $self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
+ $zipfileCommentLength
+ ) = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
+
+ if ( $zipfileCommentLength )
+ {
+ my $zipfileComment = '';
+ $fh->read( $zipfileComment, $zipfileCommentLength )
+ or return _ioError( "reading zipfile comment" );
+ $self->{'zipfileComment'} = $zipfileComment;
+ }
+
+ return AZ_OK;
+}
+
+# Seek in my file to the end, then read backwards until we find the
+# signature of the central directory record. Leave the file positioned right
+# before the signature. Returns AZ_OK if success.
+sub _findEndOfCentralDirectory # Archive::Zip::Archive
+{
+ my $self = shift;
+ my $fh = shift;
+ my $data = '';
+ $fh->seek( 0, IO::Seekable::SEEK_END )
+ or return _ioError( "seeking to end" );
+
+ my $fileLength = $fh->tell();
+ if ( $fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4 )
+ {
+ return _formatError( "file is too short" )
+ }
+
+ my $seekOffset = 0;
+ my $pos = -1;
+ for ( ;; )
+ {
+ $seekOffset += 512;
+ $seekOffset = $fileLength if ( $seekOffset > $fileLength );
+ $fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
+ or return _ioError( "seek failed" );
+ $fh->read( $data, $seekOffset )
+ or return _ioError( "read failed" );
+ $pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
+ last if ( $pos > 0
+ or $seekOffset == $fileLength
+ or $seekOffset >= $Archive::Zip::ChunkSize );
+ }
+
+ if ( $pos >= 0 )
+ {
+ $fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
+ or return _ioError( "seeking to EOCD" );
+ return AZ_OK;
+ }
+ else
+ {
+ return _formatError( "can't find EOCD signature" );
+ }
+}
+
+=back
+
+=head1 MEMBER OPERATIONS
+
+=head2 Class Methods
+
+Several constructors allow you to construct members without adding
+them to a zip archive.
+
+These work the same as the addFile(), addDirectory(), and addString()
+zip instance methods described above, but they don't add the new members
+to a zip.
+
+=over 4
+
+=cut
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::Member
+# A generic member of an archive ( abstract )
+# ----------------------------------------------------------------------
+package Archive::Zip::Member;
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip );
+
+BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
+ :UTILITY_METHODS ) }
+
+use Time::Local ();
+use Compress::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
+use File::Path;
+use File::Basename;
+
+use constant ZIPFILEMEMBERCLASS => 'Archive::Zip::ZipFileMember';
+use constant NEWFILEMEMBERCLASS => 'Archive::Zip::NewFileMember';
+use constant STRINGMEMBERCLASS => 'Archive::Zip::StringMember';
+use constant DIRECTORYMEMBERCLASS => 'Archive::Zip::DirectoryMember';
+
+# Unix perms for default creation of files/dirs.
+use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
+use constant DEFAULT_FILE_PERMISSIONS => 0100666;
+use constant DIRECTORY_ATTRIB => 040000;
+use constant FILE_ATTRIB => 0100000;
+
+# Returns self if successful, else undef
+# Assumes that fh is positioned at beginning of central directory file header.
+# Leaves fh positioned immediately after file header or EOCD signature.
+sub _newFromZipFile # Archive::Zip::Member
+{
+ my $class = shift;
+ my $self = $class->ZIPFILEMEMBERCLASS->_newFromZipFile( @_ );
+ return $self;
+}
+
+#--------------------------------
+
+=item Archive::Zip::Member->newFromString( $stringOrStringRef [, $fileName] )
+
+Construct a new member from the given string. Returns undef on error.
+
+ my $member = Archive::Zip::Member->newFromString( 'This is a test',
+ 'xyz.txt' );
+
+=cut
+
+sub newFromString # Archive::Zip::Member
+{
+ my $class = shift;
+ my $self = $class->STRINGMEMBERCLASS->_newFromString( @_ );
+ return $self;
+}
+
+#--------------------------------
+
+=item newFromFile( $fileName )
+
+Construct a new member from the given file. Returns undef on error.
+
+ my $member = Archive::Zip::Member->newFromFile( 'xyz.txt' );
+
+=cut
+
+sub newFromFile # Archive::Zip::Member
+{
+ my $class = shift;
+ my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed( @_ );
+ return $self;
+}
+
+#--------------------------------
+
+=item newDirectoryNamed( $directoryName )
+
+Construct a new member from the given directory.
+Returns undef on error.
+
+ my $member = Archive::Zip::Member->newDirectoryNamed( 'CVS/' );
+
+=cut
+
+sub newDirectoryNamed # Archive::Zip::Member
+{
+ my $class = shift;
+ my $self = $class->DIRECTORYMEMBERCLASS->_newNamed( @_ );
+ return $self;
+}
+
+sub new # Archive::Zip::Member
+{
+ my $class = shift;
+ my $self = {
+ 'lastModFileDateTime' => 0,
+ 'fileAttributeFormat' => FA_UNIX,
+ 'versionMadeBy' => 20,
+ 'versionNeededToExtract' => 20,
+ 'bitFlag' => 0,
+ 'compressionMethod' => COMPRESSION_STORED,
+ 'desiredCompressionMethod' => COMPRESSION_STORED,
+ 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE,
+ 'internalFileAttributes' => 0,
+ 'externalFileAttributes' => 0, # set later
+ 'fileName' => '',
+ 'cdExtraField' => '',
+ 'localExtraField' => '',
+ 'fileComment' => '',
+ 'crc32' => 0,
+ 'compressedSize' => 0,
+ 'uncompressedSize' => 0,
+ @_
+ };
+ bless( $self, $class );
+ $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
+ return $self;
+}
+
+sub _becomeDirectoryIfNecessary # Archive::Zip::Member
+{
+ my $self = shift;
+ $self->_become( DIRECTORYMEMBERCLASS )
+ if $self->isDirectory();
+ return $self;
+}
+
+# Morph into given class (do whatever cleanup I need to do)
+sub _become # Archive::Zip::Member
+{
+ return bless( $_[0], $_[1] );
+}
+
+=back
+
+=head2 Simple accessors
+
+These methods get (and/or set) member attribute values.
+
+=over 4
+
+=cut
+
+#--------------------------------
+
+=item versionMadeBy()
+
+Gets the field from my member header.
+
+=cut
+
+sub versionMadeBy # Archive::Zip::Member
+{ shift->{'versionMadeBy'} }
+
+#--------------------------------
+
+=item fileAttributeFormat( [$format] )
+
+Gets or sets the field from the member header.
+These are C<FA_*> values.
+
+=cut
+
+sub fileAttributeFormat # Archive::Zip::Member
+{
+ ( $#_ > 0 ) ? ( $_[0]->{'fileAttributeFormat'} = $_[1] )
+ : $_[0]->{'fileAttributeFormat'}
+}
+
+#--------------------------------
+
+=item versionNeededToExtract()
+
+Gets the field from my member header.
+
+=cut
+
+sub versionNeededToExtract # Archive::Zip::Member
+{ shift->{'versionNeededToExtract'} }
+
+#--------------------------------
+
+=item bitFlag()
+
+Gets the general purpose bit field from my member header.
+This is where the C<GPBF_*> bits live.
+
+=cut
+
+sub bitFlag # Archive::Zip::Member
+{ shift->{'bitFlag'} }
+
+#--------------------------------
+
+=item compressionMethod()
+
+Returns my compression method. This is the method that is
+currently being used to compress my data.
+
+This will be COMPRESSION_STORED for added string or file members,
+or any of the C<COMPRESSION_*> values for members from a zip file.
+However, this module can only handle members whose data is in
+COMPRESSION_STORED or COMPRESSION_DEFLATED format.
+
+=cut
+
+sub compressionMethod # Archive::Zip::Member
+{ shift->{'compressionMethod'} }
+
+#--------------------------------
+
+=item desiredCompressionMethod( [$method] )
+
+Get or set my desiredCompressionMethod
+This is the method that will be used to write.
+Returns prior desiredCompressionMethod.
+
+Only COMPRESSION_DEFLATED or COMPRESSION_STORED are valid arguments.
+
+Changing to COMPRESSION_STORED will change my desiredCompressionLevel
+to 0; changing to COMPRESSION_DEFLATED will change my
+desiredCompressionLevel to COMPRESSION_LEVEL_DEFAULT.
+
+=cut
+
+sub desiredCompressionMethod # Archive::Zip::Member
+{
+ my $self = shift;
+ my $newDesiredCompressionMethod = shift;
+ my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
+ if ( defined( $newDesiredCompressionMethod ))
+ {
+ $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
+ if ( $newDesiredCompressionMethod == COMPRESSION_STORED )
+ {
+ $self->{'desiredCompressionLevel'} = 0;
+ }
+ elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED )
+ {
+ $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
+ }
+ }
+ return $oldDesiredCompressionMethod;
+}
+
+#--------------------------------
+
+=item desiredCompressionLevel( [$method] )
+
+Get or set my desiredCompressionLevel
+This is the method that will be used to write.
+Returns prior desiredCompressionLevel.
+
+Valid arguments are 0 through 9, COMPRESSION_LEVEL_NONE,
+COMPRESSION_LEVEL_DEFAULT, COMPRESSION_LEVEL_BEST_COMPRESSION, and
+COMPRESSION_LEVEL_FASTEST.
+
+0 or COMPRESSION_LEVEL_NONE will change the desiredCompressionMethod
+to COMPRESSION_STORED. All other arguments will change the
+desiredCompressionMethod to COMPRESSION_DEFLATED.
+
+=cut
+
+sub desiredCompressionLevel # Archive::Zip::Member
+{
+ my $self = shift;
+ my $newDesiredCompressionLevel = shift;
+ my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
+ if ( defined( $newDesiredCompressionLevel ))
+ {
+ $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
+ $self->{'desiredCompressionMethod'} = ( $newDesiredCompressionLevel
+ ? COMPRESSION_DEFLATED
+ : COMPRESSION_STORED );
+ }
+ return $oldDesiredCompressionLevel;
+}
+
+#--------------------------------
+
+=item fileName()
+
+Get or set my internal filename.
+Returns the (possibly new) filename.
+
+Names will have backslashes converted to forward slashes,
+and will have multiple consecutive slashes converted to single ones.
+
+=cut
+
+sub fileName # Archive::Zip::Member
+{
+ my $self = shift;
+ my $newName = shift;
+ if ( $newName )
+ {
+ $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems
+ $self->{'fileName'} = $newName;
+ }
+ return $self->{'fileName'}
+}
+
+#--------------------------------
+
+=item lastModFileDateTime()
+
+Return my last modification date/time stamp in MS-DOS format.
+
+=cut
+
+sub lastModFileDateTime # Archive::Zip::Member
+{ shift->{'lastModFileDateTime'} }
+
+#--------------------------------
+
+=item lastModTime()
+
+Return my last modification date/time stamp,
+converted to unix localtime format.
+
+ print "Mod Time: " . scalar( localtime( $member->lastModTime() ) );
+
+=cut
+
+sub lastModTime # Archive::Zip::Member
+{
+ my $self = shift;
+ return _dosToUnixTime( $self->lastModFileDateTime() );
+}
+
+#--------------------------------
+
+=item setLastModFileDateTimeFromUnix()
+
+Set my lastModFileDateTime from the given unix time.
+
+ $member->setLastModFileDateTimeFromUnix( time() );
+
+=cut
+
+sub setLastModFileDateTimeFromUnix # Archive::Zip::Member
+{
+ my $self = shift;
+ my $time_t = shift;
+ $self->{'lastModFileDateTime'} = _unixToDosTime( $time_t );
+}
+
+# Convert DOS date/time format to unix time_t format
+# NOT AN OBJECT METHOD!
+sub _dosToUnixTime # Archive::Zip::Member
+{
+ my $dt = shift;
+
+ my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
+ my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
+ my $mday = ( ( $dt >> 16 ) & 0x1f );
+
+ my $hour = ( ( $dt >> 11 ) & 0x1f );
+ my $min = ( ( $dt >> 5 ) & 0x3f );
+ my $sec = ( ( $dt << 1 ) & 0x3e );
+
+ my $time_t = Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year );
+ return $time_t;
+}
+
+#--------------------------------
+
+=item internalFileAttributes()
+
+Return the internal file attributes field from the zip header.
+This is only set for members read from a zip file.
+
+=cut
+
+sub internalFileAttributes # Archive::Zip::Member
+{ shift->{'internalFileAttributes'} }
+
+#--------------------------------
+
+=item externalFileAttributes()
+
+Return member attributes as read from the ZIP file.
+Note that these are NOT UNIX!
+
+=cut
+
+sub externalFileAttributes # Archive::Zip::Member
+{ shift->{'externalFileAttributes'} }
+
+# Convert UNIX permissions into proper value for zip file
+# NOT A METHOD!
+sub _mapPermissionsFromUnix # Archive::Zip::Member
+{
+ my $perms = shift;
+ return $perms << 16;
+}
+
+# Convert ZIP permissions into Unix ones
+# NOT A METHOD!
+sub _mapPermissionsToUnix # Archive::Zip::Member
+{
+ my $perms = shift;
+ return $perms >> 16;
+}
+
+#--------------------------------
+
+=item unixFileAttributes( [$newAttributes] )
+
+Get or set the member's file attributes using UNIX file attributes.
+Returns old attributes.
+
+ my $oldAttribs = $member->unixFileAttributes( 0666 );
+
+Note that the return value has more than just the file permissions,
+so you will have to mask off the lowest bits for comparisions.
+
+=cut
+
+sub unixFileAttributes # Archive::Zip::Member
+{
+ my $self = shift;
+ my $oldPerms = _mapPermissionsToUnix( $self->{'externalFileAttributes'} );
+ if ( @_ )
+ {
+ my $perms = shift;
+ if ( $self->isDirectory() )
+ {
+ $perms &= ~FILE_ATTRIB;
+ $perms |= DIRECTORY_ATTRIB;
+ }
+ else
+ {
+ $perms &= ~DIRECTORY_ATTRIB;
+ $perms |= FILE_ATTRIB;
+ }
+ $self->{'externalFileAttributes'} = _mapPermissionsFromUnix( $perms);
+ }
+ return $oldPerms;
+}
+
+#--------------------------------
+
+=item localExtraField( [$newField] )
+
+Gets or sets the extra field that was read from the local header.
+This is not set for a member from a zip file until after the
+member has been written out.
+
+The extra field must be in the proper format.
+
+=cut
+
+sub localExtraField # Archive::Zip::Member
+{
+ ( $#_ > 0 ) ? ( $_[0]->{'localExtraField'} = $_[1] )
+ : $_[0]->{'localExtraField'}
+}
+
+#--------------------------------
+
+=item cdExtraField( [$newField] )
+
+Gets or sets the extra field that was read from the central directory header.
+
+The extra field must be in the proper format.
+
+=cut
+
+sub cdExtraField # Archive::Zip::Member
+{
+ ( $#_ > 0 ) ? ( $_[0]->{'cdExtraField'} = $_[1] )
+ : $_[0]->{'cdExtraField'}
+}
+
+#--------------------------------
+
+=item extraFields()
+
+Return both local and CD extra fields, concatenated.
+
+=cut
+
+sub extraFields # Archive::Zip::Member
+{
+ my $self = shift;
+ return $self->localExtraField() . $self->cdExtraField();
+}
+
+#--------------------------------
+
+=item fileComment( [$newComment] )
+
+Get or set the member's file comment.
+
+=cut
+
+sub fileComment # Archive::Zip::Member
+{
+ ( $#_ > 0 ) ? ( $_[0]->{'fileComment'} = $_[1] )
+ : $_[0]->{'fileComment'}
+}
+
+#--------------------------------
+
+=item hasDataDescriptor()
+
+Get or set the data descriptor flag.
+If this is set, the local header will not necessarily
+have the correct data sizes. Instead, a small structure
+will be stored at the end of the member data with these
+values.
+
+This should be transparent in normal operation.
+
+=cut
+
+sub hasDataDescriptor # Archive::Zip::Member
+{
+ my $self = shift;
+ if ( @_ )
+ {
+ my $shouldHave = shift;
+ if ( $shouldHave )
+ {
+ $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK
+ }
+ else
+ {
+ $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
+ }
+ }
+ return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK;
+}
+
+#--------------------------------
+
+=item crc32()
+
+Return the CRC-32 value for this member.
+This will not be set for members that were constructed from strings
+or external files until after the member has been written.
+
+=cut
+
+sub crc32 # Archive::Zip::Member
+{ shift->{'crc32'} }
+
+#--------------------------------
+
+=item crc32String()
+
+Return the CRC-32 value for this member as an 8 character printable
+hex string. This will not be set for members that were constructed
+from strings or external files until after the member has been written.
+
+=cut
+
+sub crc32String # Archive::Zip::Member
+{ sprintf( "%08x", shift->{'crc32'} ); }
+
+#--------------------------------
+
+=item compressedSize()
+
+Return the compressed size for this member.
+This will not be set for members that were constructed from strings
+or external files until after the member has been written.
+
+=cut
+
+sub compressedSize # Archive::Zip::Member
+{ shift->{'compressedSize'} }
+
+#--------------------------------
+
+=item uncompressedSize()
+
+Return the uncompressed size for this member.
+
+=cut
+
+sub uncompressedSize # Archive::Zip::Member
+{ shift->{'uncompressedSize'} }
+
+#--------------------------------
+
+=item isEncrypted()
+
+Return true if this member is encrypted.
+The Archive::Zip module does not currently create or extract
+encrypted members.
+
+=cut
+
+sub isEncrypted # Archive::Zip::Member
+{ shift->bitFlag() & GPBF_ENCRYPTED_MASK }
+
+
+#--------------------------------
+
+=item isTextFile( [$flag] )
+
+Returns true if I am a text file.
+Also can set the status if given an argument (then returns old state).
+Note that this module does not currently do anything with this flag
+upon extraction or storage.
+That is, bytes are stored in native format whether or not they came
+from a text file.
+
+=cut
+
+sub isTextFile # Archive::Zip::Member
+{
+ my $self = shift;
+ my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
+ if ( @_ )
+ {
+ my $flag = shift;
+ $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
+ $self->{'internalFileAttributes'} |=
+ ( $flag ? IFA_TEXT_FILE : IFA_BINARY_FILE );
+ }
+ return $bit == IFA_TEXT_FILE;
+}
+
+#--------------------------------
+
+=item isBinaryFile()
+
+Returns true if I am a binary file.
+Also can set the status if given an argument (then returns old state).
+Note that this module does not currently do anything with this flag
+upon extraction or storage.
+That is, bytes are stored in native format whether or not they came
+from a text file.
+
+=cut
+
+sub isBinaryFile # Archive::Zip::Member
+{
+ my $self = shift;
+ my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
+ if ( @_ )
+ {
+ my $flag = shift;
+ $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
+ $self->{'internalFileAttributes'} |=
+ ( $flag ? IFA_BINARY_FILE : IFA_TEXT_FILE );
+ }
+ return $bit == IFA_BINARY_FILE;
+}
+
+#--------------------------------
+
+=item extractToFileNamed( $fileName )
+
+Extract me to a file with the given name.
+The file will be created with default modes.
+Directories will be created as needed.
+
+Returns AZ_OK on success.
+
+=cut
+
+sub extractToFileNamed # Archive::Zip::Member
+{
+ my $self = shift;
+ my $name = shift;
+ return _error( "encryption unsupported" ) if $self->isEncrypted();
+ mkpath( dirname( $name ) ); # croaks on error
+ my ( $status, $fh ) = _newFileHandle( $name, 'w' );
+ return _ioError( "Can't open file $name for write" ) if !$status;
+ my $retval = $self->extractToFileHandle( $fh );
+ $fh->close();
+ return $retval;
+}
+
+#--------------------------------
+
+=item isDirectory()
+
+Returns true if I am a directory.
+
+=cut
+
+sub isDirectory # Archive::Zip::Member
+{ return 0 }
+
+# The following are used when copying data
+sub _writeOffset # Archive::Zip::Member
+{ shift->{'writeOffset'} }
+
+sub _readOffset # Archive::Zip::Member
+{ shift->{'readOffset'} }
+
+sub _writeLocalHeaderRelativeOffset # Archive::Zip::Member
+{ shift->{'writeLocalHeaderRelativeOffset'} }
+
+sub _dataEnded # Archive::Zip::Member
+{ shift->{'dataEnded'} }
+
+sub _readDataRemaining # Archive::Zip::Member
+{ shift->{'readDataRemaining'} }
+
+sub _inflater # Archive::Zip::Member
+{ shift->{'inflater'} }
+
+sub _deflater # Archive::Zip::Member
+{ shift->{'deflater'} }
+
+# Return the total size of my local header
+sub _localHeaderSize # Archive::Zip::Member
+{
+ my $self = shift;
+ return SIGNATURE_LENGTH
+ + LOCAL_FILE_HEADER_LENGTH
+ + length( $self->fileName() )
+ + length( $self->localExtraField() )
+}
+
+# Return the total size of my CD header
+sub _centralDirectoryHeaderSize # Archive::Zip::Member
+{
+ my $self = shift;
+ return SIGNATURE_LENGTH
+ + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+ + length( $self->fileName() )
+ + length( $self->cdExtraField() )
+ + length( $self->fileComment() )
+}
+
+# convert a unix time to DOS date/time
+# NOT AN OBJECT METHOD!
+sub _unixToDosTime # Archive::Zip::Member
+{
+ my $time_t = shift;
+ my ( $sec,$min,$hour,$mday,$mon,$year ) = localtime( $time_t );
+ my $dt = 0;
+ $dt += ( $sec >> 1 );
+ $dt += ( $min << 5 );
+ $dt += ( $hour << 11 );
+ $dt += ( $mday << 16 );
+ $dt += ( ( $mon + 1 ) << 21 );
+ $dt += ( ( $year - 80 ) << 25 );
+ return $dt;
+}
+
+# Write my local header to a file handle.
+# Stores the offset to the start of the header in my
+# writeLocalHeaderRelativeOffset member.
+# Returns AZ_OK on success.
+sub _writeLocalFileHeader # Archive::Zip::Member
+{
+ my $self = shift;
+ my $fh = shift;
+
+ my $signatureData = pack( SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE );
+ $fh->write( $signatureData, SIGNATURE_LENGTH )
+ or return _ioError( "writing local header signature" );
+
+ my $header = pack( LOCAL_FILE_HEADER_FORMAT,
+ $self->versionNeededToExtract(),
+ $self->bitFlag(),
+ $self->desiredCompressionMethod(),
+ $self->lastModFileDateTime(),
+ $self->crc32(),
+ $self->compressedSize(), # may need to be re-written later
+ $self->uncompressedSize(),
+ length( $self->fileName() ),
+ length( $self->localExtraField() )
+ );
+
+ $fh->write( $header, LOCAL_FILE_HEADER_LENGTH )
+ or return _ioError( "writing local header" );
+ if ( length( $self->fileName() ))
+ {
+ $fh->write( $self->fileName(), length( $self->fileName() ))
+ or return _ioError( "writing local header filename" );
+ }
+ if ( length( $self->localExtraField() ))
+ {
+ $fh->write( $self->localExtraField(), length( $self->localExtraField() ))
+ or return _ioError( "writing local header signature" );
+ }
+
+ return AZ_OK;
+}
+
+sub _writeCentralDirectoryFileHeader # Archive::Zip::Member
+{
+ my $self = shift;
+ my $fh = shift;
+
+ my $sigData = pack( SIGNATURE_FORMAT,
+ CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE );
+ $fh->write( $sigData, SIGNATURE_LENGTH )
+ or return _ioError( "writing central directory header signature" );
+
+ my $fileNameLength = length( $self->fileName() );
+ my $extraFieldLength = length( $self->cdExtraField() );
+ my $fileCommentLength = length( $self->fileComment() );
+
+ my $header = pack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
+ $self->versionMadeBy(),
+ $self->fileAttributeFormat(),
+ $self->versionNeededToExtract(),
+ $self->bitFlag(),
+ $self->desiredCompressionMethod(),
+ $self->lastModFileDateTime(),
+ $self->crc32(), # these three fields should have been updated
+ $self->_writeOffset(), # by writing the data stream out
+ $self->uncompressedSize(), #
+ $fileNameLength,
+ $extraFieldLength,
+ $fileCommentLength,
+ 0, # {'diskNumberStart'},
+ $self->internalFileAttributes(),
+ $self->externalFileAttributes(),
+ $self->_writeLocalHeaderRelativeOffset()
+ );
+
+ $fh->write( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
+ or return _ioError( "writing central directory header" );
+ if ( $fileNameLength )
+ {
+ $fh->write( $self->fileName(), $fileNameLength )
+ or return _ioError( "writing central directory header signature" );
+ }
+ if ( $extraFieldLength )
+ {
+ $fh->write( $self->cdExtraField(), $extraFieldLength )
+ or return _ioError( "writing central directory extra field" );
+ }
+ if ( $fileCommentLength )
+ {
+ $fh->write( $self->fileComment(), $fileCommentLength )
+ or return _ioError( "writing central directory file comment" );
+ }
+
+ return AZ_OK;
+}
+
+# This writes a data descriptor to the given file handle.
+# Assumes that crc32, writeOffset, and uncompressedSize are
+# set correctly (they should be after a write).
+# Further, the local file header should have the
+# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
+sub _writeDataDescriptor # Archive::Zip::Member
+{
+ my $self = shift;
+ my $fh = shift;
+ my $header = pack( DATA_DESCRIPTOR_FORMAT,
+ $self->crc32(),
+ $self->_writeOffset(),
+ $self->uncompressedSize()
+ );
+
+ $fh->write( $header, DATA_DESCRIPTOR_LENGTH )
+ or return _ioError( "writing data descriptor" );
+ return AZ_OK;
+}
+
+# Re-writes the local file header with new crc32 and compressedSize fields.
+# To be called after writing the data stream.
+# Assumes that filename and extraField sizes didn't change since last written.
+sub _refreshLocalFileHeader # Archive::Zip::Member
+{
+ my $self = shift;
+ my $fh = shift;
+
+ my $here = $fh->tell();
+ $fh->seek( $self->_writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH,
+ IO::Seekable::SEEK_SET )
+ or return _ioError( "seeking to rewrite local header" );
+
+ my $header = pack( LOCAL_FILE_HEADER_FORMAT,
+ $self->versionNeededToExtract(),
+ $self->bitFlag(),
+ $self->desiredCompressionMethod(),
+ $self->lastModFileDateTime(),
+ $self->crc32(),
+ $self->_writeOffset(),
+ $self->uncompressedSize(),
+ length( $self->fileName() ),
+ length( $self->localExtraField() )
+ );
+
+ $fh->write( $header, LOCAL_FILE_HEADER_LENGTH )
+ or return _ioError( "re-writing local header" );
+ $fh->seek( $here, IO::Seekable::SEEK_SET )
+ or return _ioError( "seeking after rewrite of local header" );
+
+ return AZ_OK;
+}
+
+=back
+
+=head2 Low-level member data reading
+
+It is possible to use lower-level routines to access member
+data streams, rather than the extract* methods and contents().
+
+For instance, here is how to print the uncompressed contents
+of a member in chunks using these methods:
+
+ my ( $member, $status, $bufferRef );
+ $member = $zip->memberNamed( 'xyz.txt' );
+ $member->desiredCompressionMethod( COMPRESSION_STORED );
+ $status = $member->rewindData();
+ die "error $status" if $status != AZ_OK;
+ while ( ! $member->readIsDone() )
+ {
+ ( $bufferRef, $status ) = $member->readChunk();
+ die "error $status" if $status != AZ_OK;
+ # do something with $bufferRef:
+ print $$bufferRef;
+ }
+ $member->endRead();
+
+=over 4
+
+=cut
+
+#--------------------------------
+
+=item readChunk( [$chunkSize] )
+
+This reads the next chunk of given size from the member's data stream and
+compresses or uncompresses it as necessary, returning a reference to the bytes
+read and a status.
+If size argument is not given, defaults to global set by
+Archive::Zip::setChunkSize.
+Status is AZ_OK on success. Returns C<( \$bytes, $status)>.
+
+ my ( $outRef, $status ) = $self->readChunk();
+ print $$outRef if $status != AZ_OK;
+
+=cut
+
+sub readChunk # Archive::Zip::Member
+{
+ my ( $self, $chunkSize ) = @_;
+
+ if ( $self->readIsDone() )
+ {
+ $self->endRead();
+ my $dummy = '';
+ return ( \$dummy, AZ_STREAM_END );
+ }
+
+ $chunkSize = $Archive::Zip::ChunkSize if not defined( $chunkSize );
+ $chunkSize = $self->_readDataRemaining()
+ if $chunkSize > $self->_readDataRemaining();
+
+ my $buffer = '';
+ my $outputRef;
+ my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
+ return ( \$buffer, $status) if $status != AZ_OK;
+
+ $self->{'readDataRemaining'} -= $bytesRead;
+ $self->{'readOffset'} += $bytesRead;
+
+ if ( $self->compressionMethod() == COMPRESSION_STORED )
+ {
+ $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
+ }
+
+ ( $outputRef, $status) = &{$self->{'chunkHandler'}}( $self, \$buffer );
+ $self->{'writeOffset'} += length( $$outputRef );
+
+ $self->endRead()
+ if $self->readIsDone();
+
+ return ( $outputRef, $status);
+}
+
+# Read the next raw chunk of my data. Subclasses MUST implement.
+# my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
+sub _readRawChunk # Archive::Zip::Member
+{
+ my $self = shift;
+ return $self->_subclassResponsibility();
+}
+
+# A place holder to catch rewindData errors if someone ignores
+# the error code.
+sub _noChunk # Archive::Zip::Member
+{
+ my $self = shift;
+ return ( \undef, _error( "trying to copy chunk when init failed" ));
+}
+
+# Basically a no-op so that I can have a consistent interface.
+# ( $outputRef, $status) = $self->_copyChunk( \$buffer );
+sub _copyChunk # Archive::Zip::Member
+{
+ my ( $self, $dataRef ) = @_;
+ return ( $dataRef, AZ_OK );
+}
+
+
+# ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
+sub _deflateChunk # Archive::Zip::Member
+{
+ my ( $self, $buffer ) = @_;
+ my ( $out, $status ) = $self->_deflater()->deflate( $buffer );
+
+ if ( $self->_readDataRemaining() == 0 )
+ {
+ my $extraOutput;
+ ( $extraOutput, $status ) = $self->_deflater()->flush();
+ $out .= $extraOutput;
+ $self->endRead();
+ return ( \$out, AZ_STREAM_END );
+ }
+ elsif ( $status == Z_OK )
+ {
+ return ( \$out, AZ_OK );
+ }
+ else
+ {
+ $self->endRead();
+ my $retval = _error( 'deflate error', $status);
+ my $dummy = '';
+ return ( \$dummy, $retval );
+ }
+}
+
+# ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
+sub _inflateChunk # Archive::Zip::Member
+{
+ my ( $self, $buffer ) = @_;
+ my ( $out, $status ) = $self->_inflater()->inflate( $buffer );
+ my $retval;
+ $self->endRead() if ( $status != Z_OK );
+ if ( $status == Z_OK || $status == Z_STREAM_END )
+ {
+ $retval = ( $status == Z_STREAM_END )
+ ? AZ_STREAM_END : AZ_OK;
+ return ( \$out, $retval );
+ }
+ else
+ {
+ $retval = _error( 'inflate error', $status);
+ my $dummy = '';
+ return ( \$dummy, $retval );
+ }
+}
+
+#--------------------------------
+
+=item rewindData()
+
+Rewind data and set up for reading data streams or writing zip files.
+Can take options for C<inflateInit()> or C<deflateInit()>,
+but this isn't likely to be necessary.
+Subclass overrides should call this method.
+Returns C<AZ_OK> on success.
+
+=cut
+
+sub rewindData # Archive::Zip::Member
+{
+ my $self = shift;
+ my $status;
+
+ # set to trap init errors
+ $self->{'chunkHandler'} = $self->can( '_noChunk' );
+
+ # Work around WinZip defect with 0-length DEFLATED files
+ $self->desiredCompressionMethod( COMPRESSION_STORED )
+ if $self->uncompressedSize() == 0;
+
+ # assume that we're going to read the whole file, and compute the CRC anew.
+ $self->{'crc32'} = 0 if ( $self->compressionMethod() == COMPRESSION_STORED );
+
+ # These are the only combinations of methods we deal with right now.
+ if ( $self->compressionMethod() == COMPRESSION_STORED
+ and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
+ {
+ ( $self->{'deflater'}, $status ) = Compress::Zlib::deflateInit(
+ '-Level' => $self->desiredCompressionLevel(),
+ '-WindowBits' => - MAX_WBITS(), # necessary magic
+ @_ ); # pass additional options
+ return _error( 'deflateInit error:', $status ) if $status != Z_OK;
+ $self->{'chunkHandler'} = $self->can( '_deflateChunk' );
+ }
+ elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
+ and $self->desiredCompressionMethod() == COMPRESSION_STORED )
+ {
+ ( $self->{'inflater'}, $status ) = Compress::Zlib::inflateInit(
+ '-WindowBits' => - MAX_WBITS(), # necessary magic
+ @_ ); # pass additional options
+ return _error( 'inflateInit error:', $status ) if $status != Z_OK;
+ $self->{'chunkHandler'} = $self->can( '_inflateChunk' );
+ }
+ elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() )
+ {
+ $self->{'chunkHandler'} = $self->can( '_copyChunk' );
+ }
+ else
+ {
+ return _error(
+ sprintf( "Unsupported compression combination: read %d, write %d",
+ $self->compressionMethod(),
+ $self->desiredCompressionMethod() )
+ );
+ }
+
+ $self->{'dataEnded'} = 0;
+ $self->{'readDataRemaining'} = $self->compressedSize();
+ $self->{'readOffset'} = 0;
+
+ return AZ_OK;
+}
+
+#--------------------------------
+
+=item endRead()
+
+Reset the read variables and free the inflater or deflater.
+Must be called to close files, etc.
+
+Returns AZ_OK on success.
+
+=cut
+
+sub endRead # Archive::Zip::Member
+{
+ my $self = shift;
+ delete $self->{'inflater'};
+ delete $self->{'deflater'};
+ $self->{'dataEnded'} = 1;
+ $self->{'readDataRemaining'} = 0;
+ return AZ_OK;
+}
+
+#--------------------------------
+
+=item readIsDone()
+
+Return true if the read has run out of data or errored out.
+
+=cut
+
+sub readIsDone # Archive::Zip::Member
+{
+ my $self = shift;
+ return ( $self->_dataEnded() or ! $self->_readDataRemaining() );
+}
+
+#--------------------------------
+
+=item contents()
+
+Return the entire uncompressed member data or undef in scalar context.
+When called in array context, returns C<( $string, $status )>; status
+will be AZ_OK on success:
+
+ my $string = $member->contents();
+ # or
+ my ( $string, $status ) = $member->contents();
+ die "error $status" if $status != AZ_OK;
+
+Can also be used to set the contents of a member (this may change
+the class of the member):
+
+ $member->contents( "this is my new contents" );
+
+=cut
+
+sub contents # Archive::Zip::Member
+{
+ my $self = shift;
+ my $newContents = shift;
+ if ( defined( $newContents ) )
+ {
+ $self->_become( STRINGMEMBERCLASS );
+ return $self->contents( $newContents );
+ }
+ else
+ {
+ my $oldCompression =
+ $self->desiredCompressionMethod( COMPRESSION_STORED );
+ my $status = $self->rewindData( @_ );
+ if ( $status != AZ_OK )
+ {
+ $self->endRead();
+ return $status;
+ }
+ my $retval = '';
+ while ( $status == AZ_OK )
+ {
+ my $ref;
+ ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
+ # did we get it in one chunk?
+ if ( length( $$ref ) == $self->uncompressedSize() )
+ { $retval = $$ref }
+ else
+ { $retval .= $$ref }
+ }
+ $self->desiredCompressionMethod( $oldCompression );
+ $self->endRead();
+ $status = AZ_OK if $status == AZ_STREAM_END;
+ $retval = undef if $status != AZ_OK;
+ return wantarray ? ( $retval, $status ) : $retval;
+ }
+}
+
+#--------------------------------
+
+=item extractToFileHandle( $fh )
+
+Extract (and uncompress, if necessary) my contents to the given file handle.
+Return AZ_OK on success.
+
+=cut
+
+sub extractToFileHandle # Archive::Zip::Member
+{
+ my $self = shift;
+ return _error( "encryption unsupported" ) if $self->isEncrypted();
+ my $fh = shift;
+ _binmode( $fh );
+ my $oldCompression = $self->desiredCompressionMethod( COMPRESSION_STORED );
+ my $status = $self->rewindData( @_ );
+ $status = $self->_writeData( $fh ) if $status == AZ_OK;
+ $self->desiredCompressionMethod( $oldCompression );
+ $self->endRead();
+ return $status;
+}
+
+# write local header and data stream to file handle
+sub _writeToFileHandle # Archive::Zip::Member
+{
+ my $self = shift;
+ my $fh = shift;
+ my $fhIsSeekable = shift;
+
+ # Determine if I need to write a data descriptor
+ # I need to do this if I can't refresh the header
+ # and I don't know compressed size or crc32 fields.
+ my $headerFieldsUnknown = ( ( $self->uncompressedSize() > 0 )
+ and ( $self->compressionMethod() == COMPRESSION_STORED
+ or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED ) );
+
+ my $shouldWriteDataDescriptor =
+ ( $headerFieldsUnknown and not $fhIsSeekable );
+
+ $self->hasDataDescriptor( 1 )
+ if ( $shouldWriteDataDescriptor );
+
+ $self->{'writeOffset'} = 0;
+
+ my $status = $self->rewindData();
+ ( $status = $self->_writeLocalFileHeader( $fh ) )
+ if $status == AZ_OK;
+ ( $status = $self->_writeData( $fh ) )
+ if $status == AZ_OK;
+ if ( $status == AZ_OK )
+ {
+ if ( $self->hasDataDescriptor() )
+ {
+ $status = $self->_writeDataDescriptor( $fh );
+ }
+ elsif ( $headerFieldsUnknown )
+ {
+ $status = $self->_refreshLocalFileHeader( $fh );
+ }
+ }
+
+ return $status;
+}
+
+# Copy my (possibly compressed) data to given file handle.
+# Returns C<AZ_OK> on success
+sub _writeData # Archive::Zip::Member
+{
+ my $self = shift;
+ my $writeFh = shift;
+
+ return AZ_OK if ( $self->uncompressedSize() == 0 );
+ my $status;
+ my $chunkSize = $Archive::Zip::ChunkSize;
+ while ( $self->_readDataRemaining() > 0 )
+ {
+ my $outRef;
+ ( $outRef, $status ) = $self->readChunk( $chunkSize );
+ return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );
+
+ $writeFh->write( $$outRef, length( $$outRef ) )
+ or return _ioError( "write error during copy" );
+
+ last if $status == AZ_STREAM_END;
+ }
+ return AZ_OK;
+}
+
+
+# Return true if I depend on the named file
+sub _usesFileNamed
+{
+ return 0;
+}
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::DirectoryMember
+# ----------------------------------------------------------------------
+
+package Archive::Zip::DirectoryMember;
+use File::Path;
+
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip::Member );
+BEGIN { use Archive::Zip qw( :ERROR_CODES :UTILITY_METHODS ) }
+
+sub _newNamed # Archive::Zip::DirectoryMember
+{
+ my $class = shift;
+ my $name = shift;
+ my $self = $class->new( @_ );
+ $self->fileName( $name );
+ if ( -d $name )
+ {
+ my @stat = stat( _ );
+ $self->unixFileAttributes( $stat[2] );
+ $self->setLastModFileDateTimeFromUnix( $stat[9] );
+ }
+ else
+ {
+ $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
+ $self->setLastModFileDateTimeFromUnix( time() );
+ }
+ return $self;
+}
+
+sub isDirectory # Archive::Zip::DirectoryMember
+{ return 1; }
+
+sub extractToFileNamed # Archive::Zip::DirectoryMember
+{
+ my $self = shift;
+ my $name = shift;
+ my $attribs = $self->unixFileAttributes() & 07777;
+ mkpath( $name, 0, $attribs ); # croaks on error
+ return AZ_OK;
+}
+
+sub fileName # Archive::Zip::DirectoryMember
+{
+ my $self = shift;
+ my $newName = shift;
+ $newName =~ s{/?$}{/} if defined( $newName );
+ return $self->SUPER::fileName( $newName );
+}
+
+=back
+
+=head1 Archive::Zip::FileMember methods
+
+The Archive::Zip::FileMember class extends Archive::Zip::Member.
+It is the base class for both ZipFileMember and NewFileMember classes.
+This class adds an C<externalFileName> and an C<fh> member to keep
+track of the external file.
+
+=over 4
+
+=cut
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::FileMember
+# Base class for classes that have file handles
+# to external files
+# ----------------------------------------------------------------------
+
+package Archive::Zip::FileMember;
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip::Member );
+BEGIN { use Archive::Zip qw( :UTILITY_METHODS ) }
+
+#--------------------------------
+
+=item externalFileName()
+
+Return my external filename.
+
+=cut
+
+sub externalFileName # Archive::Zip::FileMember
+{ shift->{'externalFileName'} }
+
+#--------------------------------
+
+# Return true if I depend on the named file
+sub _usesFileNamed
+{
+ my $self = shift;
+ my $fileName = shift;
+ return $self->externalFileName eq $fileName;
+}
+
+=item fh()
+
+Return my read file handle.
+Automatically opens file if necessary.
+
+=cut
+
+sub fh # Archive::Zip::FileMember
+{
+ my $self = shift;
+ $self->_openFile() if ! $self->{'fh'};
+ return $self->{'fh'};
+}
+
+# opens my file handle from my file name
+sub _openFile # Archive::Zip::FileMember
+{
+ my $self = shift;
+ my ( $status, $fh ) = _newFileHandle( $self->externalFileName(), 'r' );
+ if ( !$status )
+ {
+ _ioError( "Can't open", $self->externalFileName() );
+ return undef;
+ }
+ $self->{'fh'} = $fh;
+ _binmode( $fh );
+ return $fh;
+}
+
+# Closes my file handle
+sub _closeFile # Archive::Zip::FileMember
+{
+ my $self = shift;
+ $self->{'fh'} = undef;
+}
+
+# Make sure I close my file handle
+sub endRead # Archive::Zip::FileMember
+{
+ my $self = shift;
+ $self->_closeFile();
+ return $self->SUPER::endRead( @_ );
+}
+
+sub _become # Archive::Zip::FileMember
+{
+ my $self = shift;
+ my $newClass = shift;
+ return $self if ref( $self ) eq $newClass;
+ delete( $self->{'externalFileName'} );
+ delete( $self->{'fh'} );
+ return $self->SUPER::_become( $newClass );
+}
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::NewFileMember
+# Used when adding a pre-existing file to an archive
+# ----------------------------------------------------------------------
+
+package Archive::Zip::NewFileMember;
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip::FileMember );
+
+BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :UTILITY_METHODS ) }
+
+# Given a file name, set up for eventual writing.
+sub _newFromFileNamed # Archive::Zip::NewFileMember
+{
+ my $class = shift;
+ my $fileName = shift;
+ return undef if ! ( -r $fileName && ( -f _ || -l _ ) );
+ my $self = $class->new( @_ );
+ $self->fileName( $fileName );
+ $self->{'externalFileName'} = $fileName;
+ $self->{'compressionMethod'} = COMPRESSION_STORED;
+ my @stat = stat( _ );
+ $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
+ $self->desiredCompressionMethod( ( $self->compressedSize() > 0 )
+ ? COMPRESSION_DEFLATED
+ : COMPRESSION_STORED );
+ $self->unixFileAttributes( $stat[2] );
+ $self->setLastModFileDateTimeFromUnix( $stat[9] );
+ $self->isTextFile( -T _ );
+ return $self;
+}
+
+sub rewindData # Archive::Zip::NewFileMember
+{
+ my $self = shift;
+
+ my $status = $self->SUPER::rewindData( @_ );
+ return $status if $status != AZ_OK;
+
+ return AZ_IO_ERROR if ! $self->fh();
+ $self->fh()->clearerr();
+ $self->fh()->seek( 0, IO::Seekable::SEEK_SET )
+ or return _ioError( "rewinding", $self->externalFileName() );
+ return AZ_OK;
+}
+
+# Return bytes read. Note that first parameter is a ref to a buffer.
+# my $data;
+# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
+sub _readRawChunk # Archive::Zip::NewFileMember
+{
+ my ( $self, $dataRef, $chunkSize ) = @_;
+ return ( 0, AZ_OK ) if ( ! $chunkSize );
+ my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
+ or return ( 0, _ioError( "reading data" ) );
+ return ( $bytesRead, AZ_OK );
+}
+
+# If I already exist, extraction is a no-op.
+sub extractToFileNamed # Archive::Zip::NewFileMember
+{
+ my $self = shift;
+ my $name = shift;
+ if ( $name eq $self->fileName() and -r $name )
+ {
+ return AZ_OK;
+ }
+ else
+ {
+ return $self->SUPER::extractToFileNamed( $name, @_ );
+ }
+}
+
+=back
+
+=head1 Archive::Zip::ZipFileMember methods
+
+The Archive::Zip::ZipFileMember class represents members that have
+been read from external zip files.
+
+=over 4
+
+=cut
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::ZipFileMember
+# This represents a member in an existing zip file on disk.
+# ----------------------------------------------------------------------
+
+package Archive::Zip::ZipFileMember;
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip::FileMember );
+
+BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS
+ :UTILITY_METHODS ) }
+
+# Create a new Archive::Zip::ZipFileMember
+# given a filename and optional open file handle
+sub _newFromZipFile # Archive::Zip::ZipFileMember
+{
+ my $class = shift;
+ my $fh = shift;
+ my $externalFileName = shift;
+ my $self = $class->new(
+ 'crc32' => 0,
+ 'diskNumberStart' => 0,
+ 'localHeaderRelativeOffset' => 0,
+ 'dataOffset' => 0, # localHeaderRelativeOffset + header length
+ @_
+ );
+ $self->{'externalFileName'} = $externalFileName;
+ $self->{'fh'} = $fh;
+ return $self;
+}
+
+sub isDirectory # Archive::Zip::FileMember
+{
+ my $self = shift;
+ return ( substr( $self->fileName(), -1, 1 ) eq '/'
+ and $self->uncompressedSize() == 0 );
+}
+
+# Because I'm going to delete the file handle, read the local file
+# header if the file handle is seekable. If it isn't, I assume that
+# I've already read the local header.
+# Return ( $status, $self )
+
+sub _become # Archive::Zip::ZipFileMember
+{
+ my $self = shift;
+ my $newClass = shift;
+ return $self if ref( $self ) eq $newClass;
+
+ my $status = AZ_OK;
+
+ if ( _isSeekable( $self->fh() ) )
+ {
+ my $here = $self->fh()->tell();
+ $status = $self->fh()->seek(
+ $self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
+ IO::Seekable::SEEK_SET );
+ if ( ! $status )
+ {
+ $self->fh()->seek( $here );
+ _ioError( "seeking to local header" );
+ return $self;
+ }
+ $self->_readLocalFileHeader();
+ $self->fh()->seek( $here, IO::Seekable::SEEK_SET );
+ }
+
+ delete( $self->{'diskNumberStart'} );
+ delete( $self->{'localHeaderRelativeOffset'} );
+ delete( $self->{'dataOffset'} );
+
+ return $self->SUPER::_become( $newClass );
+}
+
+#--------------------------------
+
+=item diskNumberStart()
+
+Returns the disk number that my local header resides
+in. Had better be 0.
+
+=cut
+
+sub diskNumberStart # Archive::Zip::ZipFileMember
+{ shift->{'diskNumberStart'} }
+
+#--------------------------------
+
+=item localHeaderRelativeOffset()
+
+Returns the offset into the zip file where my local header is.
+
+=cut
+
+sub localHeaderRelativeOffset # Archive::Zip::ZipFileMember
+{ shift->{'localHeaderRelativeOffset'} }
+
+#--------------------------------
+
+=item dataOffset()
+
+Returns the offset from the beginning of the zip file to
+my data.
+
+=cut
+
+sub dataOffset # Archive::Zip::ZipFileMember
+{ shift->{'dataOffset'} }
+
+# Skip local file header, updating only extra field stuff.
+# Assumes that fh is positioned before signature.
+sub _skipLocalFileHeader # Archive::Zip::ZipFileMember
+{
+ my $self = shift;
+ my $header;
+ $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH )
+ or return _ioError( "reading local file header" );
+ my $fileNameLength;
+ my $extraFieldLength;
+ ( undef, # $self->{'versionNeededToExtract'},
+ undef, # $self->{'bitFlag'},
+ undef, # $self->{'compressionMethod'},
+ undef, # $self->{'lastModFileDateTime'},
+ undef, # $crc32,
+ undef, # $compressedSize,
+ undef, # $uncompressedSize,
+ $fileNameLength,
+ $extraFieldLength ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
+
+ if ( $fileNameLength )
+ {
+ $self->fh()->seek( $fileNameLength, IO::Seekable::SEEK_CUR )
+ or return _ioError( "skipping local file name" );
+ }
+
+ if ( $extraFieldLength )
+ {
+ $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength )
+ or return _ioError( "reading local extra field" );
+ }
+
+ $self->{'dataOffset'} = $self->fh()->tell();
+
+ return AZ_OK;
+}
+
+# Read from a local file header into myself. Returns AZ_OK if successful.
+# Assumes that fh is positioned after signature.
+# Note that crc32, compressedSize, and uncompressedSize will be 0 if
+# GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag.
+
+sub _readLocalFileHeader # Archive::Zip::ZipFileMember
+{
+ my $self = shift;
+ my $header;
+ $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH )
+ or return _ioError( "reading local file header" );
+ my $fileNameLength;
+ my $crc32;
+ my $compressedSize;
+ my $uncompressedSize;
+ my $extraFieldLength;
+ ( $self->{'versionNeededToExtract'},
+ $self->{'bitFlag'},
+ $self->{'compressionMethod'},
+ $self->{'lastModFileDateTime'},
+ $crc32,
+ $compressedSize,
+ $uncompressedSize,
+ $fileNameLength,
+ $extraFieldLength ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
+
+ if ( $fileNameLength )
+ {
+ my $fileName;
+ $self->fh()->read( $fileName, $fileNameLength )
+ or return _ioError( "reading local file name" );
+ $self->fileName( $fileName );
+ }
+
+ if ( $extraFieldLength )
+ {
+ $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength )
+ or return _ioError( "reading local extra field" );
+ }
+
+ $self->{'dataOffset'} = $self->fh()->tell();
+
+ # Don't trash these fields from the CD if we already have them.
+ if ( not $self->hasDataDescriptor() )
+ {
+ $self->{'crc32'} = $crc32;
+ $self->{'compressedSize'} = $compressedSize;
+ $self->{'uncompressedSize'} = $uncompressedSize;
+ }
+
+ # We ignore data descriptors (we don't read them,
+ # and we compute elsewhere whether we need to write them ).
+ # And, we have the necessary data from the CD header.
+ # So mark this entry as not having a data descriptor.
+ $self->hasDataDescriptor( 0 );
+
+ return AZ_OK;
+}
+
+
+# Read a Central Directory header. Return AZ_OK on success.
+# Assumes that fh is positioned right after the signature.
+
+sub _readCentralDirectoryFileHeader # Archive::Zip::ZipFileMember
+{
+ my $self = shift;
+ my $fh = $self->fh();
+ my $header = '';
+ $fh->read( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
+ or return _ioError( "reading central dir header" );
+ my ( $fileNameLength, $extraFieldLength, $fileCommentLength );
+ (
+ $self->{'versionMadeBy'},
+ $self->{'fileAttributeFormat'},
+ $self->{'versionNeededToExtract'},
+ $self->{'bitFlag'},
+ $self->{'compressionMethod'},
+ $self->{'lastModFileDateTime'},
+ $self->{'crc32'},
+ $self->{'compressedSize'},
+ $self->{'uncompressedSize'},
+ $fileNameLength,
+ $extraFieldLength,
+ $fileCommentLength,
+ $self->{'diskNumberStart'},
+ $self->{'internalFileAttributes'},
+ $self->{'externalFileAttributes'},
+ $self->{'localHeaderRelativeOffset'}
+ ) = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
+
+ if ( $fileNameLength )
+ {
+ $fh->read( $self->{'fileName'}, $fileNameLength )
+ or return _ioError( "reading central dir filename" );
+ }
+ if ( $extraFieldLength )
+ {
+ $fh->read( $self->{'cdExtraField'}, $extraFieldLength )
+ or return _ioError( "reading central dir extra field" );
+ }
+ if ( $fileCommentLength )
+ {
+ $fh->read( $self->{'fileComment'}, $fileCommentLength )
+ or return _ioError( "reading central dir file comment" );
+ }
+
+ $self->desiredCompressionMethod( $self->compressionMethod() );
+
+ return AZ_OK;
+}
+
+sub rewindData # Archive::Zip::ZipFileMember
+{
+ my $self = shift;
+
+ my $status = $self->SUPER::rewindData( @_ );
+ return $status if $status != AZ_OK;
+
+ return AZ_IO_ERROR if ! $self->fh();
+
+ $self->fh()->clearerr();
+
+ # Seek to local file header.
+ # The only reason that I'm doing this this way is that the extraField
+ # length seems to be different between the CD header and the LF header.
+ $self->fh()->seek( $self->localHeaderRelativeOffset() + SIGNATURE_LENGTH,
+ IO::Seekable::SEEK_SET )
+ or return _ioError( "seeking to local header" );
+
+ # skip local file header
+ $status = $self->_skipLocalFileHeader();
+ return $status if $status != AZ_OK;
+
+ # Seek to beginning of file data
+ $self->fh()->seek( $self->dataOffset(), IO::Seekable::SEEK_SET )
+ or return _ioError( "seeking to beginning of file data" );
+
+ return AZ_OK;
+}
+
+# Return bytes read. Note that first parameter is a ref to a buffer.
+# my $data;
+# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
+sub _readRawChunk # Archive::Zip::ZipFileMember
+{
+ my ( $self, $dataRef, $chunkSize ) = @_;
+ return ( 0, AZ_OK )
+ if ( ! $chunkSize );
+ my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
+ or return ( 0, _ioError( "reading data" ) );
+ return ( $bytesRead, AZ_OK );
+}
+
+# ----------------------------------------------------------------------
+# class Archive::Zip::StringMember ( concrete )
+# A Zip member whose data lives in a string
+# ----------------------------------------------------------------------
+
+package Archive::Zip::StringMember;
+use vars qw( @ISA );
+@ISA = qw ( Archive::Zip::Member );
+
+BEGIN { use Archive::Zip qw( :CONSTANTS :ERROR_CODES ) }
+
+# Create a new string member. Default is COMPRESSION_STORED.
+# Can take a ref to a string as well.
+sub _newFromString # Archive::Zip::StringMember
+{
+ my $class = shift;
+ my $string = shift;
+ my $name = shift;
+ my $self = $class->new( @_ );
+ $self->contents( $string );
+ $self->fileName( $name ) if defined( $name );
+ # Set the file date to now
+ $self->setLastModFileDateTimeFromUnix( time() );
+ $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
+ return $self;
+}
+
+sub _become # Archive::Zip::StringMember
+{
+ my $self = shift;
+ my $newClass = shift;
+ return $self if ref( $self ) eq $newClass;
+ delete( $self->{'contents'} );
+ return $self->SUPER::_become( $newClass );
+}
+
+# Get or set my contents. Note that we do not call the superclass
+# version of this, because it calls us.
+sub contents # Archive::Zip::StringMember
+{
+ my $self = shift;
+ my $string = shift;
+ if ( defined( $string ) )
+ {
+ $self->{'contents'} = ( ref( $string ) eq 'SCALAR' )
+ ? $$string
+ : $string;
+ $self->{'uncompressedSize'}
+ = $self->{'compressedSize'}
+ = length( $self->{'contents'} );
+ $self->{'compressionMethod'} = COMPRESSION_STORED;
+ }
+ return $self->{'contents'};
+}
+
+# Return bytes read. Note that first parameter is a ref to a buffer.
+# my $data;
+# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
+sub _readRawChunk # Archive::Zip::StringMember
+{
+ my ( $self, $dataRef, $chunkSize ) = @_;
+ $$dataRef = substr( $self->contents(), $self->_readOffset(), $chunkSize );
+ return ( length( $$dataRef ), AZ_OK );
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Ned Konz, perl@bike-nomad.com
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ned Konz. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=head1 SEE ALSO
+
+L<Compress::Zlib>
+
+=cut
+
+# vim: ts=4 sw=4 columns=80