PC Professionell 2004 December/PCpro_2004_12.ISO/files/webserver/tsw/TSW_3.4.0.exe/Apache2/perl/Zip.pm

Perl POD Document | 2003-11-26 | 80.1 KB | 2,979 lines

#! perl -w
# $Revision: 1.88 $

# Copyright (c) 2000-2002 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.

# ----------------------------------------------------------------------
# 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 File::Spec 0.8 ();

use vars
  qw( @ISA @EXPORT_OK %EXPORT_TAGS $VERSION $ChunkSize $ErrorHandler $TempSequence);

# 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 = "1.09";
    @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_TOPS20
      FA_WINDOWS_NTFS FA_QDOS FA_ACORN FA_VFAT FA_MVS FA_BEOS FA_TANDEM
      FA_THEOS 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 _printError _ioError _formatError
      _subclassResponsibility _binmode _isSeekable _newFileHandle _readSignature
      _asZipDirName);

    @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 -------------------

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_AMIGA        => 1;
use constant FA_VAX_VMS      => 2;
use constant FA_UNIX         => 3;
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_TOPS20       => 10;
use constant FA_WINDOWS_NTFS => 11;
use constant FA_QDOS         => 12;
use constant FA_ACORN        => 13;
use constant FA_VFAT         => 14;
use constant FA_MVS          => 15;
use constant FA_BEOS         => 16;
use constant FA_TANDEM       => 17;
use constant FA_THEOS        => 18;

# 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

# 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 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 ---------------------

use constant ZIPARCHIVECLASS => 'Archive::Zip::Archive';
use constant ZIPMEMBERCLASS  => 'Archive::Zip::Member';

sub new    # Archive::Zip
{
    my $class = shift;
    return $class->ZIPARCHIVECLASS->new(@_);
}

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 );
}

# Report or change chunk size used for reading and writing.
# Also sets Zlib's default buffer size (eventually).
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 if ($chunkSize);
    return $oldChunkSize;
}

sub chunkSize    # Archive::Zip
{
    return $Archive::Zip::ChunkSize;
}

sub setErrorHandler (&)    # Archive::Zip
{
    my $errorHandler = shift;
    $errorHandler = \&Carp::carp unless defined($errorHandler);
    my $oldErrorHandler = $Archive::Zip::ErrorHandler;
    $Archive::Zip::ErrorHandler = $errorHandler;
    return $oldErrorHandler;
}

# ----------------------------------------------------------------------
# Private utility functions (not methods).
# ----------------------------------------------------------------------

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 UNIVERSAL::can( $fh, 'binmode' ) ? $fh->binmode() : binmode($fh);
}

# Attempt to guess whether file handle is seekable.
# Because of problems with Windoze, this only returns true when
# the file handle is a real file.
sub _isSeekable    # Archive::Zip
{
    my $fh = shift;

    if ( UNIVERSAL::isa( $fh, 'IO::Scalar' ) )
    {
        return 0;
    }
    elsif ( UNIVERSAL::isa( $fh, 'IO::String' ) )
    {
        return 1;
    }
    elsif ( UNIVERSAL::can( $fh, 'stat' ) )
    {
        return -f $fh;
    }
    return UNIVERSAL::can( $fh, 'seek' );
}

# 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;

    if ( ref($fd) )
    {
        if ( UNIVERSAL::isa( $fd, 'IO::Scalar' )
            or UNIVERSAL::isa( $fd, 'IO::String' ) )
        {
            $handle = $fd;
        }
        elsif ( UNIVERSAL::isa( $fd, 'IO::Handle' )
            or UNIVERSAL::isa( $fd, 'GLOB' ) )
        {
            $handle = IO::File->new();
            $status = $handle->fdopen( $fd, @_ );
        }
        else
        {
            $handle = $fd;
        }
    }
    else
    {
        $handle = IO::File->new();
        $status = $handle->open( $fd, @_ );
    }

    return ( $status, $handle );
}

# Returns next signature from given file handle, leaves
# file handle positioned afterwards.
# In list context, returns ($status, $signature)
# ( $status, $signature) = _readSignature( $fh, $fileName );

sub _readSignature    # Archive::Zip
{
    my $fh                = shift;
    my $fileName          = shift;
    my $expectedSignature = shift;    # optional

    my $signatureData;
    my $bytesRead = $fh->read( $signatureData, SIGNATURE_LENGTH );
    return _ioError("reading header signature")
      if $bytesRead != SIGNATURE_LENGTH;
    my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
    my $status    = AZ_OK;

    # compare with expected signature, if any, or any known signature.
    if ( ( defined($expectedSignature) && $signature != $expectedSignature )
        || ( !defined($expectedSignature)
            && $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
            && $signature != LOCAL_FILE_HEADER_SIGNATURE
            && $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE ) )
    {
        my $errmsg = sprintf( "bad signature: 0x%08x", $signature );
        if ( _isSeekable($fh) )
        {
            $errmsg .=
              sprintf( " at offset %d", $fh->tell() - SIGNATURE_LENGTH );
        }

        $status = _formatError("$errmsg in file $fileName");
    }

    return ( $status, $signature );
}

# Utility method to make and open a temp file.
# Will create $temp_dir if it doesn't exist.
# Returns file handle and name:
#
# my ($fh, $name) = Archive::Zip::tempFile();
# my ($fh, $name) = Archive::Zip::tempFile('mytempdir');
#
BEGIN { $Archive::Zip::TempSequence = 0 }

sub tempFileName    # Archive::Zip
{
    my $temp_dir = shift;
    $temp_dir = ( -d '/tmp' ? '/tmp' : $ENV{TMPDIR} || $ENV{TEMP} || '.' )
      unless defined($temp_dir);
    unless ( -d $temp_dir )
    {
        mkdir( $temp_dir, 0777 )
          or die "Can't create temp directory $temp_dir\: $!\n";
    }
    my $base_name =
      sprintf( "%d-%d.%d", $$, time(), $Archive::Zip::TempSequence++ );
    return File::Spec->canonpath(
        File::Spec->catpath( '', $temp_dir, $base_name ) );
}

