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(@_);
48 my $self = $class->STRINGMEMBERCLASS->_newFromString(@_);
54 my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed(@_);
58 sub newDirectoryNamed
{
60 my $self = $class->DIRECTORYMEMBERCLASS->_newNamed(@_);
67 'lastModFileDateTime' => 0,
68 'fileAttributeFormat' => FA_UNIX
,
69 'versionMadeBy' => 20,
70 'versionNeededToExtract' => 20,
72 'compressionMethod' => COMPRESSION_STORED
,
73 'desiredCompressionMethod' => COMPRESSION_STORED
,
74 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE
,
75 'internalFileAttributes' => 0,
76 'externalFileAttributes' => 0, # set later
79 'localExtraField' => '',
82 'compressedSize' => 0,
83 'uncompressedSize' => 0,
84 'isSymbolicLink' => 0,
87 bless( $self, $class );
88 $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
92 sub _becomeDirectoryIfNecessary
{
94 $self->_become(DIRECTORYMEMBERCLASS
)
95 if $self->isDirectory();
99 # Morph into given class (do whatever cleanup I need to do)
101 return bless( $_[0], $_[1] );
105 shift->{'versionMadeBy'};
108 sub fileAttributeFormat
{
110 ?
( $_[0]->{'fileAttributeFormat'} = $_[1] )
111 : $_[0]->{'fileAttributeFormat'};
114 sub versionNeededToExtract
{
115 shift->{'versionNeededToExtract'};
121 # Set General Purpose Bit Flags according to the desiredCompressionLevel setting
122 if ( $self->desiredCompressionLevel == 1 || $self->desiredCompressionLevel == 2 ) {
123 $self->{'bitFlag'} = DEFLATING_COMPRESSION_FAST
;
124 } elsif ( $self->desiredCompressionLevel == 3 || $self->desiredCompressionLevel == 4
125 || $self->desiredCompressionLevel == 5 || $self->desiredCompressionLevel == 6
126 || $self->desiredCompressionLevel == 7 ) {
127 $self->{'bitFlag'} = DEFLATING_COMPRESSION_NORMAL
;
128 } elsif ( $self->desiredCompressionLevel == 8 || $self->desiredCompressionLevel == 9 ) {
129 $self->{'bitFlag'} = DEFLATING_COMPRESSION_MAXIMUM
;
134 sub compressionMethod
{
135 shift->{'compressionMethod'};
138 sub desiredCompressionMethod
{
140 my $newDesiredCompressionMethod = shift;
141 my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
142 if ( defined($newDesiredCompressionMethod) ) {
143 $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
144 if ( $newDesiredCompressionMethod == COMPRESSION_STORED
) {
145 $self->{'desiredCompressionLevel'} = 0;
146 $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
;
148 } elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED
) {
149 $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT
;
152 return $oldDesiredCompressionMethod;
155 sub desiredCompressionLevel
{
157 my $newDesiredCompressionLevel = shift;
158 my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
159 if ( defined($newDesiredCompressionLevel) ) {
160 $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
161 $self->{'desiredCompressionMethod'} = (
162 $newDesiredCompressionLevel
163 ? COMPRESSION_DEFLATED
167 return $oldDesiredCompressionLevel;
174 $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems
175 $self->{'fileName'} = $newName;
177 return $self->{'fileName'};
180 sub lastModFileDateTime
{
181 my $modTime = shift->{'lastModFileDateTime'};
182 $modTime =~ m/^(\d+)$/; # untaint
188 return _dosToUnixTime
( $self->lastModFileDateTime() );
191 sub setLastModFileDateTimeFromUnix
{
194 $self->{'lastModFileDateTime'} = _unixToDosTime
($time_t);
197 sub internalFileAttributes
{
198 shift->{'internalFileAttributes'};
201 sub externalFileAttributes
{
202 shift->{'externalFileAttributes'};
205 # Convert UNIX permissions into proper value for zip file
206 # Usable as a function or a method
207 sub _mapPermissionsFromUnix
{
210 my $attribs = $mode << 16;
212 # Microsoft Windows Explorer needs this bit set for directories
213 if ( $mode & DIRECTORY_ATTRIB
) {
219 # TODO: map more MS-DOS perms
222 # Convert ZIP permissions into Unix ones
224 # This was taken from Info-ZIP group's portable UnZip
225 # zipfile-extraction program, version 5.50.
226 # http://www.info-zip.org/pub/infozip/
228 # See the mapattr() function in unix/unix.c
229 # See the attribute format constants in unzpriv.h
231 # XXX Note that there's one situation that isn't implemented
232 # yet that depends on the "extra field."
233 sub _mapPermissionsToUnix
{
236 my $format = $self->{'fileAttributeFormat'};
237 my $attribs = $self->{'externalFileAttributes'};
241 if ( $format == FA_AMIGA
) {
242 $attribs = $attribs >> 17 & 7; # Amiga RWE bits
243 $mode = $attribs << 6 | $attribs << 3 | $attribs;
247 if ( $format == FA_THEOS
) {
248 $attribs &= 0xF1FFFFFF;
249 if ( ( $attribs & 0xF0000000 ) != 0x40000000 ) {
250 $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits
253 $attribs &= 0x41FFFFFF; # leave directory bit as set
257 if ( $format == FA_UNIX
258 || $format == FA_VAX_VMS
259 || $format == FA_ACORN
260 || $format == FA_ATARI_ST
261 || $format == FA_BEOS
262 || $format == FA_QDOS
263 || $format == FA_TANDEM
)
265 $mode = $attribs >> 16;
266 return $mode if $mode != 0 or not $self->localExtraField;
268 # warn("local extra field is: ", $self->localExtraField, "\n");
270 # XXX This condition is not implemented
271 # I'm just including the comments from the info-zip section for now.
273 # Some (non-Info-ZIP) implementations of Zip for Unix and
274 # VMS (and probably others ??) leave 0 in the upper 16-bit
275 # part of the external_file_attributes field. Instead, they
276 # store file permission attributes in some extra field.
277 # As a work-around, we search for the presence of one of
278 # these extra fields and fall back to the MSDOS compatible
279 # part of external_file_attributes if one of the known
280 # e.f. types has been detected.
281 # Later, we might implement extraction of the permission
282 # bits from the VMS extra field. But for now, the work-around
283 # should be sufficient to provide "readable" extracted files.
284 # (For ASI Unix e.f., an experimental remap from the e.f.
285 # mode value IS already provided!)
288 # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the
289 # Unix attributes in the upper 16 bits of the external attributes
290 # field, just like Info-ZIP's Zip for Unix. We try to use that
291 # value, after a check for consistency with the MSDOS attribute
293 if ( $format == FA_MSDOS
) {
294 $mode = $attribs >> 16;
297 # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20
298 $attribs = !( $attribs & 1 ) << 1 | ( $attribs & 0x10 ) >> 4;
300 # keep previous $mode setting when its "owner"
301 # part appears to be consistent with DOS attribute flags!
302 return $mode if ( $mode & 0700 ) == ( 0400 | $attribs << 6 );
303 $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
307 sub unixFileAttributes
{
309 my $oldPerms = $self->_mapPermissionsToUnix;
312 if ( $self->isDirectory ) {
313 $perms &= ~FILE_ATTRIB
;
314 $perms |= DIRECTORY_ATTRIB
;
316 $perms &= ~DIRECTORY_ATTRIB
;
317 $perms |= FILE_ATTRIB
;
319 $self->{externalFileAttributes
} = $self->_mapPermissionsFromUnix($perms);
324 sub localExtraField
{
326 ?
( $_[0]->{'localExtraField'} = $_[1] )
327 : $_[0]->{'localExtraField'};
331 ( $#_ > 0 ) ?
( $_[0]->{'cdExtraField'} = $_[1] ) : $_[0]->{'cdExtraField'};
336 return $self->localExtraField() . $self->cdExtraField();
341 ?
( $_[0]->{'fileComment'} = pack( 'C0a*', $_[1] ) )
342 : $_[0]->{'fileComment'};
345 sub hasDataDescriptor
{
348 my $shouldHave = shift;
350 $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK
;
353 $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK
;
356 return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK
;
364 sprintf( "%08x", shift->{'crc32'} );
368 shift->{'compressedSize'};
371 sub uncompressedSize
{
372 shift->{'uncompressedSize'};
376 shift->bitFlag() & GPBF_ENCRYPTED_MASK
;
381 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK
;
384 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK
;
385 $self->{'internalFileAttributes'} |=
386 ( $flag ? IFA_TEXT_FILE
: IFA_BINARY_FILE
);
388 return $bit == IFA_TEXT_FILE
;
393 my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK
;
396 $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK
;
397 $self->{'internalFileAttributes'} |=
398 ( $flag ? IFA_BINARY_FILE
: IFA_TEXT_FILE
);
400 return $bit == IFA_BINARY_FILE
;
403 sub extractToFileNamed
{
405 my $name = shift; # local FS name
406 $self->{'isSymbolicLink'} = 0;
408 # Check if the file / directory is a symbolic link or not
409 if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
410 $self->{'isSymbolicLink'} = 1;
411 $self->{'newName'} = $name;
412 my ( $status, $fh ) = _newFileHandle
( $name, 'r' );
413 my $retval = $self->extractToFileHandle($fh);
416 #return _writeSymbolicLink($self, $name) if $self->isSymbolicLink();
417 return _error
("encryption unsupported") if $self->isEncrypted();
418 mkpath
( dirname
($name) ); # croaks on error
419 my ( $status, $fh ) = _newFileHandle
( $name, 'w' );
420 return _ioError
("Can't open file $name for write") unless $status;
421 my $retval = $self->extractToFileHandle($fh);
423 chmod ($self->unixFileAttributes(), $name)
424 or return _error
("Can't chmod() ${name}: $!");
425 utime( $self->lastModTime(), $self->lastModTime(), $name );
430 sub _writeSymbolicLink
{
433 my $chunkSize = $Archive::Zip
::ChunkSize
;
434 #my ( $outRef, undef ) = $self->readChunk($chunkSize);
436 my $retval = $self->extractToFileHandle($fh);
437 my ( $outRef, undef ) = $self->readChunk(100);
442 if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
443 $self->{'isSymbolicLink'} = 1;
454 sub externalFileName
{
458 # The following are used when copying data
460 shift->{'writeOffset'};
464 shift->{'readOffset'};
467 sub writeLocalHeaderRelativeOffset
{
468 shift->{'writeLocalHeaderRelativeOffset'};
471 sub wasWritten
{ shift->{'wasWritten'} }
474 shift->{'dataEnded'};
477 sub _readDataRemaining
{
478 shift->{'readDataRemaining'};
489 # Return the total size of my local header
490 sub _localHeaderSize
{
492 return SIGNATURE_LENGTH
+ LOCAL_FILE_HEADER_LENGTH
+
493 length( $self->fileName() ) + length( $self->localExtraField() );
496 # Return the total size of my CD header
497 sub _centralDirectoryHeaderSize
{
499 return SIGNATURE_LENGTH
+ CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+
500 length( $self->fileName() ) + length( $self->cdExtraField() ) +
501 length( $self->fileComment() );
504 # DOS date/time format
505 # 0-4 (5) Second divided by 2
506 # 5-10 (6) Minute (0-59)
507 # 11-15 (5) Hour (0-23 on a 24-hour clock)
508 # 16-20 (5) Day of the month (1-31)
509 # 21-24 (4) Month (1 = January, 2 = February, etc.)
510 # 25-31 (7) Year offset from 1980 (add 1980 to get actual year)
512 # Convert DOS date/time format to unix time_t format
513 # NOT AN OBJECT METHOD!
516 return time() unless defined($dt);
518 my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
519 my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
520 my $mday = ( ( $dt >> 16 ) & 0x1f );
522 my $hour = ( ( $dt >> 11 ) & 0x1f );
523 my $min = ( ( $dt >> 5 ) & 0x3f );
524 my $sec = ( ( $dt << 1 ) & 0x3e );
528 eval { Time
::Local
::timelocal
( $sec, $min, $hour, $mday, $mon, $year ); };
529 return time() if ($@
);
533 # Note, this isn't exactly UTC 1980, it's 1980 + 12 hours and 1
534 # minute so that nothing timezoney can muck us up.
535 my $safe_epoch = 315576060;
537 # convert a unix time to DOS date/time
538 # NOT AN OBJECT METHOD!
542 _error
("Tried to add member with zero or undef value for time");
543 $time_t = $safe_epoch;
545 if ( $time_t < $safe_epoch ) {
546 _ioError
("Unsupported date before 1980 encountered, moving to 1980");
547 $time_t = $safe_epoch;
549 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
551 $dt += ( $sec >> 1 );
552 $dt += ( $min << 5 );
553 $dt += ( $hour << 11 );
554 $dt += ( $mday << 16 );
555 $dt += ( ( $mon + 1 ) << 21 );
556 $dt += ( ( $year - 80 ) << 25 );
560 # Write my local header to a file handle.
561 # Stores the offset to the start of the header in my
562 # writeLocalHeaderRelativeOffset member.
563 # Returns AZ_OK on success.
564 sub _writeLocalFileHeader
{
568 my $signatureData = pack( SIGNATURE_FORMAT
, LOCAL_FILE_HEADER_SIGNATURE
);
569 $self->_print($fh, $signatureData)
570 or return _ioError
("writing local header signature");
573 LOCAL_FILE_HEADER_FORMAT
,
574 $self->versionNeededToExtract(),
576 $self->desiredCompressionMethod(),
577 $self->lastModFileDateTime(),
579 $self->compressedSize(), # may need to be re-written later
580 $self->uncompressedSize(),
581 length( $self->fileName() ),
582 length( $self->localExtraField() )
585 $self->_print($fh, $header) or return _ioError
("writing local header");
587 # Check for a valid filename or a filename equal to a literal `0'
588 if ( $self->fileName() || $self->fileName eq '0' ) {
589 $self->_print($fh, $self->fileName() )
590 or return _ioError
("writing local header filename");
592 if ( $self->localExtraField() ) {
593 $self->_print($fh, $self->localExtraField() )
594 or return _ioError
("writing local extra field");
600 sub _writeCentralDirectoryFileHeader
{
605 pack( SIGNATURE_FORMAT
, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
);
606 $self->_print($fh, $sigData)
607 or return _ioError
("writing central directory header signature");
609 my $fileNameLength = length( $self->fileName() );
610 my $extraFieldLength = length( $self->cdExtraField() );
611 my $fileCommentLength = length( $self->fileComment() );
614 CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
,
615 $self->versionMadeBy(),
616 $self->fileAttributeFormat(),
617 $self->versionNeededToExtract(),
619 $self->desiredCompressionMethod(),
620 $self->lastModFileDateTime(),
621 $self->crc32(), # these three fields should have been updated
622 $self->_writeOffset(), # by writing the data stream out
623 $self->uncompressedSize(), #
627 0, # {'diskNumberStart'},
628 $self->internalFileAttributes(),
629 $self->externalFileAttributes(),
630 $self->writeLocalHeaderRelativeOffset()
633 $self->_print($fh, $header)
634 or return _ioError
("writing central directory header");
635 if ($fileNameLength) {
636 $self->_print($fh, $self->fileName() )
637 or return _ioError
("writing central directory header signature");
639 if ($extraFieldLength) {
640 $self->_print($fh, $self->cdExtraField() )
641 or return _ioError
("writing central directory extra field");
643 if ($fileCommentLength) {
644 $self->_print($fh, $self->fileComment() )
645 or return _ioError
("writing central directory file comment");
651 # This writes a data descriptor to the given file handle.
652 # Assumes that crc32, writeOffset, and uncompressedSize are
653 # set correctly (they should be after a write).
654 # Further, the local file header should have the
655 # GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
656 sub _writeDataDescriptor
{
660 SIGNATURE_FORMAT
. DATA_DESCRIPTOR_FORMAT
,
661 DATA_DESCRIPTOR_SIGNATURE
,
663 $self->_writeOffset(), # compressed size
664 $self->uncompressedSize()
667 $self->_print($fh, $header)
668 or return _ioError
("writing data descriptor");
672 # Re-writes the local file header with new crc32 and compressedSize fields.
673 # To be called after writing the data stream.
674 # Assumes that filename and extraField sizes didn't change since last written.
675 sub _refreshLocalFileHeader
{
679 my $here = $fh->tell();
680 $fh->seek( $self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH
,
681 IO
::Seekable
::SEEK_SET
)
682 or return _ioError
("seeking to rewrite local header");
685 LOCAL_FILE_HEADER_FORMAT
,
686 $self->versionNeededToExtract(),
688 $self->desiredCompressionMethod(),
689 $self->lastModFileDateTime(),
691 $self->_writeOffset(), # compressed size
692 $self->uncompressedSize(),
693 length( $self->fileName() ),
694 length( $self->localExtraField() )
697 $self->_print($fh, $header)
698 or return _ioError
("re-writing local header");
699 $fh->seek( $here, IO
::Seekable
::SEEK_SET
)
700 or return _ioError
("seeking after rewrite of local header");
706 my ( $self, $chunkSize ) = @_;
708 if ( $self->readIsDone() ) {
711 return ( \
$dummy, AZ_STREAM_END
);
714 $chunkSize = $Archive::Zip
::ChunkSize
if not defined($chunkSize);
715 $chunkSize = $self->_readDataRemaining()
716 if $chunkSize > $self->_readDataRemaining();
720 my ( $bytesRead, $status ) = $self->_readRawChunk( \
$buffer, $chunkSize );
721 return ( \
$buffer, $status ) unless $status == AZ_OK
;
723 $self->{'readDataRemaining'} -= $bytesRead;
724 $self->{'readOffset'} += $bytesRead;
726 if ( $self->compressionMethod() == COMPRESSION_STORED
) {
727 $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
730 ( $outputRef, $status ) = &{ $self->{'chunkHandler'} }( $self, \
$buffer );
731 $self->{'writeOffset'} += length($$outputRef);
734 if $self->readIsDone();
736 return ( $outputRef, $status );
739 # Read the next raw chunk of my data. Subclasses MUST implement.
740 # my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
743 return $self->_subclassResponsibility();
746 # A place holder to catch rewindData errors if someone ignores
750 return ( \
undef, _error
("trying to copy chunk when init failed") );
753 # Basically a no-op so that I can have a consistent interface.
754 # ( $outputRef, $status) = $self->_copyChunk( \$buffer );
756 my ( $self, $dataRef ) = @_;
757 return ( $dataRef, AZ_OK
);
760 # ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
762 my ( $self, $buffer ) = @_;
763 my ( $status ) = $self->_deflater()->deflate( $buffer, my $out );
765 if ( $self->_readDataRemaining() == 0 ) {
767 ( $status ) = $self->_deflater()->flush($extraOutput);
768 $out .= $extraOutput;
770 return ( \
$out, AZ_STREAM_END
);
772 elsif ( $status == Z_OK
) {
773 return ( \
$out, AZ_OK
);
777 my $retval = _error
( 'deflate error', $status );
779 return ( \
$dummy, $retval );
783 # ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
785 my ( $self, $buffer ) = @_;
786 my ( $status ) = $self->_inflater()->inflate( $buffer, my $out );
788 $self->endRead() unless $status == Z_OK
;
789 if ( $status == Z_OK
|| $status == Z_STREAM_END
) {
790 $retval = ( $status == Z_STREAM_END
) ? AZ_STREAM_END
: AZ_OK
;
791 return ( \
$out, $retval );
794 $retval = _error
( 'inflate error', $status );
796 return ( \
$dummy, $retval );
804 # set to trap init errors
805 $self->{'chunkHandler'} = $self->can('_noChunk');
807 # Work around WinZip bug with 0-length DEFLATED files
808 $self->desiredCompressionMethod(COMPRESSION_STORED
)
809 if $self->uncompressedSize() == 0;
811 # assume that we're going to read the whole file, and compute the CRC anew.
813 if ( $self->compressionMethod() == COMPRESSION_STORED
);
815 # These are the only combinations of methods we deal with right now.
816 if ( $self->compressionMethod() == COMPRESSION_STORED
817 and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED
)
819 ( $self->{'deflater'}, $status ) = Compress
::Raw
::Zlib
::Deflate
->new(
820 '-Level' => $self->desiredCompressionLevel(),
821 '-WindowBits' => -MAX_WBITS
(), # necessary magic
822 '-Bufsize' => $Archive::Zip
::ChunkSize
,
824 ); # pass additional options
825 return _error
( 'deflateInit error:', $status )
826 unless $status == Z_OK
;
827 $self->{'chunkHandler'} = $self->can('_deflateChunk');
829 elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
830 and $self->desiredCompressionMethod() == COMPRESSION_STORED
)
832 ( $self->{'inflater'}, $status ) = Compress
::Raw
::Zlib
::Inflate
->new(
833 '-WindowBits' => -MAX_WBITS
(), # necessary magic
834 '-Bufsize' => $Archive::Zip
::ChunkSize
,
836 ); # pass additional options
837 return _error
( 'inflateInit error:', $status )
838 unless $status == Z_OK
;
839 $self->{'chunkHandler'} = $self->can('_inflateChunk');
841 elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() ) {
842 $self->{'chunkHandler'} = $self->can('_copyChunk');
847 "Unsupported compression combination: read %d, write %d",
848 $self->compressionMethod(),
849 $self->desiredCompressionMethod()
854 $self->{'readDataRemaining'} =
855 ( $self->compressionMethod() == COMPRESSION_STORED
)
856 ?
$self->uncompressedSize()
857 : $self->compressedSize();
858 $self->{'dataEnded'} = 0;
859 $self->{'readOffset'} = 0;
866 delete $self->{'inflater'};
867 delete $self->{'deflater'};
868 $self->{'dataEnded'} = 1;
869 $self->{'readDataRemaining'} = 0;
875 return ( $self->_dataEnded() or !$self->_readDataRemaining() );
880 my $newContents = shift;
882 if ( defined($newContents) ) {
884 # change our type and call the subclass contents method.
885 $self->_become(STRINGMEMBERCLASS
);
886 return $self->contents( pack( 'C0a*', $newContents ) )
887 ; # in case of Unicode
891 $self->desiredCompressionMethod(COMPRESSION_STORED
);
892 my $status = $self->rewindData(@_);
893 if ( $status != AZ_OK
) {
898 while ( $status == AZ_OK
) {
900 ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
902 # did we get it in one chunk?
903 if ( length($$ref) == $self->uncompressedSize() ) {
906 else { $retval .= $$ref }
908 $self->desiredCompressionMethod($oldCompression);
910 $status = AZ_OK
if $status == AZ_STREAM_END
;
911 $retval = undef unless $status == AZ_OK
;
912 return wantarray ?
( $retval, $status ) : $retval;
916 sub extractToFileHandle
{
918 return _error
("encryption unsupported") if $self->isEncrypted();
921 my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED
);
922 my $status = $self->rewindData(@_);
923 $status = $self->_writeData($fh) if $status == AZ_OK
;
924 $self->desiredCompressionMethod($oldCompression);
929 # write local header and data stream to file handle
930 sub _writeToFileHandle
{
933 my $fhIsSeekable = shift;
936 return _error
("no member name given for $self")
937 if $self->fileName() eq '';
939 $self->{'writeLocalHeaderRelativeOffset'} = $offset;
940 $self->{'wasWritten'} = 0;
942 # Determine if I need to write a data descriptor
943 # I need to do this if I can't refresh the header
944 # and I don't know compressed size or crc32 fields.
945 my $headerFieldsUnknown = (
946 ( $self->uncompressedSize() > 0 )
947 and ($self->compressionMethod() == COMPRESSION_STORED
948 or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED
)
951 my $shouldWriteDataDescriptor =
952 ( $headerFieldsUnknown and not $fhIsSeekable );
954 $self->hasDataDescriptor(1)
955 if ($shouldWriteDataDescriptor);
957 $self->{'writeOffset'} = 0;
959 my $status = $self->rewindData();
960 ( $status = $self->_writeLocalFileHeader($fh) )
962 ( $status = $self->_writeData($fh) )
964 if ( $status == AZ_OK
) {
965 $self->{'wasWritten'} = 1;
966 if ( $self->hasDataDescriptor() ) {
967 $status = $self->_writeDataDescriptor($fh);
969 elsif ($headerFieldsUnknown) {
970 $status = $self->_refreshLocalFileHeader($fh);
977 # Copy my (possibly compressed) data to given file handle.
978 # Returns C<AZ_OK> on success
983 # If symbolic link, just create one if the operating system is Linux, Unix, BSD or VMS
984 # TODO: Add checks for other operating systems
985 if ( $self->{'isSymbolicLink'} == 1 && $^O
eq 'linux' ) {
986 my $chunkSize = $Archive::Zip
::ChunkSize
;
987 my ( $outRef, $status ) = $self->readChunk($chunkSize);
988 symlink $$outRef, $self->{'newName'};
990 return AZ_OK
if ( $self->uncompressedSize() == 0 );
992 my $chunkSize = $Archive::Zip
::ChunkSize
;
993 while ( $self->_readDataRemaining() > 0 ) {
995 ( $outRef, $status ) = $self->readChunk($chunkSize);
996 return $status if ( $status != AZ_OK
and $status != AZ_STREAM_END
);
998 if ( length($$outRef) > 0 ) {
999 $self->_print($writeFh, $$outRef)
1000 or return _ioError
("write error during copy");
1003 last if $status == AZ_STREAM_END
;
1005 $self->{'compressedSize'} = $self->_writeOffset();
1010 # Return true if I depend on the named file
1011 sub _usesFileNamed
{