view release on metacpan or  search on metacpan

lib/Archive/Zip/Member.pm  view on Meta::CPAN

sub isTextFile {
    my $self = shift;
    my $bit  = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
    if (@_) {
        my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift;
        $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
        $self->{'internalFileAttributes'} |=
          ($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE);
    }
    return $bit == IFA_TEXT_FILE;
}

sub isBinaryFile {
    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 {
    my $self = shift;

    # local FS name
    my $name = (ref($_[0]) eq 'HASH') ? $_[0]->{name} : $_[0];

    # Create directory for regular files as well as for symbolic
    # links
    if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
        $name = decode_utf8(Win32::GetFullPathName($name));
        mkpath_win32($name);
    } else {
        mkpath(dirname($name));    # croaks on error
    }

    # Check if the file / directory is a symbolic link *and* if
    # the operating system supports these.  Only in that case
    # call method extractToFileHandle with the name of the
    # symbolic link.  If the operating system does not support
    # symbolic links, process the member using the usual
    # extraction routines, which creates a file containing the
    # link target.
    if ($self->isSymbolicLink() && OS_SUPPORTS_SYMLINK) {
        return $self->extractToFileHandle($name);
    } else {
        my ($status, $fh);
        if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
            Win32::CreateFile($name);
            ($status, $fh) = _newFileHandle(Win32::GetANSIPathName($name), 'w');
        } else {
            ($status, $fh) = _newFileHandle($name, 'w');
        }
        return _ioError("Can't open file $name for write") unless $status;
        $status = $self->extractToFileHandle($fh);
        $fh->close();
        chmod($self->unixFileAttributes(), $name)
          or return _error("Can't chmod() ${name}: $!");
        utime($self->lastModTime(), $self->lastModTime(), $name);
        return $status;
    }
}

sub mkpath_win32 {
    my $path = shift;
    use File::Spec;

    my ($volume, @path) = File::Spec->splitdir($path);
    $path = File::Spec->catfile($volume, shift @path);
    pop @path;
    while (@path) {
        $path = File::Spec->catfile($path, shift @path);
        Win32::CreateDirectory($path);
    }
}

sub isSymbolicLink {
    return shift->{'externalFileAttributes'} == 0xA1FF0000;
}

sub isDirectory {
    return 0;
}

sub externalFileName {
    return undef;
}

# Search the given extra field string for a zip64 extended
# information extra field and "correct" the header fields given
# in the remaining parameters with the information from that
# extra field, if required.  Writes back the extra field string
# sans the zip64 information.  The extra field string and all
# header fields must be passed as lvalues or the undefined value.
#
# This method returns a pair ($status, $zip64) in list context,
# where the latter flag specifies whether a zip64 extended
# information extra field was found.
#
# This method must be called with two header fields for local
# file headers and with four header fields for Central Directory
# headers.
sub _extractZip64ExtraField
{
    my $classOrSelf = shift;

    my $extraField = $_[0];

    my ($zip64Data, $newExtraField) = (undef, '');
    while (length($extraField) >= 4) {
        my ($headerId, $dataSize) = unpack('v v', $extraField);
        if (length($extraField) < 4 + $dataSize) {
            return _formatError('invalid extra field (bad data)');
        }
        elsif ($headerId != 0x0001) {
            $newExtraField .= substr($extraField, 0, 4 + $dataSize);
            $extraField     = substr($extraField, 4 + $dataSize);
        }