view release on metacpan or  search on metacpan

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

sub _stdPreq
{
    my $self = shift;

    return 0
        if $self->{Error} ;

    return $self->_setError(0, "Zip file closed")
        if ! $self->{Open} ;

    return $self->_setError(0, "openMember filehandle already open")
        if  defined $self->{Raw};

     return 1;
}

sub add
{
    my $self = shift;
    my $filename = shift;

    $self->_stdPreq or return 0 ;

    return $self->_setError(0, "File '$filename' does not exist")
        if ! -e $filename  ;

    return $self->_setError(0, "File '$filename' cannot be read")
        if ! -r $filename ;

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

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

    # Force Encode off.
    $got->setValue('encode', undef);

    my $isLink = $got->getValue('storelinks') && -l $filename ;
    my $isDir = -d $filename;

    return 0
        if $filename eq '.' || $filename eq '..';

    if ($options->getValue("canonicalname"))
    {
        if (! $got->parsed("name"))
        {
            $got->setValue(name => IO::Compress::Zip::canonicalName($filename, $isDir && ! $isLink));
        }
        else
        {
            $got->setValue(name => IO::Compress::Zip::canonicalName($got->getValue("name"), $isDir && ! $isLink));
        }
    }

    my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;

    if ( $got->parsed('storelinks') )
    {
        ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
                = (lstat($filename))[2, 4, 5, 7, 8, 9, 10] ;
    }
    else
    {
        ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
                = (stat($filename))[2, 4, 5,7, 8, 9, 10] ;
    }

    $got->setValue(time => $mtime);

    if (! $got->getValue('minimal')) {

        $got->setValue(extime => [$atime, $mtime, $ctime]) ;

        use Perl::OSType;
        my $type = Perl::OSType::os_type();
        if ( $type eq 'Unix' )
        {
            $got->setValue(exunixn => [$uid, $gid]) ;
        }
        # TODO add Windows
    }

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

    if($isLink)
    {
        my $target = readlink($filename);
        $self->{Zip}->write($target);
    }
    elsif (-d $filename)
    {
        # Do nothing, a directory has no payload
    }
    elsif (-f $filename)
    {
        my $fh = IO::File->new("<$filename")
            or die "Cannot open file $filename: $!";

        binmode $fh;

        my $data;
        my $last ;
        while ($fh->read($data, 1024 * 16))
        {
            $self->{Zip}->write($data);
        }
    }
    else
    {
        return 0;
    }

    return 1;
}


sub addString
{
    my $self    = shift;
    my $string  = shift;

    $self->_stdPreq or return 0 ;

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