File Coverage

lib/Archive/Zip/StreamedUnzip.pm

Criterion	Covered	Total	%
statement	113	150	75.3
branch	24	50	48.0
condition	6	12	50.0
subroutine	30	41	73.1
pod	3	7	42.8
total	176	260	67.6

package Archive::Zip::StreamedUnzip;

require 5.006;

use strict ;
use warnings;
use bytes;

use IO::File;
use Carp;
use Scalar::Util ();

use IO::Compress::Base::Common  2.201 qw(:Status);
use IO::Compress::Zip::Constants 2.201 ;
use IO::Uncompress::Unzip 2.201 ;


require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $StreamedUnzipError);

$VERSION = '1.000';
$StreamedUnzipError = '';

@ISA    = qw(IO::Uncompress::Unzip Exporter);
@EXPORT_OK = qw( $StreamedUnzipError unzip );
%EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');


sub _setError
{
    $StreamedUnzipError = $_[2] ;
    $_[0]->{Error} = $_[2]
        if defined  $_[0] ;

    return $_[1];
}

sub _illegalFilename
{
    return _setError(undef, undef, "Illegal Filename") ;
}

sub is64BitPerl
{
    use Config;
    # possibly use presence of pack/unpack "Q" for int size test?
    $Config{lseeksize} >= 8 and $Config{uvsize} >= 8;
}

sub new
{
    my $class = shift ;

    return _setError(undef, undef, "Missing Filename")
        unless @_ ;

    my $inValue = shift ;
    my $fh;

    if (!defined $inValue)
    {
        return _illegalFilename
    }

    my $isSTDOUT = ($inValue eq '-') ;
    my $inType = IO::Compress::Base::Common::whatIsOutput($inValue);

    if ($inType eq 'filename')
    {
        if (-e $inValue && ( ! -f _ || ! -r _))
        {
            return _illegalFilename
        }

        $fh = new IO::File "<$inValue"
            or return _setError(undef, undef, "cannot open file '$inValue': $!");
    }
    elsif( $inType eq 'buffer' || $inType eq 'handle')
    {
        $fh = $inValue;
    }
    else
    {
        return _illegalFilename
    }

    my %obj ;
    # my $inner = IO::Compress::Base::Common::createSelfTiedObject($class, \$StreamedUnzipError);

    # # *$inner->{Pause} = 1;
    # $inner->_create(undef, 0, $fh, @_)
    #     or return undef;

    my $inner = IO::Uncompress::Unzip->new($fh) ;

    $obj{Inner} = $inner;
    $obj{Open} = 1 ;
    $obj{FirstOne} = 1 ;

    bless \%obj, $class;
}

sub close
{
    my $self = shift;
    # TODO - fix me
    $self->{Inner}->close();
    return 1;
}

sub DESTROY
{
    my $self = shift;
}

sub next
{
    my $self = shift;

    if ($self->{FirstOne})
    {
        $self->{FirstOne} = 0;
    }
    else
    {
        my $status = $self->{Inner}->nextStream();
        return undef
            if $status <= 0;
    }

    my %member ;
    $member{Inner}  = $self->{Inner};
    # $member{Member} = $member;
    $member{Info} = $self->{Inner}->getHeaderInfo() ;
    #Scalar::Util::weaken $member{Inner}; # for 5.8

    return bless \%member, 'Archive::Zip::StreamedUnzip::Member';
}

sub member
{
    my $self = shift;
    my $name = shift;

    return _setError(undef, undef, "Member '$name' not in zip")
        if ! defined $name ;

    while (my $member = $self->next())
    {
        return $member
            if $member->name() eq $name ;

    }

    return _setError(undef, undef, "Member '$name' not in zip") ;
}

sub getExtraParams
{

    return (
            # Zip header fields
            'name'    => [IO::Compress::Base::Common::Parse_any,       undef],

#            'stream'  => [IO::Compress::Base::Common::Parse_boolean,   1],
        );
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # unzip always needs crc32
    $got->setValue('crc32' => 1);

    *$self->{UnzipData}{Name} = $got->getValue('name');

    return 1;
}