sub tempFile    # Archive::Zip
{
    my $full_name = tempFileName(@_);
    my $fh = IO::File->new( $full_name, '+>' );
    return defined($fh) ? ( $fh, $full_name ) : ();
}

# Return the normalized directory name as used in a zip file (path
# separators become slashes, etc.).
# Will translate internal slashes in path components (i.e. on Macs) to
# underscores.  Discards volume names.
# When $forceDir is set, returns paths with trailing slashes (or arrays
# with trailing blank members).
#
# If third argument is a reference, returns volume information there.
#
# input         output
# .                ('.')    '.'
# ./a            ('a')    a
# ./a/b            ('a','b')    a/b
# ./a/b/        ('a','b')    a/b
# a/b/            ('a','b')    a/b
# /a/b/            ('','a','b')    /a/b
# c:\a\b\c.doc    ('','a','b','c.doc')    /a/b/c.doc        # on Windoze
# "i/o maps:whatever"    ('i_o maps', 'whatever')  "i_o maps/whatever"    # on Macs
sub _asZipDirName    # Archive::Zip
{
    my $name      = shift;
    my $forceDir  = shift;
    my $volReturn = shift;
    my ( $volume, $directories, $file ) =
      File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
    $$volReturn = $volume if ( ref($volReturn) );
    my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories);
    if ( @dirs > 0 ) { pop (@dirs) unless $dirs[-1] }   # remove empty component
    push ( @dirs, $file || '' );
    return wantarray ? @dirs : join ( '/', @dirs );
}

# Return an absolute local name for a zip name.
# Assume a directory if zip name has trailing slash.
# Takes an optional volume name in FS format (like 'a:').
#
sub _asLocalName    # Archive::Zip
{
    my $name   = shift;    # zip format
    my $volume = shift;
    $volume = '' unless defined($volume);    # local FS format

    my @paths = split ( /\//, $name );
    my $filename  = pop (@paths);
    my $localDirs = File::Spec->catdir(@paths);
    my $localName = File::Spec->catpath( $volume, $localDirs, $filename );
    $localName = File::Spec->rel2abs($localName) unless $volume;
    return $localName;
}

# ----------------------------------------------------------------------
# class Archive::Zip::Archive (concrete)
# Generic ZIP archive.
# ----------------------------------------------------------------------
package Archive::Zip::Archive;
use File::Path;
use File::Find();
use File::Spec();
use File::Copy();
use File::Basename;
use Cwd;

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
          'writeEOCDOffset'             => 0,
          'writeCentralDirectoryOffset' => 0,
          'zipfileComment'              => '',
          'eocdOffset'                  => 0,
          'fileName'                    => ''
      },
      $class
    );
    $self->{'members'} = [];
    if (@_)
    {
        my $status = $self->read(@_);
        return $status == AZ_OK ? $self : undef;
    }
    return $self;
}

sub members    # Archive::Zip::Archive
{
    @{ shift->{'members'} };
}

sub numberOfMembers    # Archive::Zip::Archive
{
    scalar( shift->members() );
}

sub memberNames    # Archive::Zip::Archive
{
    my $self = shift;
    return map { $_->fileName() } $self->members();
}

# return ref to member with given name or undef
sub memberNamed    # Archive::Zip::Archive
{
    my ( $self, $fileName ) = @_;
    foreach my $member ( $self->members() )
    {
        return $member if $member->fileName() eq $fileName;
    }
    return undef;
}

sub membersMatching    # Archive::Zip::Archive
{
    my ( $self, $pattern ) = @_;
    return grep { $_->fileName() =~ /$pattern/ } $self->members();
}

sub diskNumber    # Archive::Zip::Archive
{
    shift->{'diskNumber'};
}

sub diskNumberWithStartOfCentralDirectory    # Archive::Zip::Archive
{
    shift->{'diskNumberWithStartOfCentralDirectory'};
}

sub numberOfCentralDirectoriesOnThisDisk    # Archive::Zip::Archive
{
    shift->{'numberOfCentralDirectoriesOnThisDisk'};
}

sub numberOfCentralDirectories    # Archive::Zip::Archive
{
    shift->{'numberOfCentralDirectories'};
}

sub centralDirectorySize    # Archive::Zip::Archive
{
    shift->{'centralDirectorySize'};
}

sub centralDirectoryOffsetWRTStartingDiskNumber    # Archive::Zip::Archive
{
    shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
}

sub zipfileComment    # Archive::Zip::Archive
{
    my $self    = shift;
    my $comment = $self->{'zipfileComment'};
    if (@_)
    {
        $self->{'zipfileComment'} = shift;
    }
    return $comment;
}

sub eocdOffset    # Archive::Zip::Archive
{
    shift->{'eocdOffset'};
}

# Return the name of the file last read.
sub fileName    # Archive::Zip::Archive
{
    shift->{'fileName'};
}

sub removeMember    # Archive::Zip::Archive
{
    my ( $self, $member ) = @_;
    $member = $self->memberNamed($member) unless ref($member);
    return undef unless $member;
    my @newMembers = grep { $_ != $member } $self->members();
    $self->{'members'} = \@newMembers;
    return $member;
}

sub replaceMember    # Archive::Zip::Archive
{
    my ( $self, $oldMember, $newMember ) = @_;
    $oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
    return undef unless $oldMember;
    return undef unless $newMember;
    my @newMembers =
      map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
    $self->{'members'} = \@newMembers;
    return $oldMember;
}

