view release on metacpan or  search on metacpan

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

        if ! $got->parsed("name");

    $got->setValue(name => IO::Compress::Zip::canonicalName($got->getValue("name")))
        if $options->getValue("canonicalname") ;

    $self->_newStream(undef, $got);

    my $data;

    while ($fh->read($data, 1024 * 16))
    {
        $self->{Zip}->write($data);
    }

    return 1;
}

# sub createDirectory
# {
#     my $self = shift ;
#     my $directory = shift;

#     # TODO - file attributes

#     $self->_stdPreq or return 0 ;

#     my $got = _ckParams($options, 0, @_);
#     $got->setValue(name => IO::Compress::Zip::canonicalName($filename, 1));

#     $self->_newStream(undef, $got);

#     return 1;
# }

sub openMember
{
    my $self    = shift;

    $self->_stdPreq or return undef ;

    my $options =  $self->{Opts}->clone();

    my $got = _ckParams($options, 0, @_);

    _myDie("Missing 'Name' parameter in openMember")
        if ! $got->parsed("name");

    $got->setValue(name => IO::Compress::Zip::canonicalName($got->getValue("name")))
        if $options->getValue("canonicalname") ;

    $self->_newStream(undef, $got);

#  if (1)
#  {
    my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::SimpleZip::Handle", \$SimpleZipError) ;

    $self->{Raw} = 1;

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

    return $z;
#  }
#  else
#  {
#    my $handle = Symbol::gensym();
#    tie *$handle, "Archive::Zip::SimpleZip::Handle", $self, $self->{Zip};
#
#    $self->{Raw} = 1;
#
#    return $handle;
#  }
}

sub STORABLE_freeze
{
    my $type = ref shift;
    croak "Cannot freeze $type object\n";
}

sub STORABLE_thaw
{
    my $type = ref shift;
    croak "Cannot thaw $type object\n";
}



{
    package Archive::Zip::SimpleZip::Handle ;

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

    sub UNTIE
    {
        my $self = shift ;
    }

    sub DESTROY
    {
        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};

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

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

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

         return 1;
    }

    sub _setError
    {
        $Archive::Zip::SimpleZip::SimpleZipError = $_[0] ;
        return 0;
    }

    sub clearerr
    {
        my $self = shift;

        return 0;
    }

    sub binmode { 1 }
#    sub clearerr { $Archive::Zip::SimpleZip::SimpleZipError = '' }

    *FILENO   = \&fileno;
    *PRINT    = \&print;
    *PRINTF   = \&printf;
    *WRITE    = \&syswrite;
    *write    = \&syswrite;
    *TELL     = \&tell;
    *EOF      = \&eof;
    *CLOSE    = \&close;
    *BINMODE  = \&binmode;
}

#{
#    package Archive::Zip::SimpleZip::HandleNEW ;
#
## TODO - fix this
##    require Tie::Handle;
##
##    @ISA = qw(Tie::Handle);
##@ISA = qw(IO::Handle) ;
#
#    sub TIEHANDLE
#    {
#        my $class = shift;
#        my $parent = shift;
#        my $zip = shift;
#        my $errorRef = shift;
#
#        my %obj = (
#            Zip  => $zip ,
#            SZ   => $parent,
#            Open => 1,
#        ) ;
#
#        Scalar::Util::weaken $obj{SZ}; # for 5.8
#        return bless \%obj, $class;
#    }
#
#    sub UNTIE
#    {
#        my $self = shift ;
#    }
#
#    sub DESTROY
#    {
#        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 print
#    {
#        my $self = shift;
#        $self->_stdPreq() or return 0 ;
#
#        $self->{Zip}->print(@_);
#    }
#
#    sub printf
#    {
#        my $self = shift;
#        $self->_stdPreq() or return 0 ;
#
#        $self->{Zip}->printf(@_);
#    }
#
#    sub syswrite
#    {
#        my $self = shift;
#        $self->_stdPreq() or return 0 ;