1 package Archive
::Zip
::Member
;
3 # A generic membet of an archive
6 use vars
qw( $VERSION @ISA );
10 @ISA = qw( Archive::Zip );
22 use Compress
::Raw
::Zlib
qw( Z_OK Z_STREAM_END MAX_WBITS );
26 use constant ZIPFILEMEMBERCLASS
=> 'Archive::Zip::ZipFileMember';
27 use constant NEWFILEMEMBERCLASS
=> 'Archive::Zip::NewFileMember';
28 use constant STRINGMEMBERCLASS
=> 'Archive::Zip::StringMember';
29 use constant DIRECTORYMEMBERCLASS
=> 'Archive::Zip::DirectoryMember';
31 # Unix perms for default creation of files/dirs.
32 use constant DEFAULT_DIRECTORY_PERMISSIONS
=> 040755;
33 use constant DEFAULT_FILE_PERMISSIONS
=> 0100666;
34 use constant DIRECTORY_ATTRIB
=> 040000;
35 use constant FILE_ATTRIB
=> 0100000;
37 # Returns self if successful, else undef
38 # Assumes that fh is positioned at beginning of central directory file header.
39 # Leaves fh positioned immediately after file header or EOCD signature.
42 my $self = $class->ZIPFILEMEMBERCLASS->_newFromZipFile(@_);
49 my ( $stringOrStringRef, $fileName );
50 if ( ref( $_[0] ) eq 'HASH' ) {
51 $stringOrStringRef = $_[0]->{string
};
52 $fileName = $_[0]->{zipName
};
55 ( $stringOrStringRef, $fileName ) = @_;
58 my $self = $class->STRINGMEMBERCLASS->_newFromString( $stringOrStringRef,
66 my ( $fileName, $zipName );
67 if ( ref( $_[0] ) eq 'HASH' ) {
68 $fileName = $_[0]->{fileName
};
69 $zipName = $_[0]->{zipName
};
72 ( $fileName, $zipName ) = @_;
75 my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed( $fileName,
80 sub newDirectoryNamed
{
83 my ( $directoryName, $newName );
84 if ( ref( $_[0] ) eq 'HASH' ) {
85 $directoryName = $_[0]->{directoryName
};
86 $newName = $_[0]->{zipName
};
89 ( $directoryName, $newName ) = @_;
92 my $self = $class->DIRECTORYMEMBERCLASS->_newNamed( $directoryName,
100 'lastModFileDateTime' => 0,
101 'fileAttributeFormat' => FA_UNIX
,
102 'versionMadeBy' => 20,
103 'versionNeededToExtract' => 20,
105 'compressionMethod' => COMPRESSION_STORED
,
106 'desiredCompressionMethod' => COMPRESSION_STORED
,
107 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE
,
108 'internalFileAttributes' => 0,
109 'externalFileAttributes' => 0, # set later
111 'cdExtraField' => '',
112 'localExtraField' => '',
115 'compressedSize' => 0,
116 'uncompressedSize' => 0,
117 'isSymbolicLink' => 0,
120 bless( $self, $class );
121 $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
125 sub _becomeDirectoryIfNecessary
{
127 $self->_become(DIRECTORYMEMBERCLASS
)
128 if $self->isDirectory();
132 # Morph into given class (do whatever cleanup I need to do)
134 return bless( $_[0], $_[1] );
138 shift->{'versionMadeBy'};
141 sub fileAttributeFormat
{
145 $self->{fileAttributeFormat
} = ( ref( $_[0] ) eq 'HASH' )
146 ?
$_[0]->{format
} : $_[0];
149 return $self->{fileAttributeFormat
};
153 sub versionNeededToExtract
{
154 shift->{'versionNeededToExtract'};
160 # Set General Purpose Bit Flags according to the desiredCompressionLevel setting
161 if ( $self->desiredCompressionLevel == 1 || $self->desiredCompressionLevel == 2 ) {
162 $self->{'bitFlag'} = DEFLATING_COMPRESSION_FAST
;
163 } elsif ( $self->desiredCompressionLevel == 3 || $self->desiredCompressionLevel == 4
164 || $self->desiredCompressionLevel == 5 || $self->desiredCompressionLevel == 6
165 || $self->desiredCompressionLevel == 7 ) {
166 $self->{'bitFlag'} = DEFLATING_COMPRESSION_NORMAL
;
167 } elsif ( $self->desiredCompressionLevel == 8 || $self->desiredCompressionLevel == 9 ) {
168 $self->{'bitFlag'} = DEFLATING_COMPRESSION_MAXIMUM
;
173 sub compressionMethod
{
174 shift->{'compressionMethod'};
177 sub desiredCompressionMethod
{
179 my $newDesiredCompressionMethod =
180 ( ref( $_[0] ) eq 'HASH' ) ?
shift->{compressionMethod
} : shift;
181 my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
182 if ( defined($newDesiredCompressionMethod) ) {
183 $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
184 if ( $newDesiredCompressionMethod == COMPRESSION_STORED
) {
185 $self->{'desiredCompressionLevel'} = 0;
186 $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
;
188 } elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED
) {
189 $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT
;
192 return $oldDesiredCompressionMethod;
195 sub desiredCompressionLevel
{
197 my $newDesiredCompressionLevel =
198 ( ref( $_[0] ) eq 'HASH' ) ?
shift->{compressionLevel
} : shift;
199 my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
200 if ( defined($newDesiredCompressionLevel) ) {
201 $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
202 $self->{'desiredCompressionMethod'} = (
203 $newDesiredCompressionLevel
204 ? COMPRESSION_DEFLATED
208 return $oldDesiredCompressionLevel;
215 $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems
216 $self->{'fileName'} = $newName;
218 return $self->{'fileName'};
221 sub lastModFileDateTime
{
222 my $modTime = shift->{'lastModFileDateTime'};
223 $modTime =~ m/^(\d+)$/; # untaint
229 return _dosToUnixTime
( $self->lastModFileDateTime() );
232 sub setLastModFileDateTimeFromUnix
{
235 $self->{'lastModFileDateTime'} = _unixToDosTime
($time_t);
238 sub internalFileAttributes
{
239 shift->{'internalFileAttributes'};
242 sub externalFileAttributes
{
243 shift->{'externalFileAttributes'};
246 # Convert UNIX permissions into proper value for zip file
247 # Usable as a function or a method
248 sub _mapPermissionsFromUnix
{
251 my $attribs = $mode << 16;
253 # Microsoft Windows Explorer needs this bit set for directories
254 if ( $mode & DIRECTORY_ATTRIB
) {
260 # TODO: map more MS-DOS perms
263 # Convert ZIP permissions into Unix ones
265 # This was taken from Info-ZIP group's portable UnZip
266 # zipfile-extraction program, version 5.50.
267 # http://www.info-zip.org/pub/infozip/
269 # See the mapattr() function in unix/unix.c
270 # See the attribute format constants in unzpriv.h
272 # XXX Note that there's one situation that isn't implemented
273 # yet that depends on the "extra field."
274 sub _mapPermissionsToUnix
{
277 my $format = $self->{'fileAttributeFormat'};
278 my $attribs = $self->{'externalFileAttributes'};
282 if ( $format == FA_AMIGA
) {
283 $attribs = $attribs >> 17 & 7; # Amiga RWE bits
284 $mode = $attribs << 6 | $attribs << 3 | $attribs;
288 if ( $format == FA_THEOS
) {
289 $attribs &= 0xF1FFFFFF;
290 if ( ( $attribs & 0xF0000000 ) != 0x40000000 ) {
291 $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits
294 $attribs &= 0x41FFFFFF; # leave directory bit as set
298 if ( $format == FA_UNIX
299 || $format == FA_VAX_VMS
300 || $format == FA_ACORN
301 || $format == FA_ATARI_ST
302 || $format == FA_BEOS
303 || $format == FA_QDOS
304 || $format == FA_TANDEM
)
306 $mode = $attribs >> 16;
307 return $mode if $mode != 0 or not $self->localExtraField;
309 # warn("local extra field is: ", $self->localExtraField, "\n");
311 # XXX This condition is not implemented
312 # I'm just including the comments from the info-zip section for now.
314 # Some (non-Info-ZIP) implementations of Zip for Unix and
315 # VMS (and probably others ??) leave 0 in the upper 16-bit
316 # part of the external_file_attributes field. Instead, they
317 # store file permission attributes in some extra field.
318 # As a work-around, we search for the presence of one of
319 # these extra fields and fall back to the MSDOS compatible
320 # part of external_file_attributes if one of the known
321 # e.f. types has been detected.
322 # Later, we might implement extraction of the permission
323 # bits from the VMS extra field. But for now, the work-around
324 # should be sufficient to provide "readable" extracted files.
325 # (For ASI Unix e.f., an experimental remap from the e.f.
326 # mode value IS already provided!)
329 # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the
330 # Unix attributes in the upper 16 bits of the external attributes
331 # field, just like Info-ZIP's Zip for Unix. We try to use that
332 # value, after a check for consistency with the MSDOS attribute
334 if ( $format == FA_MSDOS
) {
335 $mode = $attribs >> 16;
338 # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20
339 $attribs = !( $attribs & 1 ) << 1 | ( $attribs & 0x10 ) >> 4;
341 # keep previous $mode setting when its "owner"
342 # part appears to be consistent with DOS attribute flags!
343 return $mode if ( $mode & 0700 ) == ( 0400 | $attribs << 6 );
344 $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
348 sub unixFileAttributes
{
350 my $oldPerms = $self->_mapPermissionsToUnix;
354 $perms = ( ref( $_[0] ) eq 'HASH' ) ?
$_[0]->{attributes
} : $_[0];
356 if ( $self->isDirectory ) {
357 $perms &= ~FILE_ATTRIB
;
358 $perms |= DIRECTORY_ATTRIB
;
360 $perms &= ~DIRECTORY_ATTRIB
;
361 $perms |= FILE_ATTRIB
;
363 $self->{externalFileAttributes
} = $self->_mapPermissionsFromUnix($perms);
369 sub localExtraField
{
373 $self->{localExtraField
} = ( ref( $_[0] ) eq 'HASH' )
374 ?
$_[0]->{field
} : $_[0];
377 return $self->{localExtraField
};
385 $self->{cdExtraField
} = ( ref( $_[0] ) eq 'HASH' )
386 ?
$_[0]->{field
} : $_[0];
389 return $self->{cdExtraField
};
395 return $self->localExtraField() . $self->cdExtraField();
402 $self->{fileComment
} = ( ref( $_[0] ) eq 'HASH' )
403 ?
pack( 'C0a*', $_[0]->{comment
} ) : pack( 'C0a*', $_[0] );
406 return $self->{fileComment
};
410 sub hasDataDescriptor
{
413 my $shouldHave = shift;
415 $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK
;
418 $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
;
421 return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK
;
429 sprintf( "%08x", shift->{'crc32'} );
433 shift->{'compressedSize'};
436 sub uncompressedSize
{
437 shift->{'uncompressedSize'};
441 shift->bitFlag() & GPBF_ENCRYPTED_MASK
;
446 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK
;
448 my $flag = ( ref( $_[0] ) eq 'HASH' ) ?
shift->{flag
} : shift;
449 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK
;
450 $self->{'internalFileAttributes'} |=
451 ( $flag ? IFA_TEXT_FILE
: IFA_BINARY_FILE
);
453 return $bit == IFA_TEXT_FILE
;
458 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK
;
461 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK
;
462 $self->{'internalFileAttributes'} |=
463 ( $flag ? IFA_BINARY_FILE
: IFA_TEXT_FILE
);
465 return $bit == IFA_BINARY_FILE
;
468 sub extractToFileNamed
{
472 my $name = ( ref( $_[0] ) eq 'HASH' ) ?
$_[0]->{name
} : $_[0];
473 $self->{'isSymbolicLink'} = 0;
475 # Check if the file / directory is a symbolic link or not
476 if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
477 $self->{'isSymbolicLink'} = 1;
478 $self->{'newName'} = $name;
479 my ( $status, $fh ) = _newFileHandle
( $name, 'r' );
480 my $retval = $self->extractToFileHandle($fh);
483 #return _writeSymbolicLink($self, $name) if $self->isSymbolicLink();
484 return _error
("encryption unsupported") if $self->isEncrypted();
485 mkpath
( dirname
($name) ); # croaks on error
486 my ( $status, $fh ) = _newFileHandle
( $name, 'w' );
487 return _ioError
("Can't open file $name for write") unless $status;
488 my $retval = $self->extractToFileHandle($fh);
490 chmod ($self->unixFileAttributes(), $name)
491 or return _error
("Can't chmod() ${name}: $!");
492 utime( $self->lastModTime(), $self->lastModTime(), $name );
497 sub _writeSymbolicLink
{
500 my $chunkSize = $Archive::Zip
::ChunkSize
;
501 #my ( $outRef, undef ) = $self->readChunk($chunkSize);
503 my $retval = $self->extractToFileHandle($fh);
504 my ( $outRef, undef ) = $self->readChunk(100);
509 if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
510 $self->{'isSymbolicLink'} = 1;
521 sub externalFileName
{
525 # The following are used when copying data
527 shift->{'writeOffset'};
531 shift->{'readOffset'};
534 sub writeLocalHeaderRelativeOffset
{
535 shift->{'writeLocalHeaderRelativeOffset'};
538 sub wasWritten
{ shift->{'wasWritten'} }
541 shift->{'dataEnded'};
544 sub _readDataRemaining
{
545 shift->{'readDataRemaining'};
556 # Return the total size of my local header
557 sub _localHeaderSize
{
559 return SIGNATURE_LENGTH
+ LOCAL_FILE_HEADER_LENGTH
+
560 length( $self->fileName() ) + length( $self->localExtraField() );
563 # Return the total size of my CD header
564 sub _centralDirectoryHeaderSize
{
566 return SIGNATURE_LENGTH
+ CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+
567 length( $self->fileName() ) + length( $self->cdExtraField() ) +
568 length( $self->fileComment() );
571 # DOS date/time format
572 # 0-4 (5) Second divided by 2
573 # 5-10 (6) Minute (0-59)
574 # 11-15 (5) Hour (0-23 on a 24-hour clock)
575 # 16-20 (5) Day of the month (1-31)
576 # 21-24 (4) Month (1 = January, 2 = February, etc.)
577 # 25-31 (7) Year offset from 1980 (add 1980 to get actual year)
579 # Convert DOS date/time format to unix time_t format
580 # NOT AN OBJECT METHOD!
583 return time() unless defined($dt);
585 my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
586 my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
587 my $mday = ( ( $dt >> 16 ) & 0x1f );
589 my $hour = ( ( $dt >> 11 ) & 0x1f );
590 my $min = ( ( $dt >> 5 ) & 0x3f );
591 my $sec = ( ( $dt << 1 ) & 0x3e );
595 eval { Time
::Local
::timelocal
( $sec, $min, $hour, $mday, $mon, $year ); };
596 return time() if ($@
);
600 # Note, this isn't exactly UTC 1980, it's 1980 + 12 hours and 1
601 # minute so that nothing timezoney can muck us up.
602 my $safe_epoch = 315576060;
604 # convert a unix time to DOS date/time
605 # NOT AN OBJECT METHOD!
609 _error
("Tried to add member with zero or undef value for time");
610 $time_t = $safe_epoch;
612 if ( $time_t < $safe_epoch ) {
613 _ioError
("Unsupported date before 1980 encountered, moving to 1980");
614 $time_t = $safe_epoch;
616 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
618 $dt += ( $sec >> 1 );
619 $dt += ( $min << 5 );
620 $dt += ( $hour << 11 );
621 $dt += ( $mday << 16 );
622 $dt += ( ( $mon + 1 ) << 21 );
623 $dt += ( ( $year - 80 ) << 25 );
627 # Write my local header to a file handle.
628 # Stores the offset to the start of the header in my
629 # writeLocalHeaderRelativeOffset member.
630 # Returns AZ_OK on success.
631 sub _writeLocalFileHeader
{
635 my $signatureData = pack( SIGNATURE_FORMAT
, LOCAL_FILE_HEADER_SIGNATURE
);
636 $self->_print($fh, $signatureData)
637 or return _ioError
("writing local header signature");
640 LOCAL_FILE_HEADER_FORMAT
,
641 $self->versionNeededToExtract(),
643 $self->desiredCompressionMethod(),
644 $self->lastModFileDateTime(),
646 $self->compressedSize(), # may need to be re-written later
647 $self->uncompressedSize(),
648 length( $self->fileName() ),
649 length( $self->localExtraField() )
652 $self->_print($fh, $header) or return _ioError
("writing local header");
654 # Check for a valid filename or a filename equal to a literal `0'
655 if ( $self->fileName() || $self->fileName eq '0' ) {
656 $self->_print($fh, $self->fileName() )
657 or return _ioError
("writing local header filename");
659 if ( $self->localExtraField() ) {
660 $self->_print($fh, $self->localExtraField() )
661 or return _ioError
("writing local extra field");
667 sub _writeCentralDirectoryFileHeader
{
672 pack( SIGNATURE_FORMAT
, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
);
673 $self->_print($fh, $sigData)
674 or return _ioError
("writing central directory header signature");
676 my $fileNameLength = length( $self->fileName() );
677 my $extraFieldLength = length( $self->cdExtraField() );
678 my $fileCommentLength = length( $self->fileComment() );
681 CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
,
682 $self->versionMadeBy(),
683 $self->fileAttributeFormat(),
684 $self->versionNeededToExtract(),
686 $self->desiredCompressionMethod(),
687 $self->lastModFileDateTime(),
688 $self->crc32(), # these three fields should have been updated
689 $self->_writeOffset(), # by writing the data stream out
690 $self->uncompressedSize(), #
694 0, # {'diskNumberStart'},
695 $self->internalFileAttributes(),
696 $self->externalFileAttributes(),
697 $self->writeLocalHeaderRelativeOffset()
700 $self->_print($fh, $header)
701 or return _ioError
("writing central directory header");
702 if ($fileNameLength) {
703 $self->_print($fh, $self->fileName() )
704 or return _ioError
("writing central directory header signature");
706 if ($extraFieldLength) {
707 $self->_print($fh, $self->cdExtraField() )
708 or return _ioError
("writing central directory extra field");
710 if ($fileCommentLength) {
711 $self->_print($fh, $self->fileComment() )
712 or return _ioError
("writing central directory file comment");
718 # This writes a data descriptor to the given file handle.
719 # Assumes that crc32, writeOffset, and uncompressedSize are
720 # set correctly (they should be after a write).
721 # Further, the local file header should have the
722 # GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
723 sub _writeDataDescriptor
{
727 SIGNATURE_FORMAT
. DATA_DESCRIPTOR_FORMAT
,
728 DATA_DESCRIPTOR_SIGNATURE
,
730 $self->_writeOffset(), # compressed size
731 $self->uncompressedSize()
734 $self->_print($fh, $header)
735 or return _ioError
("writing data descriptor");
739 # Re-writes the local file header with new crc32 and compressedSize fields.
740 # To be called after writing the data stream.
741 # Assumes that filename and extraField sizes didn't change since last written.
742 sub _refreshLocalFileHeader
{
746 my $here = $fh->tell();
747 $fh->seek( $self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH
,
748 IO
::Seekable
::SEEK_SET
)
749 or return _ioError
("seeking to rewrite local header");
752 LOCAL_FILE_HEADER_FORMAT
,
753 $self->versionNeededToExtract(),
755 $self->desiredCompressionMethod(),
756 $self->lastModFileDateTime(),
758 $self->_writeOffset(), # compressed size
759 $self->uncompressedSize(),
760 length( $self->fileName() ),
761 length( $self->localExtraField() )
764 $self->_print($fh, $header)
765 or return _ioError
("re-writing local header");
766 $fh->seek( $here, IO
::Seekable
::SEEK_SET
)
767 or return _ioError
("seeking after rewrite of local header");
774 my $chunkSize = ( ref( $_[0] ) eq 'HASH' ) ?
$_[0]->{chunkSize
} : $_[0];
776 if ( $self->readIsDone() ) {
779 return ( \
$dummy, AZ_STREAM_END
);
782 $chunkSize = $Archive::Zip
::ChunkSize
if not defined($chunkSize);
783 $chunkSize = $self->_readDataRemaining()
784 if $chunkSize > $self->_readDataRemaining();
788 my ( $bytesRead, $status ) = $self->_readRawChunk( \
$buffer, $chunkSize );
789 return ( \
$buffer, $status ) unless $status == AZ_OK
;
791 $self->{'readDataRemaining'} -= $bytesRead;
792 $self->{'readOffset'} += $bytesRead;
794 if ( $self->compressionMethod() == COMPRESSION_STORED
) {
795 $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
798 ( $outputRef, $status ) = &{ $self->{'chunkHandler'} }( $self, \
$buffer );
799 $self->{'writeOffset'} += length($$outputRef);
802 if $self->readIsDone();
804 return ( $outputRef, $status );
807 # Read the next raw chunk of my data. Subclasses MUST implement.
808 # my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
811 return $self->_subclassResponsibility();
814 # A place holder to catch rewindData errors if someone ignores
818 return ( \
undef, _error
("trying to copy chunk when init failed") );
821 # Basically a no-op so that I can have a consistent interface.
822 # ( $outputRef, $status) = $self->_copyChunk( \$buffer );
824 my ( $self, $dataRef ) = @_;
825 return ( $dataRef, AZ_OK
);
828 # ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
830 my ( $self, $buffer ) = @_;
831 my ( $status ) = $self->_deflater()->deflate( $buffer, my $out );
833 if ( $self->_readDataRemaining() == 0 ) {
835 ( $status ) = $self->_deflater()->flush($extraOutput);
836 $out .= $extraOutput;
838 return ( \
$out, AZ_STREAM_END
);
840 elsif ( $status == Z_OK
) {
841 return ( \
$out, AZ_OK
);
845 my $retval = _error
( 'deflate error', $status );
847 return ( \
$dummy, $retval );
851 # ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
853 my ( $self, $buffer ) = @_;
854 my ( $status ) = $self->_inflater()->inflate( $buffer, my $out );
856 $self->endRead() unless $status == Z_OK
;
857 if ( $status == Z_OK
|| $status == Z_STREAM_END
) {
858 $retval = ( $status == Z_STREAM_END
) ? AZ_STREAM_END
: AZ_OK
;
859 return ( \
$out, $retval );
862 $retval = _error
( 'inflate error', $status );
864 return ( \
$dummy, $retval );
872 # set to trap init errors
873 $self->{'chunkHandler'} = $self->can('_noChunk');
875 # Work around WinZip bug with 0-length DEFLATED files
876 $self->desiredCompressionMethod(COMPRESSION_STORED
)
877 if $self->uncompressedSize() == 0;
879 # assume that we're going to read the whole file, and compute the CRC anew.
881 if ( $self->compressionMethod() == COMPRESSION_STORED
);
883 # These are the only combinations of methods we deal with right now.
884 if ( $self->compressionMethod() == COMPRESSION_STORED
885 and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED
)
887 ( $self->{'deflater'}, $status ) = Compress
::Raw
::Zlib
::Deflate
->new(
888 '-Level' => $self->desiredCompressionLevel(),
889 '-WindowBits' => -MAX_WBITS
(), # necessary magic
890 '-Bufsize' => $Archive::Zip
::ChunkSize
,
892 ); # pass additional options
893 return _error
( 'deflateInit error:', $status )
894 unless $status == Z_OK
;
895 $self->{'chunkHandler'} = $self->can('_deflateChunk');
897 elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
898 and $self->desiredCompressionMethod() == COMPRESSION_STORED
)
900 ( $self->{'inflater'}, $status ) = Compress
::Raw
::Zlib
::Inflate
->new(
901 '-WindowBits' => -MAX_WBITS
(), # necessary magic
902 '-Bufsize' => $Archive::Zip
::ChunkSize
,
904 ); # pass additional options
905 return _error
( 'inflateInit error:', $status )
906 unless $status == Z_OK
;
907 $self->{'chunkHandler'} = $self->can('_inflateChunk');
909 elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() ) {
910 $self->{'chunkHandler'} = $self->can('_copyChunk');
915 "Unsupported compression combination: read %d, write %d",
916 $self->compressionMethod(),
917 $self->desiredCompressionMethod()
922 $self->{'readDataRemaining'} =
923 ( $self->compressionMethod() == COMPRESSION_STORED
)
924 ?
$self->uncompressedSize()
925 : $self->compressedSize();
926 $self->{'dataEnded'} = 0;
927 $self->{'readOffset'} = 0;
934 delete $self->{'inflater'};
935 delete $self->{'deflater'};
936 $self->{'dataEnded'} = 1;
937 $self->{'readDataRemaining'} = 0;
943 return ( $self->_dataEnded() or !$self->_readDataRemaining() );
948 my $newContents = shift;
950 if ( defined($newContents) ) {
952 # change our type and call the subclass contents method.
953 $self->_become(STRINGMEMBERCLASS
);
954 return $self->contents( pack( 'C0a*', $newContents ) )
955 ; # in case of Unicode
959 $self->desiredCompressionMethod(COMPRESSION_STORED
);
960 my $status = $self->rewindData(@_);
961 if ( $status != AZ_OK
) {
966 while ( $status == AZ_OK
) {
968 ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
970 # did we get it in one chunk?
971 if ( length($$ref) == $self->uncompressedSize() ) {
974 else { $retval .= $$ref }
976 $self->desiredCompressionMethod($oldCompression);
978 $status = AZ_OK
if $status == AZ_STREAM_END
;
979 $retval = undef unless $status == AZ_OK
;
980 return wantarray ?
( $retval, $status ) : $retval;
984 sub extractToFileHandle
{
986 return _error
("encryption unsupported") if $self->isEncrypted();
987 my $fh = ( ref( $_[0] ) eq 'HASH' ) ?
shift->{fileHandle
} : shift;
989 my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED
);
990 my $status = $self->rewindData(@_);
991 $status = $self->_writeData($fh) if $status == AZ_OK
;
992 $self->desiredCompressionMethod($oldCompression);
997 # write local header and data stream to file handle
998 sub _writeToFileHandle
{
1001 my $fhIsSeekable = shift;
1004 return _error
("no member name given for $self")
1005 if $self->fileName() eq '';
1007 $self->{'writeLocalHeaderRelativeOffset'} = $offset;
1008 $self->{'wasWritten'} = 0;
1010 # Determine if I need to write a data descriptor
1011 # I need to do this if I can't refresh the header
1012 # and I don't know compressed size or crc32 fields.
1013 my $headerFieldsUnknown = (
1014 ( $self->uncompressedSize() > 0 )
1015 and ($self->compressionMethod() == COMPRESSION_STORED
1016 or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED
)
1019 my $shouldWriteDataDescriptor =
1020 ( $headerFieldsUnknown and not $fhIsSeekable );
1022 $self->hasDataDescriptor(1)
1023 if ($shouldWriteDataDescriptor);
1025 $self->{'writeOffset'} = 0;
1027 my $status = $self->rewindData();
1028 ( $status = $self->_writeLocalFileHeader($fh) )
1029 if $status == AZ_OK
;
1030 ( $status = $self->_writeData($fh) )
1031 if $status == AZ_OK
;
1032 if ( $status == AZ_OK
) {
1033 $self->{'wasWritten'} = 1;
1034 if ( $self->hasDataDescriptor() ) {
1035 $status = $self->_writeDataDescriptor($fh);
1037 elsif ($headerFieldsUnknown) {
1038 $status = $self->_refreshLocalFileHeader($fh);
1045 # Copy my (possibly compressed) data to given file handle.
1046 # Returns C<AZ_OK> on success
1049 my $writeFh = shift;
1051 # If symbolic link, just create one if the operating system is Linux, Unix, BSD or VMS
1052 # TODO: Add checks for other operating systems
1053 if ( $self->{'isSymbolicLink'} == 1 && $^O
eq 'linux' ) {
1054 my $chunkSize = $Archive::Zip
::ChunkSize
;
1055 my ( $outRef, $status ) = $self->readChunk($chunkSize);
1056 symlink $$outRef, $self->{'newName'};
1058 return AZ_OK
if ( $self->uncompressedSize() == 0 );
1060 my $chunkSize = $Archive::Zip
::ChunkSize
;
1061 while ( $self->_readDataRemaining() > 0 ) {
1063 ( $outRef, $status ) = $self->readChunk($chunkSize);
1064 return $status if ( $status != AZ_OK
and $status != AZ_STREAM_END
);
1066 if ( length($$outRef) > 0 ) {
1067 $self->_print($writeFh, $$outRef)
1068 or return _ioError
("write error during copy");
1071 last if $status == AZ_STREAM_END
;
1073 $self->{'compressedSize'} = $self->_writeOffset();
1078 # Return true if I depend on the named file
1079 sub _usesFileNamed
{