sub extractMember    # Archive::Zip::Archive
{
    my $self   = shift;
    my $member = shift;
    $member = $self->memberNamed($member) unless ref($member);
    return _error('member not found') unless $member;
    my $name = shift;    # local FS name if given
    my ( $volumeName, $dirName, $fileName );
    if ( defined($name) )
    {
        ( $volumeName, $dirName, $fileName ) = File::Spec->splitpath($name);
        $dirName = File::Spec->catpath( $volumeName, $dirName, '' );
    }
    else
    {
        $name = $member->fileName();
        ( $dirName = $name ) =~ s{[^/]*$}{};
        $dirName = Archive::Zip::_asLocalName($dirName);
        $name    = Archive::Zip::_asLocalName($name);
    }
    if ( $dirName && !-d $dirName )
    {
        mkpath($dirName);
        return _ioError("can't create dir $dirName") if ( !-d $dirName );
    }
    return $member->extractToFileNamed( $name, @_ );
}

sub extractMemberWithoutPaths    # Archive::Zip::Archive
{
    my $self   = shift;
    my $member = shift;
    $member = $self->memberNamed($member) unless ref($member);
    return _error('member not found') unless $member;
    return AZ_OK if $member->isDirectory();
    my $name = shift;
    unless ($name)
    {
        $name = $member->fileName();
        $name =~ s{.*/}{};    # strip off directories, if any
        $name = Archive::Zip::_asLocalName($name);
    }
    return $member->extractToFileNamed( $name, @_ );
}

sub addMember    # Archive::Zip::Archive
{
    my ( $self, $newMember ) = @_;
    push ( @{ $self->{'members'} }, $newMember ) if $newMember;
    return $newMember;
}

sub addFile    # Archive::Zip::Archive
{
    my $self      = shift;
    my $fileName  = shift;
    my $newName   = shift;
    my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
    $self->addMember($newMember) if defined($newMember);
    return $newMember;
}

sub addString    # Archive::Zip::Archive
{
    my $self      = shift;
    my $newMember = $self->ZIPMEMBERCLASS->newFromString(@_);
    return $self->addMember($newMember);
}

sub addDirectory    # Archive::Zip::Archive
{
    my ( $self, $name, $newName ) = @_;
    my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name, $newName );
    $self->addMember($newMember);
    return $newMember;
}

# add either a file or a directory.

sub addFileOrDirectory
{
    my ( $self, $name, $newName ) = @_;
    if ( -f $name )
    {
        ( $newName =~ s{/$}{} ) if $newName;
        return $self->addFile( $name, $newName );
    }
    elsif ( -d $name )
    {
        ( $newName =~ s{[^/]$}{&/} ) if $newName;
        return $self->addDirectory( $name, $newName );
    }
    else
    {
        return _error("$name is neither a file nor a directory");
    }
}

sub contents    # Archive::Zip::Archive
{
    my ( $self, $member, $newContents ) = @_;
    $member = $self->memberNamed($member) unless ref($member);
    return undef unless $member;
    return $member->contents($newContents);
}

sub writeToFileNamed    # Archive::Zip::Archive
{
    my $self     = shift;
    my $fileName = shift;    # local FS format
    foreach my $member ( $self->members() )
    {
        if ( $member->_usesFileNamed($fileName) )
        {
            return _error( "$fileName is needed by member "
                . $member->fileName()
                . "; consider using overwrite() or overwriteAs() instead." );
        }
    }
    my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
    return _ioError("Can't open $fileName for write") unless $status;
    my $retval = $self->writeToFileHandle( $fh, 1 );
    $fh->close();
    return $retval;
}

# It is possible to write data to the FH before calling this,
# perhaps to make a self-extracting archive.
sub writeToFileHandle    # Archive::Zip::Archive
{
    my $self         = shift;
    my $fh           = shift;
    my $fhIsSeekable = @_ ? shift: _isSeekable($fh);
    _binmode($fh);

    # Find out where the current position is.
    my $offset = $fhIsSeekable ? $fh->tell() : 0;
    $offset = 0 if $offset < 0;

    foreach my $member ( $self->members() )
    {
        my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
        $member->endRead();
        return $retval if $retval != AZ_OK;
        $offset += $member->_localHeaderSize() + $member->_writeOffset();
        $offset += $member->hasDataDescriptor() ? DATA_DESCRIPTOR_LENGTH: 0;

        # changed this so it reflects the last successful position
        $self->{'writeCentralDirectoryOffset'} = $offset;
    }
    return $self->writeCentralDirectory($fh);
}

# Write zip back to the original file,
# as safely as possible.
# Returns AZ_OK if successful.
sub overwrite    # Archive::Zip::Archive
{
    my $self = shift;
    return $self->overwriteAs( $self->{'fileName'} );
}

# Write zip to the specified file,
# as safely as possible.
# Returns AZ_OK if successful.
sub overwriteAs    # Archive::Zip::Archive
{
    my $self    = shift;
    my $zipName = shift;
    return _error("no filename in overwriteAs()") unless defined($zipName);

    my ( $fh, $tempName ) = Archive::Zip::tempFile();
    return _error( "Can't open temp file", $! ) unless $fh;
    ( my $backupName = $zipName ) =~ s{\.[^.]*$}{.zbk};
    my $status;

    if ( ( $status = $self->writeToFileHandle($fh) ) == AZ_OK )
    {
        my $err;
        $fh->close();

        # rename the zip
        if ( -f $zipName && !rename( $zipName, $backupName ) )
        {
            $err = $!;
            unlink($tempName);
            return _error( "Can't rename $zipName as $backupName", $err );
        }

        # move the temp to the original name (possibly copying)
        unless ( File::Copy::move( $tempName, $zipName ) )
        {
            $err = $!;
            rename( $backupName, $zipName );
            unlink($tempName);
            return _error( "Can't move $tempName to $zipName", $err );
        }

        # unlink the backup
        if ( -f $backupName && !unlink($backupName) )
        {
            $err = $!;
            return _error( "Can't unlink $backupName", $err );
        }
        return AZ_OK;
    }
    else
    {
        $fh->close();
        unlink($tempName);
        _printError("Can't write to $tempName");
        return $status;
    }
}