{
    package Archive::Zip::StreamedUnzip::Member;

    sub name
    {
        my $self = shift;
#        $self->_stdPreq() or return 0 ;

        return $self->{Info}{Name};
    }

    sub isDirectory
    {
        my $self = shift;
#        $self->_stdPreq() or return 0 ;

        return substr($self->{Info}{Name}, -1, 1) eq '/' ;
    }

    sub isFile
    {
        my $self = shift;
#        $self->_stdPreq() or return 0 ;

        # TODO - test for symlink
        return ! $self->isDirectory() ;
    }

    sub isEncrypted
    {
        my $self = shift;
        return $self->{Info}{Encrypted};
        # my $gpFlag = unpack ("v", substr($self->{Info}{Header}, 4 + 2, 2));
        # return $gpFlag & (0x01 | (1 << 6)) ;
    }

# TODO
#
#    isZip64
#    isDir
#    isSymLink
#    isText
#    isBinary
#    isEncrypted
#    isStreamed
#    getComment
#    getExtra
#    compressedSize - 64 bit alert
#    uncompressedSize
#    time
#    isStored
#    compressionName
#
#   extractToFile

    sub compressedSize
    {
        my $self = shift;
#        $self->_stdPreq() or return 0 ;

        my $CompressedLength = $self->{Info}{CompressedLength};
        if (ref $CompressedLength)
        {
            return U64::get64bit($CompressedLength)
        }
        return $CompressedLength;
    }

    sub uncompressedSize
    {
        my $self = shift;
#        $self->_stdPreq() or return 0 ;
        my $UncompressedLength = $self->{Info}{UncompressedLength};
        if (ref $UncompressedLength)
        {
            return U64::get64bit($UncompressedLength)
        }
        return $UncompressedLength;
    }

    sub content
    {
        my $self = shift;
        my $data ;

        # $self->{Inner}->read($data, $self->{UncompressedLength});
        $self->{Inner}->read($data, $self->{Info}{UncompressedLength});

        return $data;
    }

    sub open
    {
        my $self = shift;

#        return  return $self->{Inner} ;

#        my $handle = Symbol::gensym();
#        tie *$handle, "Archive::Zip::StreamedUnzip::Handle", $self->{SZ}{UnZip};
#        return $handle;

        my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::StreamedUnzip::Handle", \$StreamedUnzipError) ;

        *$z->{Open} = 1 ;
        *$z->{SZ} = $self->{Inner};
        Scalar::Util::weaken *$z->{SZ}; # for 5.8

        $z;
    }

    sub close
    {
        my $self = shift;
        return 1;
    }


}


{
    package Archive::Zip::StreamedUnzip::Handle ;

    sub TIEHANDLE
    {
        return $_[0] if ref($_[0]);
        die "OOPS\n" ;
    }

    sub UNTIE
    {
        my $self = shift ;
    }

    sub DESTROY
    {
#        print "DESTROY H";
        my $self = shift ;
        local ($., $@, $!, $^E, $?);
        $self->close() ;

        # TODO - memory leak with 5.8.0 - this isn't called until
        #        global destruction
        #
        %{ *$self } = () ;
        undef $self ;
    }


    sub close
    {
        my $self = shift ;
        return 1 if ! *$self->{Open};

        *$self->{Open} = 0 ;

#        untie *$self
#            if $] >= 5.008 ;

        if (defined *$self->{SZ})
        {
#            *$self->{SZ}{Raw} = undef ;
            *$self->{SZ} = undef ;
        }

        1;
    }

    sub read
    {
        # TODO - remember to fix the return value to match real read & not the broken one in IO::Uncompress
        my $self = shift;
        $self->_stdPreq() or return 0 ;

#        warn "READ [$self]\n";
#        warn "READ [*$self->{SZ}]\n";

#        $_[0] = *$self->{SZ}{Unzip};
#        my $status = goto &IO::Uncompress::Base::read;
#        $_[0] = \$_[0] unless ref $_[0];
        my $status = *$self->{SZ}->read(@_);
        $status = undef if $status < 0 ;
        return $status;
    }

    sub readline
    {
        my $self = shift;
        $self->_stdPreq() or return 0 ;
        *$self->{SZ}->getline(@_);
    }

    sub tell
    {
        my $self = shift;
        $self->_stdPreq() or return 0 ;

        *$self->{SZ}->tell(@_);
    }

    sub eof
    {
        my $self = shift;
        $self->_stdPreq() or return 0 ;

        *$self->{SZ}->eof;
    }

    sub _stdPreq
    {
        my $self = shift;

        # TODO - fix me
        return 1;

        return _setError("Zip file closed")
            if ! defined defined *$self->{SZ} || ! *$self->{Inner}{Open} ;


        return _setError("member filehandle closed")
            if  ! *$self->{Open} ; #|| ! defined *$self->{SZ}{Raw};

        return 0
            if *$self->{SZ}{Error} ;

         return 1;
    }

    sub _setError
    {
        $Archive::Zip::SimpleUnzip::StreamedUnzipError = $_[0] ;
        return 0;
    }

    sub clearerr
    {
        my $self = shift;

        return 0;
    }

    sub binmode { 1 }

#    sub clearerr { $Archive::Zip::SimpleUnzip::StreamedUnzipError = '' }

    *BINMODE  = \&binmode;
#    *SEEK     = \&seek;
    *READ     = \&read;
    *sysread  = \&read;
    *TELL     = \&tell;
    *READLINE = \&readline;
    *EOF      = \&eof;
    *FILENO   = \&fileno;
    *CLOSE    = \&close;
}


1;

__END__