Archive-Zip

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    - NetBSD doesn't mind empty zips [github/pmqs]
    - Solaris test failure, Add diag to failing test to collect data [github/pmqs]
    - Test for presence of Test::MockModule [github/pmqs]
    - Fix skip line for Windows [github/pmqs]
    - Skip tests that assume /tmp on Windows [github/pmqs]

1.64 Wed 12 Sep 2018
    - Fix for year 2030

1.63 Wed 21 Aug 2018
    - Restore missing META.yml deps (needed updated MB)
    - Symlink traversal test fix [github/haarg]
    - Added missing prereq Encode as suggested by CPANTS [github/manwar]

1.62 Sun 19 Aug 2018
    - Add link-samename.zip to MANIFEST

1.61 Sat 18 Aug 2018
    - File::Find will not untaint [github/ThisUsedToBeAnEmail]
    - Prevent from traversing symlinks and parent directories when extracting [github/ppisar]

examples/updateTree.pl  view on Meta::CPAN

# Read the zip
my $zip = Archive::Zip->new();

if (-f $zipName) {
    die "can't read $zipName\n" unless $zip->read($zipName) == AZ_OK;

    # Update the zip
    $zip->updateTree($dirName, undef, undef, $mirror);

    # Now the zip is updated. Write it back via a temp file.
    exit($zip->overwrite());
} else    # new zip
{
    $zip->addTree($dirName);
    exit($zip->writeToFileNamed($zipName));
}

examples/updateZip.pl  view on Meta::CPAN

        } elsif (-d $file) {
            $zip->addDirectory($file) or die "Can't add $file to zip!\n";
        } else {
            warn "Don't know how to add $file\n";
        }
    } else {
        warn "Can't read $file\n";
    }
}

# Now the zip is updated. Write it back via a temp file.

exit($zip->overwrite());

examples/ziprecent.pl  view on Meta::CPAN

# Usage:
# ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
# Zips files in source directory and its subdirectories
# whose file extension is in specified extensions (default: any extension).
#     -d <days>       max age (days) for files to be zipped (default: 1 day)
#     <dir>           source directory
#     -e <ext>        one or more space-separated extensions
#     -h              print help text and exit
#     -msvc           may be given instead of -e and will zip all msvc source files
#     -q              query only (list files but don't zip)
#     <zippath>.zip   path to zipfile to be created (or updated if it exists)
#
# $Revision: 1.2 $

use strict;

use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Cwd;
use File::Basename;
use File::Copy;
use File::Find;

examples/ziprecent.pl  view on Meta::CPAN

my $usage      = <<ENDUSAGE;
$scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
Zips files in source directory and its subdirectories
whose file extension is in specified extensions (default: any extension).
    -d <days>       max age (days) for files to be zipped (default: 1 day)
    <dir>           source directory
    -e <ext>        one or more space-separated extensions
    -h              print help text and exit
    -msvc           may be given instead of -e and will zip all msvc source files
    -q              query only (list files but don't zip)
    <zippath>.zip   path to zipfile to be created (or updated if it exists)
ENDUSAGE

# parse arguments
#
while (@ARGV) {
    my $arg = shift;

    if ($arg eq '-d') {
        $maxFileAgeDays = shift;
        $maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;

examples/ziprecent.pl  view on Meta::CPAN

 ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
 Zips files in source directory and its subdirectories
 whose file extension is in specified extensions (default: any extension).
    -d <days>       max age (days) for files to be zipped (default: 1 day)
    <dir>           source directory
    -e <ext>        one or more space-separated extensions
    -h              print help text and exit
    -msvc           may be given instead of -e and will zip all msvc source files
    -q              query only (list files but don't zip)
    <zippath>.zip   path to zipfile to be created (or updated if it exists)

=back


=head1 BUGS

Tested only on Win2k.

Does not handle filenames without extension.

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

    # Move member named 'abc' to end of zip:
    my $member = $zip->removeMember( 'abc' );
    $zip->addMember( $member );

=item updateMember( $memberOrName, $fileName )

=item updateMember( { memberOrZipName => $memberOrName, name => $fileName } )

Update a single member from the file or directory named C<$fileName>.
Returns the (possibly added or updated) member, if any; C<undef> on
errors.
The comparison is based on C<lastModTime()> and (in the case of a
non-directory) the size of the file.

=item addFile( $fileName [, $newName, $compressionLevel ] )

=item addFile( { filename => $fileName
    [, zipName => $newName, compressionLevel => $compressionLevel } ] )

Append a member whose data comes from an external file,

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

        $fileName = Archive::Zip::_asLocalName($fileName, $volume);
        if ((my $ret = _extractionNameIsSafe($fileName))
            != AZ_OK) { return $ret; }
        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 {
    my $self = shift;

    my ($oldMember, $fileName);
    if (ref($_[0]) eq 'HASH') {
        $oldMember = $_[0]->{memberOrZipName};
        $fileName  = $_[0]->{name};
    } else {
        ($oldMember, $fileName) = @_;

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

        my $dir = _untaintDir($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

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

      or return _ioError("writing central directory header signature");

    my $header = pack(
        CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
        $versionMadeBy,
        $self->fileAttributeFormat(),
        $versionNeededToExtract,
        $self->bitFlag(),
        $self->desiredCompressionMethod(),
        $self->lastModFileDateTime(),
        $self->crc32(),            # these three fields should have been updated
        $compressedSize,           # by writing the data stream out
        $uncompressedSize,         #
        $fileNameLength,
        $extraFieldLength,
        $fileCommentLength,
        0,                         # {'diskNumberStart'},
        $self->internalFileAttributes(),
        $self->externalFileAttributes(),
        $localHeaderRelativeOffset);

t/03_ex.t  view on Meta::CPAN

is($status, 0) or diag($output);
my $fn = testPath(FILENAME);
is(-f $fn, 1, "$fn exists");

unlink(OUTPUTZIP);
($output, $status) = execPerl('examples/updateTree.pl', OUTPUTZIP, testPath());
is($status, 0, "updateTree.pl create") or diag($output);
is(-f OUTPUTZIP, 1, "zip created");
($output, $status) = execPerl('examples/updateTree.pl', OUTPUTZIP, testPath());
is($status, 0, "updateTree.pl update") or diag($output);
is(-f OUTPUTZIP, 1, "zip updated");
unlink(OUTPUTZIP);

# Still untested:
#
# calcSizes.pl - creates test.zip, may be sensitive to /dev/null
# mailZip.pl
# readScalar.pl - requires IO::Scalar
# unzipAll.pl
# updateZip.pl
# writeScalar2.pl