# 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->print(END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
      or return _ioError('writing EOCD Signature');
    my $zipfileCommentLength = length( $self->zipfileComment() );

    my $header = pack(
        END_OF_CENTRAL_DIRECTORY_FORMAT,
        0,                          # {'diskNumber'},
        0,                          # {'diskNumberWithStartOfCentralDirectory'},
        $self->numberOfMembers(),   # {'numberOfCentralDirectoriesOnThisDisk'},
        $self->numberOfMembers(),   # {'numberOfCentralDirectories'},
        $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
        $self->_writeCentralDirectoryOffset(),
        $zipfileCommentLength
    );
    $fh->print($header)
      or return _ioError('writing EOCD header');
    if ($zipfileCommentLength)
    {
        $fh->print( $self->zipfileComment() )
          or return _ioError('writing zipfile comment');
    }
    return AZ_OK;
}

# $offset can be specified to truncate a zip file.
sub writeCentralDirectory    # Archive::Zip::Archive
{
    my ( $self, $fh, $offset ) = @_;

    if ( defined($offset) )
    {
        $self->{'writeCentralDirectoryOffset'} = $offset;
        $fh->seek( $offset, IO::Seekable::SEEK_SET )
          or return _ioError('seeking to write central directory');
    }
    else
    {
        $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);
}

sub read    # Archive::Zip::Archive
{
    my $self     = shift;
    my $fileName = shift;
    return _error('No filename given') unless $fileName;
    my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
    return _ioError("opening $fileName for read") unless $status;

    $status = $self->readFromFileHandle( $fh, $fileName );
    return $status if $status != AZ_OK;

    $fh->close();
    $self->{'fileName'} = $fileName;
    return AZ_OK;
}

