diff -r 22486c9c7b15 -r 378360dbbdba releasing/cbrtools/perl/Archive/Zip.pm --- /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 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 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 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 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 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 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 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 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 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 or C, +but this isn't likely to be necessary. +Subclass overrides should call this method. +Returns C 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 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 and an C 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 + +=cut + +# vim: ts=4 sw=4 columns=80