File manager

File manager - Edit - /home/newsbmcs.com/public_html/static/img/logo/libarchive-zip-perl.tar

Back
copyright��0000644��00000011563�15030416166�0006507 0��ustar�00��Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: Archive-Zip Upstream-Contact: Adam Kennedy <adamk@cpan.org> Source: https://metacpan.org/release/Archive-Zip Files: * Copyright: 2000-2004, Ned Konz <perl@bike-nomad.com> 2005, Steve Peters <steve@fisharerojo.org> 2006-2009, Adam Kennedy <adamk@cpan.org> License: Artistic or GPL-1+ Files: lib/Archive/Zip/Member.pm Copyright: 2000-2004, Ned Konz <perl@bike-nomad.com> 2005, Steve Peters <steve@fisharerojo.org> 2006-2009, Adam Kennedy <adamk@cpan.org> 1990-2007, Info-ZIP License: Artistic and Info-ZIP Comment: This file contains code that was derived from an Info-ZIP product. The additional restrictions on the Info-ZIP license likely make it incompatible with GPL-1+, so only the Artistic side of the Perl license is listed here. Files: debian/* Copyright: 2001-2003, Ivo Timmermans <ivo@debian.org> 2004, Matthias Klose <doko@debian.org> 2005, 2007, Ben Burton <bab@debian.org> 2009-2019, Salvatore Bonaccorso <carnil@debian.org> 2009-2011, Ernesto Hernández-Novich (USB) <emhn@usb.ve> 2010-2020, gregor herrmann <gregoa@debian.org> License: Artistic or GPL-1+ License: Artistic This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License, which comes with Perl. . On Debian systems, the complete text of the Artistic License can be found in `/usr/share/common-licenses/Artistic'. License: GPL-1+ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. . On Debian systems, the complete text of version 1 of the GNU General Public License can be found in `/usr/share/common-licenses/GPL-1'. License: Info-ZIP This is version 2005-Feb-10 of the Info-ZIP copyright and license. The definitive version of this document should be available at ftp://ftp.info-zip.org/pub/infozip/license.html indefinitely. . . Copyright (c) 1990-2005 Info-ZIP. All rights reserved. . For the purposes of this copyright and license, "Info-ZIP" is defined as the following set of individuals: . Mark Adler, John Bush, Karl Davis, Harald Denker, Jean-Michel Dubois, Jean-loup Gailly, Hunter Goatley, Ed Gordon, Ian Gorman, Chris Herborth, Dirk Haase, Greg Hartwig, Robert Heath, Jonathan Hudson, Paul Kienitz, David Kirschbaum, Johnny Lee, Onno van der Linden, Igor Mandrichenko, Steve P. Miller, Sergio Monesi, Keith Owens, George Petrov, Greg Roelofs, Kai Uwe Rommel, Steve Salisbury, Dave Smith, Steven M. Schweda, Christian Spieler, Cosmin Truta, Antoine Verheijen, Paul von Behren, Rich Wales, Mike White . This software is provided "as is," without warranty of any kind, express or implied. In no event shall Info-ZIP or its contributors be held liable for any direct, indirect, incidental, special or consequential damages arising out of the use of or inability to use this software. . Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: . 1. Redistributions of source code must retain the above copyright notice, definition, disclaimer, and this list of conditions. . 2. Redistributions in binary form (compiled executables) must reproduce the above copyright notice, definition, disclaimer, and this list of conditions in documentation and/or other materials provided with the distribution. The sole exception to this condition is redistribution of a standard UnZipSFX binary (including SFXWiz) as part of a self-extracting archive; that is permitted without inclusion of this license, as long as the normal SFX banner has not been removed from the binary or disabled. . 3. Altered versions--including, but not limited to, ports to new operating systems, existing ports with new graphical interfaces, and dynamic, shared, or static library versions--must be plainly marked as such and must not be misrepresented as being the original source. Such altered versions also must not be misrepresented as being Info-ZIP releases--including, but not limited to, labeling of the altered versions with the names "Info-ZIP" (or any variation thereof, including, but not limited to, different capitalizations), "Pocket UnZip," "WiZ" or "MacZip" without the explicit permission of Info-ZIP. Such altered versions are further prohibited from misrepresentative use of the Zip-Bugs or Info-ZIP e-mail addresses or of the Info-ZIP URL(s). . 4. Info-ZIP retains the right to use the names "Info-ZIP," "Zip," "UnZip," "UnZipSFX," "WiZ," "Pocket UnZip," "Pocket Zip," and "MacZip" for its own source and binary releases. ��changelog.Debian.gz��0000644��00000002226�15030416166�0010222 0��ustar�00��V�n�6}�WL�_bmtۛ��%vԵ�y ��+�J�)R!�u�_ߡ��f�v��h�9s� >a:-��x�U��Ʋ��9�t�K��˽=�#�GVB] Ų^�XVJ[ ��J�+�f�Ye�"Lj.2ȰB�QY��'��w�:�J��X�t�U�H��h��֘�U��T3��B��)أ�{�s��@�I 'M��ږ�)��c��}��&y��'��E>�o(��V�Dxh��ˏ��+׵��;�pS��B4 �� >l��ׇu��ȴ5��,�2�TUs��vpc�F �� pR�'n�;��V ��!�{~��Q`1:EFw;�sﮞ��2��>�p�8�F1N�(��J��v�"\�f�ͿtO f�ݫ߬f��U�XEH�%�d��2�-2wL̘��,M�6 NR�%� \|�I-��!$�8�O�#x;2�N��F�Z�+ܪZ��I�D8�߾G �̨�f�S#p t�A�kR�&�+w�jW��u�[8��6��e�L� 7m�5��x��9�RY'g��b��Y��$UZ`��~�z�Ԟ��k%I��=J�8��ۇ�-v&e�D��a��!e�U��7 �D�O�锕�D�f.��&�9$v[�ɓ�1M�� Q��З��x��h�n5�]n�@c_��h��[�o�3��(-�1.z�4��u��JZƥ�H��Nr��1Ɉ:#\|ܝe��öa�;a��9�b9�~ҏ�a��j��xu��B��L�j�y\�ZԲ]//��┼��p�ЏL0��a��+n�^�K"O�\r2�ڰf�P��8� iFNJ�d��KYM�M�v�� }�6�"��M�VUh��VU��u�?Z��¶��x�ۭ �`��qƤ�uJɖB��-��zH��&a��ٱ�[5��)5�5M��3+C� e��)�ު�m��m��n5yyJC 2�&��7󒬃f��i�.'�S�j�y�M �l�[�>xt/�G�p}��h>��_�ֻ9��"w_�?J�hmͿ�K��k��P9x�cе�}VY/'�^�o`��߾h��examples/selfex.pl��0000644��00000003047�15030416166�0010213 0��ustar�00��#!/usr/bin/perl -w # # Shows one way to write a self-extracting archive file. # This is not intended for production use, and it always extracts to a # subdirectory with a fixed name. # Plus, it requires Perl and A::Z to be installed first. # # In general, you want to provide a stub that is platform-specific. # You can use 'unzipsfx' that it provided with the Info-Zip unzip program. # Get this from http://www.info-zip.org . # # $Revision: 1.6 $ # use strict; use Archive::Zip; use IO::File; # Make a self-extracting Zip file. die "usage: $0 sfxname file [...]\n" unless @ARGV > 1; my $outputName = shift(); my $zip = Archive::Zip->new(); foreach my $file (@ARGV) { $zip->addFileOrDirectory($file); } my $fh = IO::File->new($outputName, O_CREAT \| O_WRONLY \| O_TRUNC, 0777) or die "Can't open $outputName\: $!\n"; binmode($fh); # add self-extracting Perl code while (<DATA>) { $fh->print($_) } $zip->writeToFileHandle($fh); $fh->close(); # below the __DATA__ line is the extraction stub: __DATA__ #!/usr/bin/perl # Self-extracting Zip file extraction stub # Copyright (C) 2002 Ned Konz use Archive::Zip qw(:ERROR_CODES); use IO::File; use File::Spec; my $dir = $ARGV[0] \|\| 'extracted'; my $zip = Archive::Zip->new(); my $fh = IO::File->new($0) or die "Can't open $0\: $!\n"; die "Zip read error\n" unless $zip->readFromFileHandle($fh) == AZ_OK; (mkdir($dir, 0777) or die "Can't create directory $dir\: $!\n") unless -d $dir; for my $member ( $zip->members ) { $member->extractToFileNamed( File::Spec->catfile($dir,$member->fileName) ); } __DATA__ ��examples/zipGrep.pl��0000644��00000002653�15030416166�0010347 0��ustar�00��#!/usr/bin/perl -w # This program searches for the given Perl regular expression in a Zip archive. # Archive is assumed to contain text files. # By Ned Konz, perl@bike-nomad.com # Usage: # perl zipGrep.pl 'pattern' myZip.zip # use strict; use Archive::Zip qw(:CONSTANTS :ERROR_CODES); if (@ARGV != 2) { print <<EOF; This program searches for the given Perl regular expression in a Zip archive. Archive is assumed to contain text files. Usage: perl $0 'pattern' myZip.zip EOF exit 1; } my $pattern = shift; $pattern = qr{$pattern}; # compile the regular expression my $zipName = shift; my $zip = Archive::Zip->new(); if ($zip->read($zipName) != AZ_OK) { die "Read error reading $zipName\n"; } foreach my $member ($zip->members()) { my ($bufferRef, $status, $lastChunk); my $memberName = $member->fileName(); my $lineNumber = 1; $lastChunk = ''; $member->desiredCompressionMethod(COMPRESSION_STORED); $status = $member->rewindData(); die "rewind error $status" if $status != AZ_OK; while (!$member->readIsDone()) { ($bufferRef, $status) = $member->readChunk(); die "readChunk error $status" if $status != AZ_OK && $status != AZ_STREAM_END; my $buffer = $lastChunk . $$bufferRef; while ($buffer =~ m{(.$pattern.\n)}mg) { print "$memberName:$1"; } ($lastChunk) = $$bufferRef =~ m{([^\n\r]+)\z}; } $member->endRead(); } ��examples/copy.pl��0000644��00000000724�15030416166�0007676 0��ustar�00��#!/usr/bin/perl # Copies a zip file to another. # Usage: # perl copy.pl input.zip output.zip # $Revision: 1.4 $ use Archive::Zip qw(:ERROR_CODES); die "usage: perl copy.pl input.zip output.zip\n" if scalar(@ARGV) != 2; my $zip = Archive::Zip->new(); my $status = $zip->read($ARGV[0]); die("read $ARGV[0] failed: $status\n") if $status != AZ_OK; $status = $zip->writeToFileNamed($ARGV[1]); die("writeToFileNamed $ARGV[1] failed: $status\n") if $status != AZ_OK; ��examples/calcSizes.pl��0000644��00000001704�15030416166�0010643 0��ustar�00��#!/usr/bin/perl # Example of how to compute compressed sizes # $Revision: 1.2 $ use strict; use Archive::Zip qw(:ERROR_CODES); use File::Spec; my $zip = Archive::Zip->new(); my $blackHoleDevice = File::Spec->devnull(); $zip->addFile($_) foreach (<.pl>); # Write and throw the data away. # after members are written, the writeOffset will be set # to the compressed size. $zip->writeToFileNamed($blackHoleDevice); my $totalSize = 0; my $totalCompressedSize = 0; foreach my $member ($zip->members()) { $totalSize += $member->uncompressedSize; $totalCompressedSize += $member->_writeOffset; print "Member ", $member->externalFileName, " size=", $member->uncompressedSize, ", writeOffset=", $member->_writeOffset, ", compressed=", $member->compressedSize, "\n"; } print "Total Size=", $totalSize, ", total compressed=", $totalCompressedSize, "\n"; $zip->writeToFileNamed('test.zip'); ��examples/ziprecent.pl��0000644��00000017012�15030416166�0010725 0��ustar�00��#!/usr/bin/perl -w # Makes a zip file of the most recent files in a specified directory. # By Rudi Farkas, rudif@bluemail.ch, 9 December 2000 # 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; use File::Path; # argument and variable defaults # my $maxFileAgeDays = 1; my $defaultzipdir = 'h:/zip/_homework'; my ($sourcedir, $zipdir, $zippath, @extensions, $query); # usage # my $scriptname = basename $0; 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; } elsif ($arg eq '-e') { while ($ARGV[0] && $ARGV[0] !~ /^-/) { push @extensions, shift; } } elsif ($arg eq '-msvc') { push @extensions, qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /; } elsif ($arg eq '-q') { $query = 1; } elsif ($arg eq '-h') { print STDERR $usage; exit; } elsif (-d $arg) { $sourcedir = $arg; } elsif ($arg eq '-z') { if ($ARGV[0]) { $zipdir = shift; } } elsif ($arg =~ /\.zip$/) { $zippath = $arg; } else { errorExit("Unknown option or argument: $arg"); } } # process arguments # errorExit("Please specify an existing source directory") unless defined($sourcedir) && -d $sourcedir; my $extensions; if (@extensions) { $extensions = join "\|", @extensions; } else { $extensions = "."; } # change '\' to '/' (avoids trouble in substitution on Win2k) # $sourcedir =~ s\|\\\|/\|g; $zippath =~ s\|\\\|/\|g if defined($zippath); # find files # my @files; cwd $sourcedir; find(\&listFiles, $sourcedir); printf STDERR "Found %d file(s)\n", scalar @files; # exit ? # exit if $query; exit if @files <= 0; # prepare zip directory # if (defined($zippath)) { # deduce directory from zip path $zipdir = dirname($zippath); $zipdir = '.' unless length $zipdir; } else { $zipdir = $defaultzipdir; } # make sure that zip directory exists # mkpath $zipdir unless -d $zipdir; -d $zipdir or die "Can't find/make directory $zipdir\n"; # create the zip object # my $zip = Archive::Zip->new(); # read-in the existing zip file if any # if (defined $zippath && -f $zippath) { my $status = $zip->read($zippath); warn "Read $zippath failed\n" if $status != AZ_OK; } # add files # foreach my $memberName (@files) { if (-d $memberName) { warn "Can't add tree $memberName\n" if $zip->addTree($memberName, $memberName) != AZ_OK; } else { $zip->addFile($memberName) or warn "Can't add file $memberName\n"; } } # prepare the new zip path # my $newzipfile = genfilename(); my $newzippath = "$zipdir/$newzipfile"; # write the new zip file # my $status = $zip->writeToFileNamed($newzippath); if ($status == AZ_OK) { # rename (and overwrite the old zip file if any)? # if (defined $zippath) { my $res = rename $newzippath, $zippath; if ($res) { print STDERR "Updated file $zippath\n"; } else { print STDERR "Created file $newzippath, failed to rename to $zippath\n"; } } else { print STDERR "Created file $newzippath\n"; } } else { print STDERR "Failed to create file $newzippath\n"; } # subroutines # sub listFiles { if (/\.($extensions)$/) { cwd $File::Find::dir; return if -d $File::Find::name; # skip directories my $fileagedays = fileAgeDays($_); if ($fileagedays < $maxFileAgeDays) { printf STDERR "$File::Find::name (%.3g)\n", $fileagedays; (my $filename = $File::Find::name) =~ s/^[a-zA-Z]://; # remove the leading drive letter: push @files, $filename; } } } sub errorExit { printf STDERR "* %s \n$usage\n", shift; exit; } sub mtime { (stat shift)[9]; } sub fileAgeDays { (time() - mtime(shift)) / 86400; } sub genfilename { my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year + 1900, $mon + 1, $mday, $hour, $min, $sec; } __END__ =head1 NAME ziprecent.pl =head1 SYNOPSIS ziprecent h:/myperl ziprecent h:/myperl -e pl pm -d 365 ziprecent h:/myperl -q ziprecent h:/myperl h:/temp/zip/file1.zip =head1 DESCRIPTION This script helps to collect recently modified files in a source directory into a zip file (new or existing). It uses Archive::Zip. =over 4 =item C< ziprecent h:/myperl > Lists and zips all files more recent than 1 day (24 hours) in directory h:/myperl and it's subdirectories, and places the zip file into default zip directory. The generated zip file name is based on local time (e.g. 20001208-231237.zip). =item C< ziprecent h:/myperl -e pl pm -d 365 > Zips only .pl and .pm files more recent than one year. =item C< ziprecent h:/myperl -msvc > Zips source files found in a typical MSVC project. =item C< ziprecent h:/myperl -q > Lists files that should be zipped. =item C< ziprecent h:/myperl h:/temp/zip/file1.zip > Updates file named h:/temp/zip/file1.zip (overwrites an existing file if writable). =item C< ziprecent -h > Prints the help text and exits. 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. Does not accept more than one source directory (workaround: invoke separately for each directory, specifying the same zip file). =head1 AUTHOR Rudi Farkas rudif@lecroy.com rudif@bluemail.ch =head1 SEE ALSO perl ;-) =cut ��examples/readScalar.pl��0000644��00000001356�15030416166�0010767 0��ustar�00��#!/usr/bin/perl -w # Demonstrates reading a zip from an IO::Scalar # $Revision: 1.4 $ use strict; use Archive::Zip qw(:CONSTANTS :ERROR_CODES); use IO::Scalar; use IO::File; # test reading from a scalar my $file = IO::File->new('testin.zip', 'r'); my $zipContents; binmode($file); $file->read($zipContents, 20000); $file->close(); printf "Read %d bytes\n", length($zipContents); my $SH = IO::Scalar->new(\$zipContents); my $zip = Archive::Zip->new(); $zip->readFromFileHandle($SH); my $member = $zip->addString('c' x 300, 'bunchOfCs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); $member = $zip->addString('d' x 300, 'bunchOfDs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); $zip->writeToFileNamed('test2.zip'); ��examples/writeScalar.pl��0000644��00000001146�15030416166�0011203 0��ustar�00��#!/usr/bin/perl -w use strict; use Archive::Zip qw(:CONSTANTS :ERROR_CODES); use IO::Scalar; use IO::File; # test writing to a scalar my $zipContents = ''; my $SH = IO::Scalar->new(\$zipContents); my $zip = Archive::Zip->new(); my $member = $zip->addString('a' x 300, 'bunchOfAs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); $member = $zip->addString('b' x 300, 'bunchOfBs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); my $status = $zip->writeToFileHandle($SH); my $file = IO::File->new('test.zip', 'w'); binmode($file); $file->print($zipContents); $file->close(); ��examples/writeScalar2.pl��0000644��00000001145�15030416166�0011264 0��ustar�00��#!/usr/bin/perl -w use strict; use Archive::Zip qw(:CONSTANTS :ERROR_CODES); use IO::String; use IO::File; # test writing to a scalar my $zipContents = ''; my $SH = IO::String->new($zipContents); my $zip = Archive::Zip->new(); my $member = $zip->addString('a' x 300, 'bunchOfAs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); $member = $zip->addString('b' x 300, 'bunchOfBs.txt'); $member->desiredCompressionMethod(COMPRESSION_DEFLATED); my $status = $zip->writeToFileHandle($SH); my $file = IO::File->new('test.zip', 'w'); binmode($file); $file->print($zipContents); $file->close(); ��examples/zipcheck.pl��0000644��00000002035�15030416166�0010521 0��ustar�00��#!/usr/bin/perl -w # usage: valid zipname.zip # exits with non-zero status if invalid zip # status = 1: invalid arguments # status = 2: generic error somewhere # status = 3: format error # status = 4: IO error use strict; use Archive::Zip qw(:ERROR_CODES); use IO::Handle; use File::Spec; # instead of stack dump: Archive::Zip::setErrorHandler(sub { warn shift() }); my $nullFileName = File::Spec->devnull(); my $zip = Archive::Zip->new(); my $zipName = shift(@ARGV) \|\| exit 1; eval { my $status = $zip->read($zipName); exit $status if $status != AZ_OK; }; if ($@) { warn 'error reading zip:', $@, "\n"; exit 2 } eval { foreach my $member ($zip->members) { next if $member->isSymbolicLink(); my $fh = IO::File->new(); $fh->open(">$nullFileName") \|\| die "can't open $nullFileName\: $!\n"; my $status = $member->extractToFileHandle($fh); if ($status != AZ_OK) { warn "Extracting ", $member->fileName(), " from $zipName failed\n"; exit $status; } } } ��examples/zip.pl��0000644��00000001232�15030416166�0007521 0��ustar�00��#!/usr/bin/perl -w # Creates a zip file, adding the given directories and files. # Usage: # perl zip.pl zipfile.zip file [...] use strict; use Archive::Zip qw(:ERROR_CODES :CONSTANTS); die "usage: $0 zipfile.zip file [...]\n" if (scalar(@ARGV) < 2); my $zipName = shift(@ARGV); my $zip = Archive::Zip->new(); foreach my $memberName (map { glob } @ARGV) { if (-d $memberName) { warn "Can't add tree $memberName\n" if $zip->addTree($memberName, $memberName) != AZ_OK; } else { $zip->addFile($memberName) or warn "Can't add file $memberName\n"; } } my $status = $zip->writeToFileNamed($zipName); exit $status; ��examples/zipinfo.pl��0000644��00000010666�15030416166�0010410 0��ustar�00��#!/usr/bin/perl -w # Print out information about a ZIP file. # Note that this buffers the entire file into memory! # usage: # perl examples/zipinfo.pl zipfile.zip use strict; use Data::Dumper (); use FileHandle; use Archive::Zip qw(:ERROR_CODES :CONSTANTS :PKZIP_CONSTANTS); use Archive::Zip::BufferedFileHandle; $\| = 1; ### Workaround for a bug in version of Data::Dumper bundled ### with some versions of Perl, which causes warnings when ### calling ->Seen below. if (defined &Data::Dumper::init_refaddr_format) { Data::Dumper::init_refaddr_format(); } # use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING; use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE_STRING => pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE); use constant LOCAL_FILE_HEADER_SIGNATURE_STRING => pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE); $Data::Dumper::Useqq = 1; # enable double-quotes for string values $Data::Dumper::Indent = 1; my $zip = Archive::Zip->new(); my $zipFileName = shift(@ARGV); my $fh = Archive::Zip::BufferedFileHandle->new(); $fh->readFromFile($zipFileName) or exit($!); my $status = $zip->_findEndOfCentralDirectory($fh); die("can't find EOCD\n") if $status != AZ_OK; my $eocdPosition; ($status, $eocdPosition) = $zip->_readEndOfCentralDirectory($fh, $zipFileName); die("can't read EOCD\n") if $status != AZ_OK; my $zipDumper = Data::Dumper->new([$zip], ['ZIP']); $zipDumper->Seen({ref($fh), $fh}); print $zipDumper->Dump(), "\n"; my $expectedEOCDPosition = $zip->centralDirectoryOffsetWRTStartingDiskNumber() + $zip->centralDirectorySize(); my $eocdOffset = $zip->{eocdOffset} = $eocdPosition - $expectedEOCDPosition; if ($eocdOffset) { printf "Expected EOCD at %d (0x%x) but found it at %d (0x%x)\n", ($expectedEOCDPosition) x 2, ($eocdPosition) x 2; } else { printf("Found EOCD at %d (0x%x)\n\n", ($eocdPosition) x 2); } my $contents = $fh->contents(); my $offset = $eocdPosition + $eocdOffset - 1; my $cdPos; my @members; my $numberOfMembers = $zip->numberOfCentralDirectoriesOnThisDisk(); foreach my $n (0 .. $numberOfMembers - 1) { my $index = $numberOfMembers - $n; $cdPos = rindex($contents, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE_STRING, $offset); if ($cdPos < 0) { print "No central directory found for member #$index\n"; last; } else { print "Found central directory for member #$index at $cdPos\n"; $fh->seek($cdPos + SIGNATURE_LENGTH, 0); # SEEK_SET my $newMember = Archive::Zip::Member->_newFromZipFile($fh, "($zipFileName)", $zip->{'zip64'}); $status = $newMember->_readCentralDirectoryFileHeader(); if ($status != AZ_OK and $status != AZ_STREAM_END) { printf "read CD header status=%d\n", $status; last; } unshift(@members, $newMember); my $memberDumper = Data::Dumper->new([$newMember], ['CDMEMBER' . $index]); $memberDumper->Seen({ref($fh), $fh}); print $memberDumper->Dump(), "\n"; } $offset = $cdPos - 1; } if ( $cdPos >= 0 and $cdPos != $zip->centralDirectoryOffsetWRTStartingDiskNumber()) { printf "Expected to find central directory at %d (0x%x), but found it at %d (0x%x)\n", ($zip->centralDirectoryOffsetWRTStartingDiskNumber()) x 2, ($cdPos) x 2; } print "\n"; # Now read the local headers foreach my $n (0 .. $#members) { my $member = $members[$n]; $fh->seek( $member->localHeaderRelativeOffset() + $eocdOffset + SIGNATURE_LENGTH, 0); my $localHeaderSize; ($status, $localHeaderSize) = $member->_readLocalFileHeader(); if ($status != AZ_OK and $status != AZ_STREAM_END) { printf "member %d read header status=%d\n", $n + 1, $status; last; } my $memberDumper = Data::Dumper->new([$member], ['LHMEMBER' . ($n + 1)]); $memberDumper->Seen({ref($fh), $fh}); print $memberDumper->Dump(), "\n"; my $endOfMember = $member->localHeaderRelativeOffset() + $localHeaderSize + $member->compressedSize(); if ( $endOfMember > $cdPos or ( $n < $#members and $endOfMember > $members[$n + 1]->localHeaderRelativeOffset()) ) { print "Error: "; } printf("End of member: %d, CD at %d", $endOfMember, $cdPos); if ($n < $#members) { printf(", next member starts at %d", $members[$n + 1]->localHeaderRelativeOffset()); } print("\n\n"); } # vim: ts=4 sw=4 ��examples/mailZip.pl��0000644��00000003115�15030416166�0010326 0��ustar�00��#!/usr/bin/perl -w # Requires the following to be installed: # File::Path # File::Spec # IO::Scalar, ... from the IO-stringy distribution # MIME::Base64 # MIME::QuotedPrint # Net::SMTP # Mail::Internet, ... from the MailTools distribution. # MIME::Tools use strict; use Archive::Zip qw(:CONSTANTS :ERROR_CODES); use IO::Scalar; use MIME::Entity; # part of MIME::Tools package my $zipContents = ''; my $SH = IO::Scalar->new(\$zipContents); my $zip = Archive::Zip->new(); my $member; # add a string as a member: my $stringMember = '<html><head></head><body><h1>Testing</h1></body></html>'; $member = $zip->addString($stringMember, 'whatever.html'); # $member->desiredCompressionMethod(COMPRESSION_STORED); # write it to the scalar my $status = $zip->writeToFileHandle($SH); $SH->close; print STDERR "zip is " . length($zipContents) . " bytes long\n"; ### Create an entity: my $top = MIME::Entity->build( Type => 'multipart/mixed', From => 'ned@bike-nomad.com', To => 'billnevin@tricom.net', Subject => "Your zip", ); # attach the message $top->attach( Encoding => '7bit', Data => "here is the zip you ordered\n" ); # attach the zip $top->attach( Data => \$zipContents, Type => "application/x-zip", Encoding => "base64", Disposition => 'attachment', Filename => 'your.zip' ); # attach this code $top->attach( Encoding => '8bit', Type => 'text/plain', Path => $0, # Data => 'whatever', Disposition => 'inline' ); # and print it out to stdout $top->print(\STDOUT); ��examples/updateZip.pl��0000644��00000001614�15030416166�0010670 0��ustar�00��#!/usr/bin/perl # Shows how to update a Zip in place using a temp file. # $Revision: 1.1 $ # use Archive::Zip qw(:ERROR_CODES); use File::Copy(); my $zipName = shift \|\| die 'must provide a zip name'; my @fileNames = @ARGV; die 'must provide file names' unless scalar(@fileNames); # Read the zip my $zip = Archive::Zip->new(); die "can't read $zipName\n" unless $zip->read($zipName) == AZ_OK; # Update the zip foreach my $file (@fileNames) { $zip->removeMember($file); if (-r $file) { if (-f $file) { $zip->addFile($file) or die "Can't add $file to zip!\n"; } 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/mfh.pl��0000644��00000001220�15030416166�0007466 0��ustar�00��#!/usr/bin/perl # Prints messages on every chunk write. # Usage: # perl mfh.pl zipfile.zip # $Revision: 1.4 $ use strict; use Archive::Zip qw(:ERROR_CODES); use Archive::Zip::MockFileHandle; package NedsFileHandle; use vars qw(@ISA); @ISA = qw( Archive::Zip::MockFileHandle ); sub writeHook { my $self = shift; my $bytes = shift; my $length = length($bytes); printf "write %d bytes (position now %d)\n", $length, $self->tell(); return $length; } package main; my $zip = Archive::Zip->new(); my $status = $zip->read($ARGV[0]); exit $status if $status != AZ_OK; my $fh = NedsFileHandle->new(); $zip->writeToFileHandle($fh, 0); ��examples/extract.pl��0000644��00000001600�15030416166�0010370 0��ustar�00��#!/usr/bin/perl -w # Extracts the named files into 'extractTest' subdir # usage: # perl extract.pl [-j] zipfile.zip filename [...] # if -j option given, discards paths. # # $Revision: 1.5 $ # use strict; my $dirName = 'extractTest'; use vars qw( $opt_j ); use Archive::Zip qw(:ERROR_CODES); use Getopt::Std; $opt_j = 0; getopts('j'); if (@ARGV < 2) { die <<EOF usage: perl extract.pl [-j] zipfile.zip filename [...] if -j option given, discards paths. EOF } my $zip = Archive::Zip->new(); my $zipName = shift(@ARGV); my $status = $zip->read($zipName); die "Read of $zipName failed\n" if $status != AZ_OK; foreach my $memberName (@ARGV) { print "Extracting $memberName\n"; $status = $opt_j ? $zip->extractMemberWithoutPaths($memberName) : $zip->extractMember($memberName); die "Extracting $memberName from $zipName failed\n" if $status != AZ_OK; } ��examples/updateTree.pl��0000644��00000001506�15030416166�0011025 0��ustar�00��#!/usr/bin/perl # Shows how to update a Zip in place using a temp file. # # usage: # perl [-m] examples/updateTree.pl zipfile.zip dirname # # -m means to mirror # # $Id: updateTree.pl,v 1.2 2003/11/27 17:03:51 ned Exp $ # use Archive::Zip qw(:ERROR_CODES); my $mirror = 0; if ($ARGV[0] eq '-m') { shift; $mirror = 1; } my $zipName = shift \|\| die 'must provide a zip name'; my $dirName = shift \|\| die 'must provide a directory name'; # 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/unzipAll.pl��0000644��00000001061�15030416166�0010515 0��ustar�00��#!/usr/bin/perl -w # Extracts all files from the given zip # $Revision: 1.3 $ # usage: # perl unzipAll.pl [-j] zipfile.zip # if -j option given, discards paths. # use strict; use vars qw( $opt_j ); use Archive::Zip qw(:ERROR_CODES); use Getopt::Std; $opt_j = 0; getopts('j'); if (@ARGV < 1) { die <<EOF usage: perl $0 [-j] zipfile.zip if -j option given, discards paths. EOF } my $zip = Archive::Zip->new(); my $zipName = shift(@ARGV); my $status = $zip->read($zipName); die "Read of $zipName failed\n" if $status != AZ_OK; $zip->extractTree(); ��examples/ziptest.pl��0000644��00000003411�15030416166�0010422 0��ustar�00��#!/usr/bin/perl -w # $Revision: 1.7 $ # Lists the zipfile given as a first argument and tests CRC's. # Usage: # perl ziptest.pl zipfile.zip use strict; use Archive::Zip qw(:ERROR_CODES :CONSTANTS); package CRCComputingFileHandle; use Archive::Zip::MockFileHandle; use vars qw( @ISA ); @ISA = qw( Archive::Zip::MockFileHandle ); my $crc; sub writeHook { my $self = shift; my $bytes = shift; my $length = length($bytes); $crc = Archive::Zip::computeCRC32($bytes, $crc); } sub resetCRC { $crc = 0 } sub crc { $crc } package main; die "usage: $0 zipfile.zip\n" if (scalar(@ARGV) != 1); my $zip = Archive::Zip->new(); my $status = $zip->read($ARGV[0]); exit $status if $status != AZ_OK; print " Length Size Last Modified CRC-32 Name\n"; print "-------- -------- ------------------------ -------- ----\n"; my $fh = CRCComputingFileHandle->new(); my @errors; foreach my $member ($zip->members()) { my $compressedSize = $member->compressedSize(); $fh->resetCRC(); $member->desiredCompressionMethod(COMPRESSION_STORED); $status = $member->extractToFileHandle($fh); exit $status if $status != AZ_OK; my $crc = $fh->crc(); my $ct = scalar(localtime($member->lastModTime())); chomp($ct); printf( "%8d %8d %s %08x %s\n", $member->uncompressedSize(), $compressedSize, $ct, $member->crc32(), $member->fileName()); if ($member->crc32() != $crc) { push( @errors, sprintf( "Member %s CRC error: file says %08x computed: %08x\n", $member->fileName(), $member->crc32(), $crc )); } } if (scalar(@errors)) { print join("\n", @errors); die "CRC errors found\n"; } else { print "All CRCs check OK\n"; } ��

| ver. 1.4 | Github | . | PHP 8.2.28 | Generation time: 0.02 | proxy | phpinfo | Settings