sub readFromFileHandle    # Archive::Zip::Archive
{
    my $self     = shift;
    my $fh       = shift;
    my $fileName = shift;
    $fileName = $fh unless defined($fileName);
    return _error('No filehandle given')   unless $fh;
    return _ioError('filehandle not open') unless $fh->opened();

    $fh->seek( 0, 0 );    # rewind the file
    _binmode($fh);

    my $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");

    # Try to detect garbage at beginning of archives
    # This should be 0
    $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
      - $self->centralDirectoryOffsetWRTStartingDiskNumber();

    for ( ; ; )
    {
        my $newMember =
          $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName,
            $self->eocdOffset() );
        my $signature;
        ( $status, $signature ) = _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 );
    }

    $self->{'fileName'} = "$fh";
    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 = '';
    my $bytesRead = $fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH );
    if ( $bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH )
    {
        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 = '';
        $bytesRead = $fh->read( $zipfileComment, $zipfileCommentLength );
        if ( $bytesRead != $zipfileCommentLength )
        {
            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");
        my $bytesRead = $fh->read( $data, $seekOffset );
        if ( $bytesRead != $seekOffset )
        {
            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");
    }
}

sub addTree    # Archive::Zip::Archive
{
    my $self = shift;
    my $root = shift or return _error("root arg missing in call to addTree()");
    my $dest = shift;
    $dest = '' unless defined($dest);
    my $pred = shift || sub { -r };
    my @files;
    my $startDir = cwd();

    # This avoids chdir'ing in Find, in a way compatible with older
    # versions of File::Find.
    my $wanted = sub {
        local $main::_ = $File::Find::name;
        my $dir = $File::Find::dir;
        chdir($startDir);
        push ( @files, $File::Find::name ) if (&$pred);
        chdir($dir);
    };

    File::Find::find( $wanted, $root );

    my $rootZipName = _asZipDirName( $root, 1 );    # with trailing slash
    my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";

    $dest = _asZipDirName( $dest, 1 );              # with trailing slash

    foreach my $fileName (@files)
    {
        my $isDir = -d $fileName;

        # normalize, remove leading ./
        my $archiveName = _asZipDirName( $fileName, $isDir );
        if ( $archiveName eq $rootZipName ) { $archiveName = $dest }
        else { $archiveName =~ s{$pattern}{$dest} }
        next if $archiveName =~ m{^\.?/?$};    # skip current dir
        my $member =
          $isDir
          ? $self->addDirectory( $fileName, $archiveName )
          : $self->addFile( $fileName, $archiveName );
        return _error("add $fileName failed in addTree()") if !$member;
    }
    return AZ_OK;
}

sub addTreeMatching    # Archive::Zip::Archive
{
    my $self = shift;
    my $root = shift
      or return _error("root arg missing in call to addTreeMatching()");
    my $dest = shift;
    $dest = '' unless defined($dest);
    my $pattern = shift
      or return _error("pattern missing in call to addTreeMatching()");
    my $pred    = shift;
    my $matcher =
      $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
    return $self->addTree( $root, $dest, $matcher );
}

# $zip->extractTree( $root, $dest [, $volume] );
#
# $root and $dest are Unix-style.
# $volume is in local FS format.
#
sub extractTree    # Archive::Zip::Archive
{
    my $self = shift;
    my $root = shift;    # Zip format
    $root = '' unless defined($root);
    my $dest = shift;    # Zip format
    $dest = './' unless defined($dest);
    my $volume  = shift;                              # optional
    my $pattern = "^\Q$root";
    my @members = $self->membersMatching($pattern);

    foreach my $member (@members)
    {
        my $fileName = $member->fileName();    # in Unix format
        $fileName =~ s{$pattern}{$dest};       # in Unix format
                                               # convert to platform format:
        $fileName = Archive::Zip::_asLocalName( $fileName, $volume );
        my $status = $member->extractToFileNamed($fileName);
        return $status if $status != AZ_OK;
    }
    return AZ_OK;
}

# $zip->updateMember( $memberOrName, $fileName );
# Returns (possibly updated) member, if any; undef on errors.

sub updateMember    # Archive::Zip::Archive
{
    my $self      = shift;
    my $oldMember = shift;
    my $fileName  = shift;

    if ( !defined($fileName) )
    {
        _error("updateMember(): missing fileName argument");
        return undef;
    }

    my @newStat = stat($fileName);
    if ( !@newStat )
    {
        _ioError("Can't stat $fileName");
        return undef;
    }

    my $isDir = -d _;

    my $memberName;

    if ( ref($oldMember) )
    {
        $memberName = $oldMember->fileName();
    }
    else
    {
        $oldMember = $self->memberNamed( $memberName = $oldMember )
          || $self->memberNamed( $memberName =
            _asZipDirName( $oldMember, $isDir ) );
    }

    unless ( defined($oldMember)
        && $oldMember->lastModTime() == $newStat[9]
        && $oldMember->isDirectory() == $isDir
        && ( $isDir || ( $oldMember->uncompressedSize() == $newStat[7] ) ) )
    {

        # create the new member
        my $newMember = $isDir
          ? $self->ZIPMEMBERCLASS->newDirectoryNamed( $fileName, $memberName )
          : $self->ZIPMEMBERCLASS->newFromFile( $fileName, $memberName );

        unless ( defined($newMember) )
        {
            _error("creation of member $fileName failed in updateMember()");
            return undef;
        }

        # replace old member or append new one
        if ( defined($oldMember) )
        {
            $self->replaceMember( $oldMember, $newMember );
        }
        else { $self->addMember($newMember); }

        return $newMember;
    }

    return $oldMember;
}

# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] );
#
# This takes the same arguments as addTree, but first checks to see
# whether the file or directory already exists in the zip file.
#
# If the fourth argument $mirror is true, then delete all my members
# if corresponding files weren't found.

sub updateTree    # Archive::Zip::Archive
{
    my $self = shift;
    my $root = shift
      or return _error("root arg missing in call to updateTree()");
    my $dest = shift;
    $dest = '' unless defined($dest);
    $dest = _asZipDirName( $dest, 1 );
    my $pred = shift || sub { -r };
    my $mirror = shift;

    my $rootZipName = _asZipDirName( $root, 1 );    # with trailing slash
    my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";

    my $startDir = cwd();
    my @files;

    # This avoids chdir'ing in Find, in a way compatible with older
    # versions of File::Find.
    my $wanted = sub {
        local $main::_ = $File::Find::name;
        my $dir = $File::Find::dir;
        chdir($startDir);
        push ( @files, $File::Find::name ) if (&$pred);
        chdir($dir);
    };

    File::Find::find( $wanted, $root );

    # Now @files has all the files that I could potentially be adding to
    # the zip. Only add the ones that are necessary.
    # For each file (updated or not), add its member name to @done.
    my %done;
    foreach my $fileName (@files)
    {
        my @newStat = stat($fileName);
        my $isDir   = -d _;

        # normalize, remove leading ./
        my $memberName = _asZipDirName( $fileName, $isDir );
        if ( $memberName eq $rootZipName ) { $memberName = $dest }
        else { $memberName =~ s{$pattern}{$dest} }
        next if $memberName =~ m{^\.?/?$};    # skip current dir

        $done{$memberName} = 1;
        my $changedMember = $self->updateMember( $memberName, $fileName );
        return _error("updateTree failed to update $fileName")
          unless ref($changedMember);
    }

    # @done now has the archive names corresponding to all the found files.
    # If we're mirroring, delete all those members that aren't in @done.
    if ($mirror)
    {
        foreach my $member ( $self->members() )
        {
            $self->removeMember($member)
              unless $done{ $member->fileName() };
        }
    }

    return AZ_OK;
}

# ----------------------------------------------------------------------
# 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 :MISC_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;
}

sub newFromString    # Archive::Zip::Member
{
    my $class = shift;
    my $self  = $class->STRINGMEMBERCLASS->_newFromString(@_);
    return $self;
}

sub newFromFile    # Archive::Zip::Member
{
    my $class = shift;
    my $self  = $class->NEWFILEMEMBERCLASS->_newFromFileNamed(@_);
    return $self;
}

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] );
}

sub versionMadeBy    # Archive::Zip::Member
{
    shift->{'versionMadeBy'};
}

sub fileAttributeFormat    # Archive::Zip::Member
{
    ( $#_ > 0 )
      ? ( $_[0]->{'fileAttributeFormat'} = $_[1] )
      : $_[0]->{'fileAttributeFormat'};
}

sub versionNeededToExtract    # Archive::Zip::Member
{
    shift->{'versionNeededToExtract'};
}

sub bitFlag    # Archive::Zip::Member
{
    shift->{'bitFlag'};
}

sub compressionMethod    # Archive::Zip::Member
{
    shift->{'compressionMethod'};
}

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;
}

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;
}

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'};
}

sub lastModFileDateTime    # Archive::Zip::Member
{
    my $modTime = shift->{'lastModFileDateTime'};
    $modTime =~ m/^(\d+)$/;    # untaint
    return $1;
}

sub lastModTime    # Archive::Zip::Member
{
    my $self = shift;
    return _dosToUnixTime( $self->lastModFileDateTime() );
}

sub setLastModFileDateTimeFromUnix    # Archive::Zip::Member
{
    my $self   = shift;
    my $time_t = shift;
    $self->{'lastModFileDateTime'} = _unixToDosTime($time_t);
}

# DOS date/time format
# 0-4 (5) Second divided by 2
# 5-10 (6) Minute (0-59)
# 11-15 (5) Hour (0-23 on a 24-hour clock)
# 16-20 (5) Day of the month (1-31)
# 21-24 (4) Month (1 = January, 2 = February, etc.)
# 25-31 (7) Year offset from 1980 (add 1980 to get actual year)

# Convert DOS date/time format to unix time_t format
# NOT AN OBJECT METHOD!
sub _dosToUnixTime    # Archive::Zip::Member
{
    my $dt = shift;
    return time() unless defined($dt);

    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 );

    # catch errors
    my $time_t =
      eval { Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year ); };
    return time() if ($@);
    return $time_t;
}

sub internalFileAttributes    # Archive::Zip::Member
{
    shift->{'internalFileAttributes'};
}

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;

    # TODO: map MS-DOS perms too (RHSA?)
}

# Convert ZIP permissions into Unix ones
#
# This was taken from Info-ZIP group's portable UnZip
# zipfile-extraction program, version 5.50.
# http://www.info-zip.org/pub/infozip/
#
# See the mapattr() function in unix/unix.c
# See the attribute format constants in unzpriv.h
#
# XXX Note that there's one situation that isn't implemented
# yet that depends on the "extra field."
sub _mapPermissionsToUnix    # Archive::Zip::Member
{
    my $self = shift;

    my $format  = $self->{'fileAttributeFormat'};
    my $attribs = $self->{'externalFileAttributes'};

    my $mode = 0;

    if ( $format == FA_AMIGA )
    {
        $attribs = $attribs >> 17 & 7;                         # Amiga RWE bits
        $mode    = $attribs << 6 | $attribs << 3 | $attribs;
        return $mode;
    }

    if ( $format == FA_THEOS )
    {
        $attribs &= 0xF1FFFFFF;
        if ( ( $attribs & 0xF0000000 ) != 0x40000000 )
        {
            $attribs &= 0x01FFFFFF;    # not a dir, mask all ftype bits
        }
        else
        {
            $attribs &= 0x41FFFFFF;    # leave directory bit as set
        }
    }

    if ( $format == FA_UNIX
        || $format == FA_VAX_VMS
        || $format == FA_ACORN
        || $format == FA_ATARI_ST
        || $format == FA_BEOS
        || $format == FA_QDOS
        || $format == FA_TANDEM )
    {
        $mode = $attribs >> 16;
        return $mode if $mode != 0 or not $self->localExtraField;

        # warn("local extra field is: ", $self->localExtraField, "\n");

        # XXX This condition is not implemented
        # I'm just including the comments from the info-zip section for now.

        # Some (non-Info-ZIP) implementations of Zip for Unix and
        # VMS (and probably others ??) leave 0 in the upper 16-bit
        # part of the external_file_attributes field. Instead, they
        # store file permission attributes in some extra field.
        # As a work-around, we search for the presence of one of
        # these extra fields and fall back to the MSDOS compatible
        # part of external_file_attributes if one of the known
        # e.f. types has been detected.
        # Later, we might implement extraction of the permission
        # bits from the VMS extra field. But for now, the work-around
        # should be sufficient to provide "readable" extracted files.
        # (For ASI Unix e.f., an experimental remap from the e.f.
        # mode value IS already provided!)
    }

    # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the
    # Unix attributes in the upper 16 bits of the external attributes
    # field, just like Info-ZIP's Zip for Unix.  We try to use that
    # value, after a check for consistency with the MSDOS attribute
    # bits (see below).
    if ( $format == FA_MSDOS )
    {
        $mode = $attribs >> 16;
    }

    # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20
    $attribs = !( $attribs & 1 ) << 1 | ( $attribs & 0x10 ) >> 4;

    # keep previous $mode setting when its "owner"
    # part appears to be consistent with DOS attribute flags!
    return $mode if ( $mode & 0700 ) == ( 0400 | $attribs << 6 );
    $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
    return $mode;
}

sub unixFileAttributes    # Archive::Zip::Member
{
    my $self     = shift;
    my $oldPerms = $self->_mapPermissionsToUnix();
    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;
}

sub localExtraField    # Archive::Zip::Member
{
    ( $#_ > 0 )
      ? ( $_[0]->{'localExtraField'} = $_[1] )
      : $_[0]->{'localExtraField'};
}

sub cdExtraField    # Archive::Zip::Member
{
    ( $#_ > 0 ) ? ( $_[0]->{'cdExtraField'} = $_[1] ) : $_[0]->{'cdExtraField'};
}

sub extraFields    # Archive::Zip::Member
{
    my $self = shift;
    return $self->localExtraField() . $self->cdExtraField();
}

sub fileComment    # Archive::Zip::Member
{
    ( $#_ > 0 ) ? ( $_[0]->{'fileComment'} = $_[1] ) : $_[0]->{'fileComment'};
}

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;
}

sub crc32    # Archive::Zip::Member
{
    shift->{'crc32'};
}

sub crc32String    # Archive::Zip::Member
{
    sprintf( "%08x", shift->{'crc32'} );
}

sub compressedSize    # Archive::Zip::Member
{
    shift->{'compressedSize'};
}

sub uncompressedSize    # Archive::Zip::Member
{
    shift->{'uncompressedSize'};
}

sub isEncrypted    # Archive::Zip::Member
{
    shift->bitFlag() & GPBF_ENCRYPTED_MASK;
}

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;
}

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;
}

sub extractToFileNamed    # Archive::Zip::Member
{
    my $self = shift;
    my $name = shift;    # local FS name
    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") unless $status;
    my $retval = $self->extractToFileHandle($fh);
    $fh->close();
    utime( $self->lastModTime(), $self->lastModTime(), $name );
    return $retval;
}

sub isDirectory    # Archive::Zip::Member
{
    return 0;
}

sub externalFileName    # Archive::Zip::Member
{
    return undef;
}

# 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 wasWritten { shift->{'wasWritten'} }

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->print($signatureData)
      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->print($header) or return _ioError("writing local header");
    if ( $self->fileName() )
    {
        $fh->print( $self->fileName() )
          or return _ioError("writing local header filename");
    }
    if ( $self->localExtraField() )
    {
        $fh->print( $self->localExtraField() )
          or return _ioError("writing local extra field");
    }

    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->print($sigData)
      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->print($header)
      or return _ioError("writing central directory header");
    if ($fileNameLength)
    {
        $fh->print( $self->fileName() )
          or return _ioError("writing central directory header signature");
    }
    if ($extraFieldLength)
    {
        $fh->print( $self->cdExtraField() )
          or return _ioError("writing central directory extra field");
    }
    if ($fileCommentLength)
    {
        $fh->print( $self->fileComment() )
          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(),    # compressed size
        $self->uncompressedSize()
    );

    $fh->print($header)
      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(),    # compressed size
        $self->uncompressedSize(),
        length( $self->fileName() ),
        length( $self->localExtraField() )
    );

    $fh->print($header)
      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;
}

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 ) unless $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() unless $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 );
    }
}

sub rewindData    # Archive::Zip::Member
{
    my $self = shift;
    my $status;

    # set to trap init errors
    $self->{'chunkHandler'} = $self->can('_noChunk');

    # Work around WinZip bug 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
            #            '-Bufsize'    => $Archive::Zip::ChunkSize,
            @_
        );    # pass additional options
        return _error( 'deflateInit error:', $status )
          unless $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
            #            '-Bufsize'    => $Archive::Zip::ChunkSize,
            @_
        );    # pass additional options
        return _error( 'inflateInit error:', $status )
          unless $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->{'readDataRemaining'} =
      ( $self->compressionMethod() == COMPRESSION_STORED )
      ? $self->uncompressedSize()
      : $self->compressedSize();
    $self->{'dataEnded'}  = 0;
    $self->{'readOffset'} = 0;

    return AZ_OK;
}

sub endRead    # Archive::Zip::Member
{
    my $self = shift;
    delete $self->{'inflater'};
    delete $self->{'deflater'};
    $self->{'dataEnded'}         = 1;
    $self->{'readDataRemaining'} = 0;
    return AZ_OK;
}

sub readIsDone    # Archive::Zip::Member
{
    my $self = shift;
    return ( $self->_dataEnded() or !$self->_readDataRemaining() );
}

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 unless $status == AZ_OK;
        return wantarray ? ( $retval, $status ) : $retval;
    }
}

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;
    my $offset       = shift;

    return _error("no member name given for $self")
      unless $self->fileName();

    $self->{'writeLocalHeaderRelativeOffset'} = $offset;
    $self->{'wasWritten'}                     = 0;

    # 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 )
    {
        $self->{'wasWritten'} = 1;
        if ( $self->hasDataDescriptor() )
        {
            $status = $self->_writeDataDescriptor($fh);
        }
        elsif ($headerFieldsUnknown)
        {
            $status = $self->_refreshLocalFileHeader($fh);
        }
    }

    return $status;
}

# Copy my (possibly compressed) data to given file handle.
# Returns C<AZ_OK> on success
sub _writeData    # Archive::Zip::Member
{
    my $self    = shift;
    my $writeFh = shift;

    return AZ_OK if ( $self->uncompressedSize() == 0 );
    my $status;
    my $chunkSize = $Archive::Zip::ChunkSize;
    while ( $self->_readDataRemaining() > 0 )
    {
        my $outRef;
        ( $outRef, $status ) = $self->readChunk($chunkSize);
        return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );

        if ( length($$outRef) > 0 )
        {
            $writeFh->print($$outRef)
              or return _ioError("write error during copy");
        }

        last if $status == AZ_STREAM_END;
    }
    $self->{'compressedSize'} = $self->_writeOffset();
    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 $fileName = shift;    # FS name
    my $newName  = shift;    # Zip name
    $newName = _asZipDirName($fileName) unless $newName;
    my $self = $class->new(@_);
    $self->{'externalFileName'} = $fileName;
    $self->fileName($newName);
    if ( -e $fileName )
    {

        if ( -d _ )
        {
            my @stat = stat(_);
            $self->unixFileAttributes( $stat[2] );
            $self->setLastModFileDateTimeFromUnix( $stat[9] );
        }
        else    # hmm.. trying to add a non-directory?
        {
            _error( $fileName, ' exists but is not a directory' );
            return undef;
        }
    }
    else
    {
        $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
        $self->setLastModFileDateTimeFromUnix( time() );
    }
    return $self;
}

sub externalFileName    # Archive::Zip::DirectoryMember
{
    shift->{'externalFileName'};
}

sub isDirectory    # Archive::Zip::DirectoryMember
{
    return 1;
}

sub extractToFileNamed    # Archive::Zip::DirectoryMember
{
    my $self    = shift;
    my $name    = shift;                                 # local FS name
    my $attribs = $self->unixFileAttributes() & 07777;
    mkpath( $name, 0, $attribs );                        # croaks on error
    utime( $self->lastModTime(), $self->lastModTime(), $name );
    return AZ_OK;
}

sub fileName    # Archive::Zip::DirectoryMember
{
    my $self    = shift;
    my $newName = shift;
    $newName =~ s{/?$}{/} if defined($newName);
    return $self->SUPER::fileName($newName);
}

# So people don't get too confused. This way it looks like the problem
# is in their code...
sub contents
{
    undef;
}

# ----------------------------------------------------------------------
# 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 ) }

sub externalFileName    # Archive::Zip::FileMember
{
    shift->{'externalFileName'};
}

# Return true if I depend on the named file
sub _usesFileNamed    # Archive::Zip::FileMember
{
    my $self     = shift;
    my $fileName = shift;
    my $xfn      = $self->externalFileName();
    return undef if ref($xfn);
    return $xfn eq $fileName;
}

sub fh    # Archive::Zip::FileMember
{
    my $self = shift;
    $self->_openFile()
      if !defined( $self->{'fh'} ) || !$self->{'fh'}->opened();
    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;
    my $fh   = $self->{'fh'};
    $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;    # local FS format
    my $newName  = shift;
    $newName = _asZipDirName($fileName) unless defined($newName);
    return undef unless ( stat($fileName) && -r _ && !-d _ );
    my $self = $class->new(@_);
    $self->fileName($newName);
    $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 unless $status == AZ_OK;

    return AZ_IO_ERROR unless $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 ) unless $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;    # local FS name
    if ( File::Spec->rel2abs($name) eq
        File::Spec->rel2abs( $self->externalFileName() ) and -r $name )
    {
        return AZ_OK;
    }
    else
    {
        return $self->SUPER::extractToFileNamed( $name, @_ );
    }
}

# ----------------------------------------------------------------------
# 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 $possibleEocdOffset = shift;    # normally 0

    my $self = $class->new(
        'crc32'                     => 0,
        'diskNumberStart'           => 0,
        'localHeaderRelativeOffset' => 0,
        'dataOffset' => 0,    # localHeaderRelativeOffset + header length
        @_
    );
    $self->{'externalFileName'}   = $externalFileName;
    $self->{'fh'}                 = $fh;
    $self->{'possibleEocdOffset'} = $possibleEocdOffset;
    return $self;
}

sub isDirectory    # Archive::Zip::ZipFileMember
{
    my $self = shift;
    return ( substr( $self->fileName(), -1, 1 ) eq '/'
        and $self->uncompressedSize() == 0 );
}

# Seek to the beginning of the local header, just past the signature.
# Verify that the local header signature is in fact correct.
# Update the localHeaderRelativeOffset if necessary by adding the possibleEocdOffset.
# Returns status.

sub _seekToLocalHeader    # Archive::Zip::ZipFileMember
{
    my $self  = shift;
    my $where = shift;
    $where = $self->localHeaderRelativeOffset() unless defined($where);

    my $status;
    my $signature;

    $status = $self->fh()->seek( $where, IO::Seekable::SEEK_SET );
    return _ioError("seeking to local header") unless $status;

    ( $status, $signature ) =
      _readSignature( $self->fh(), $self->externalFileName(),
        LOCAL_FILE_HEADER_SIGNATURE );
    return $status if $status == AZ_IO_ERROR;

    # retry with EOCD offset if any was given.
    if ( $status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'} )
    {
        $status =
          $self->_seekToLocalHeader( $self->localHeaderRelativeOffset() +
            $self->{'possibleEocdOffset'} );
        if ( $status == AZ_OK )
        {
            $self->{'localHeaderRelativeOffset'} +=
              $self->{'possibleEocdOffset'};
            $self->{'possibleEocdOffset'} = 0;
        }
    }

    return $status;
}

# 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->_seekToLocalHeader();
        $status = $self->_readLocalFileHeader() if $status == AZ_OK;
        $self->fh()->seek( $here, IO::Seekable::SEEK_SET );
        return $status unless $status == AZ_OK;
    }

    delete( $self->{'diskNumberStart'} );
    delete( $self->{'localHeaderRelativeOffset'} );
    delete( $self->{'dataOffset'} );

    return $self->SUPER::_become($newClass);
}

sub diskNumberStart    # Archive::Zip::ZipFileMember
{
    shift->{'diskNumberStart'};
}

sub localHeaderRelativeOffset    # Archive::Zip::ZipFileMember
{
    shift->{'localHeaderRelativeOffset'};
}

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;
    my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
    if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH )
    {
        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)
    {
        $bytesRead =
          $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
        if ( $bytesRead != $extraFieldLength )
        {
            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;
    my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
    if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH )
    {
        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;
        $bytesRead = $self->fh()->read( $fileName, $fileNameLength );
        if ( $bytesRead != $fileNameLength )
        {
            return _ioError("reading local file name");
        }
        $self->fileName($fileName);
    }

    if ($extraFieldLength)
    {
        $bytesRead =
          $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
        if ( $bytesRead != $extraFieldLength )
        {
            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;
}

# This will read the data descriptor, which is at the end of files that have
# GPBF_HAS_DATA_DESCRIPTOR_MASK set in their bitFlag.
# Note that you have to seek to the end of the compressed file to find this to
# read.
# sub _readDataDescriptor
# {
#     my $self = shift;
#     my $header;
#     $self->fh()->read( $header, DATA_DESCRIPTOR_LENGTH )
#         or return _ioError( "reading data descriptor" );
#     (
#         $self->{'crc32'},
#         $self->{'compressedSize'},
#         $self->{'uncompressedSize'}
#      ) = unpack( DATA_DESCRIPTOR_FORMAT, $header );
#     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    = '';
    my $bytesRead = $fh->read( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH );
    if ( $bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH )
    {
        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)
    {
        $bytesRead = $fh->read( $self->{'fileName'}, $fileNameLength );
        if ( $bytesRead != $fileNameLength )
        {
            _ioError("reading central dir filename");
        }
    }
    if ($extraFieldLength)
    {
        $bytesRead = $fh->read( $self->{'cdExtraField'}, $extraFieldLength );
        if ( $bytesRead != $extraFieldLength )
        {
            return _ioError("reading central dir extra field");
        }
    }
    if ($fileCommentLength)
    {
        $bytesRead = $fh->read( $self->{'fileComment'}, $fileCommentLength );
        if ( $bytesRead != $fileCommentLength )
        {
            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 unless $status == AZ_OK;

    return AZ_IO_ERROR unless $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.
    $status = $self->_seekToLocalHeader();
    return $status unless $status == AZ_OK;

    # skip local file header
    $status = $self->_skipLocalFileHeader();
    return $status unless $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 ) unless $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__


# vim: ts=4 sw=4 tw=80 wrap