mirror of
https://github.com/honeymoose/OpenSearch.git
synced 2025-02-17 02:14:54 +00:00
Refactored check_license_and_sha.pl to accept a license dir and package path
In preparation for the move to building the core zip, tar.gz, rpm, and deb as separate modules, refactored check_license_and_sha.pl to: * accept a license dir and path to the package to check on the command line * to be able to extract zip, tar.gz, deb, and rpm * all packages except rpm will work on Windows
This commit is contained in:
parent
16418b34a2
commit
f84757e8bb
@ -3,26 +3,45 @@
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use v5.10;
|
use v5.10;
|
||||||
|
|
||||||
|
use FindBin qw($RealBin);
|
||||||
|
use lib "$RealBin/lib";
|
||||||
|
use Archive::Ar();
|
||||||
|
use Cwd();
|
||||||
|
use File::Spec();
|
||||||
use Digest::SHA qw(sha1);
|
use Digest::SHA qw(sha1);
|
||||||
use File::Temp();
|
use File::Temp();
|
||||||
use File::Basename qw(basename);
|
use File::Basename qw(basename);
|
||||||
use File::Find();
|
use Archive::Extract();
|
||||||
my $mode = shift(@ARGV) || die usage();
|
$Archive::Extract::PREFER_BIN = 1;
|
||||||
my $dir = shift(@ARGV) || die usage();
|
|
||||||
$dir =~ s{/$}{};
|
|
||||||
|
|
||||||
our $RELEASES_DIR = "$dir/target/releases/";
|
our %Extract_Package = (
|
||||||
our $LICENSE_DIR = "$dir/licenses/";
|
zip => \&extract_zip,
|
||||||
|
gz => \&extract_tar_gz,
|
||||||
|
rpm => \&extract_rpm,
|
||||||
|
deb => \&extract_deb
|
||||||
|
);
|
||||||
|
|
||||||
$mode eq '--check' ? check_shas_and_licenses($dir)
|
my $mode = shift(@ARGV) || "";
|
||||||
: $mode eq '--update' ? write_shas($dir)
|
die usage() unless $mode =~ /^--(check|update)$/;
|
||||||
: die usage();
|
|
||||||
|
my $License_Dir = shift(@ARGV) || die usage();
|
||||||
|
my $Package = shift(@ARGV) || die usage();
|
||||||
|
$License_Dir = File::Spec->rel2abs($License_Dir) . '/';
|
||||||
|
$Package = File::Spec->rel2abs($Package);
|
||||||
|
|
||||||
|
die "License dir is not a directory: $License_Dir\n" . usage()
|
||||||
|
unless -d $License_Dir;
|
||||||
|
|
||||||
|
my %shas = get_shas_from_package($Package);
|
||||||
|
$mode eq '--check'
|
||||||
|
? exit check_shas_and_licenses(%shas)
|
||||||
|
: exit write_shas(%shas);
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
sub check_shas_and_licenses {
|
sub check_shas_and_licenses {
|
||||||
#===================================
|
#===================================
|
||||||
my %new = get_shas_from_zip();
|
my %new = @_;
|
||||||
check_tar_has_same_shas(%new);
|
|
||||||
|
|
||||||
my %old = get_sha_files();
|
my %old = get_sha_files();
|
||||||
my %licenses = get_files_with('LICENSE');
|
my %licenses = get_files_with('LICENSE');
|
||||||
@ -41,7 +60,8 @@ sub check_shas_and_licenses {
|
|||||||
}
|
}
|
||||||
|
|
||||||
unless ( $old_sha eq $new{$jar} ) {
|
unless ( $old_sha eq $new{$jar} ) {
|
||||||
say STDERR "$jar: SHA has changed, expected $old_sha but found $new{$jar}";
|
say STDERR
|
||||||
|
"$jar: SHA has changed, expected $old_sha but found $new{$jar}";
|
||||||
$error++;
|
$error++;
|
||||||
$sha_error++;
|
$sha_error++;
|
||||||
next;
|
next;
|
||||||
@ -101,18 +121,18 @@ sub check_shas_and_licenses {
|
|||||||
|
|
||||||
You can update the SHA files by running:
|
You can update the SHA files by running:
|
||||||
|
|
||||||
$0 --update core
|
$0 --update $License_Dir $Package
|
||||||
|
|
||||||
SHAS
|
SHAS
|
||||||
}
|
}
|
||||||
|
say "All SHAs and licenses OK" unless $error;
|
||||||
exit $error;
|
return $error;
|
||||||
}
|
}
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
sub write_shas {
|
sub write_shas {
|
||||||
#===================================
|
#===================================
|
||||||
my %new = get_shas_from_zip();
|
my %new = @_;
|
||||||
my %old = get_sha_files();
|
my %old = get_sha_files();
|
||||||
|
|
||||||
for my $jar ( sort keys %new ) {
|
for my $jar ( sort keys %new ) {
|
||||||
@ -123,7 +143,7 @@ sub write_shas {
|
|||||||
else {
|
else {
|
||||||
say "Adding $jar";
|
say "Adding $jar";
|
||||||
}
|
}
|
||||||
open my $fh, '>', $LICENSE_DIR . $jar or die $!;
|
open my $fh, '>', $License_Dir . $jar or die $!;
|
||||||
say $fh $new{$jar} or die $!;
|
say $fh $new{$jar} or die $!;
|
||||||
close $fh or die $!;
|
close $fh or die $!;
|
||||||
}
|
}
|
||||||
@ -133,8 +153,10 @@ sub write_shas {
|
|||||||
|
|
||||||
for my $jar ( sort keys %old ) {
|
for my $jar ( sort keys %old ) {
|
||||||
say "Deleting $jar";
|
say "Deleting $jar";
|
||||||
unlink $LICENSE_DIR . $jar or die $!;
|
unlink $License_Dir . $jar or die $!;
|
||||||
}
|
}
|
||||||
|
say "SHAs updated";
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
@ -142,7 +164,7 @@ sub get_files_with {
|
|||||||
#===================================
|
#===================================
|
||||||
my $pattern = shift;
|
my $pattern = shift;
|
||||||
my %files;
|
my %files;
|
||||||
for my $path ( grep {-f} glob("$LICENSE_DIR/*$pattern*") ) {
|
for my $path ( grep {-f} glob("$License_Dir/*$pattern*") ) {
|
||||||
my ($file) = ( $path =~ m{([^/]+)-${pattern}.*$} );
|
my ($file) = ( $path =~ m{([^/]+)-${pattern}.*$} );
|
||||||
$files{$file} = 0;
|
$files{$file} = 0;
|
||||||
}
|
}
|
||||||
@ -154,10 +176,10 @@ sub get_sha_files {
|
|||||||
#===================================
|
#===================================
|
||||||
my %shas;
|
my %shas;
|
||||||
|
|
||||||
die "Missing directory: $LICENSE_DIR\n"
|
die "Missing directory: $License_Dir\n"
|
||||||
unless -d $LICENSE_DIR;
|
unless -d $License_Dir;
|
||||||
|
|
||||||
for my $file ( grep {-f} glob("$LICENSE_DIR/*.sha1") ) {
|
for my $file ( grep {-f} glob("$License_Dir/*.sha1") ) {
|
||||||
my ($jar) = ( $file =~ m{([^/]+)$} );
|
my ($jar) = ( $file =~ m{([^/]+)$} );
|
||||||
open my $fh, '<', $file or die $!;
|
open my $fh, '<', $file or die $!;
|
||||||
my $sha = <$fh>;
|
my $sha = <$fh>;
|
||||||
@ -169,58 +191,82 @@ sub get_sha_files {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
sub get_shas_from_zip {
|
sub get_shas_from_package {
|
||||||
#===================================
|
#===================================
|
||||||
my ($zip) = glob("$RELEASES_DIR/elasticsearch*.zip")
|
my $package = shift;
|
||||||
or die "No .zip file found in $RELEASES_DIR\n";
|
my ($type) = ( $package =~ /\.(\w+)$/ );
|
||||||
|
die "Unrecognised package type: $package"
|
||||||
|
unless $type && $Extract_Package{$type};
|
||||||
|
|
||||||
my $temp_dir = File::Temp->newdir;
|
my $temp_dir = File::Temp->newdir;
|
||||||
my $dir_name = $temp_dir->dirname;
|
my $files
|
||||||
system( 'unzip', "-j", "-q", $zip, "*.jar", "-d" => $dir_name )
|
= eval { $Extract_Package{$type}->( $package, $temp_dir->dirname ) }
|
||||||
&& die "Error unzipping <$zip> to <" . $dir_name . ">: $!\n";
|
or die "Couldn't extract $package: $@";
|
||||||
|
|
||||||
my @jars = grep { !/\/elasticsearch[^\/]+.jar$/ } glob "$dir_name/*.jar";
|
my @jars = map {"$temp_dir/$_"}
|
||||||
|
grep { /\.jar$/ && !/elasticsearch[^\/]*$/ } @$files;
|
||||||
return calculate_shas(@jars);
|
return calculate_shas(@jars);
|
||||||
}
|
}
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
sub check_tar_has_same_shas {
|
sub extract_zip {
|
||||||
#===================================
|
#===================================
|
||||||
my %zip_shas = @_;
|
my ( $package, $dir ) = @_;
|
||||||
my ($tar) = glob("$RELEASES_DIR/elasticsearch*.tar.gz")
|
my $archive = Archive::Extract->new( archive => $package, type => 'zip' );
|
||||||
or return;
|
$archive->extract( to => $dir ) || die $archive->error;
|
||||||
|
return $archive->files;
|
||||||
|
}
|
||||||
|
|
||||||
my $temp_dir = File::Temp->newdir;
|
#===================================
|
||||||
my $dir_name = $temp_dir->dirname;
|
sub extract_tar_gz {
|
||||||
system( 'tar', "-xz", "-C" => $dir_name, "-f" => $tar )
|
#===================================
|
||||||
&& die "Error unpacking <$tar> to <" . $dir_name . ">: $!\n";
|
my ( $package, $dir ) = @_;
|
||||||
|
my $archive = Archive::Extract->new( archive => $package, type => 'tgz' );
|
||||||
|
$archive->extract( to => $dir ) || die $archive->error;
|
||||||
|
return $archive->files;
|
||||||
|
}
|
||||||
|
|
||||||
my @jars;
|
#===================================
|
||||||
File::Find::find(
|
sub extract_rpm {
|
||||||
{ wanted =>
|
#===================================
|
||||||
sub { push @jars, $_ if /\.jar$/ && !/elasticsearch[^\/]*$/ },
|
my ( $package, $dir ) = @_;
|
||||||
no_chdir => 1
|
my $cwd = Cwd::cwd();
|
||||||
},
|
my @files;
|
||||||
$dir_name
|
eval {
|
||||||
|
chdir $dir;
|
||||||
|
say "Trying with rpm2cpio";
|
||||||
|
my $out = eval {`rpm2cpio '$package' | cpio -idmv --quiet`};
|
||||||
|
unless ($out) {
|
||||||
|
say "Trying with rpm2cpio.pl";
|
||||||
|
$out = eval {`rpm2cpio.pl '$package' | cpio -idmv --quiet`};
|
||||||
|
}
|
||||||
|
@files = split "\n", $out if $out;
|
||||||
|
};
|
||||||
|
chdir $cwd;
|
||||||
|
die $@ if $@;
|
||||||
|
die "Couldn't extract $package\n" unless @files;
|
||||||
|
return \@files;
|
||||||
|
}
|
||||||
|
|
||||||
|
#===================================
|
||||||
|
sub extract_deb {
|
||||||
|
#===================================
|
||||||
|
my ( $package, $dir ) = @_;
|
||||||
|
my $archive = Archive::Ar->new;
|
||||||
|
$archive->read($package) || die $archive->error;
|
||||||
|
my $cwd = Cwd::cwd();
|
||||||
|
eval {
|
||||||
|
chdir $dir;
|
||||||
|
$archive->extract('data.tar.gz') || die $archive->error;
|
||||||
|
};
|
||||||
|
chdir $cwd;
|
||||||
|
die $@ if $@;
|
||||||
|
$archive = Archive::Extract->new(
|
||||||
|
archive => $dir . '/data.tar.gz',
|
||||||
|
type => 'tgz'
|
||||||
);
|
);
|
||||||
|
$archive->extract( to => $dir ) || die $archive->error;
|
||||||
my %tar_shas = calculate_shas(@jars);
|
return $archive->files;
|
||||||
my @errors;
|
|
||||||
for ( sort keys %zip_shas ) {
|
|
||||||
my $sha = delete $tar_shas{$_};
|
|
||||||
if ( !$sha ) {
|
|
||||||
push @errors, "$_: JAR present in zip but not in tar.gz";
|
|
||||||
}
|
|
||||||
elsif ( $sha ne $zip_shas{$_} ) {
|
|
||||||
push @errors, "$_: JAR in zip and tar.gz are different";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
for ( sort keys %tar_shas ) {
|
|
||||||
push @errors, "$_: JAR present in tar.gz but not in zip";
|
|
||||||
}
|
|
||||||
if (@errors) {
|
|
||||||
die join "\n", @errors;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#===================================
|
#===================================
|
||||||
@ -242,11 +288,13 @@ sub usage {
|
|||||||
|
|
||||||
USAGE:
|
USAGE:
|
||||||
|
|
||||||
$0 --check dir # check the sha1 and LICENSE files for each jar
|
# check the sha1 and LICENSE files for each jar in the zip|gz|deb|rpm
|
||||||
$0 --update dir # update the sha1 files for each jar
|
$0 --check path/to/licenses/ path/to/package.zip
|
||||||
|
|
||||||
The <dir> can be set to e.g. 'core' or 'plugins/analysis-icu/'
|
# updates the sha1s for each jar in the zip|gz|deb|rpm
|
||||||
|
$0 --update path/to/licenses/ path/to/package.zip
|
||||||
|
|
||||||
USAGE
|
USAGE
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
806
dev-tools/src/main/resources/license-check/lib/Archive/Ar.pm
Normal file
806
dev-tools/src/main/resources/license-check/lib/Archive/Ar.pm
Normal file
@ -0,0 +1,806 @@
|
|||||||
|
###########################################################
|
||||||
|
# Archive::Ar - Pure perl module to handle ar achives
|
||||||
|
#
|
||||||
|
# Copyright 2003 - Jay Bonci <jaybonci@cpan.org>
|
||||||
|
# Copyright 2014 - John Bazik <jbazik@cpan.org>
|
||||||
|
# Licensed under the same terms as perl itself
|
||||||
|
#
|
||||||
|
###########################################################
|
||||||
|
package Archive::Ar;
|
||||||
|
|
||||||
|
use base qw(Exporter);
|
||||||
|
our @EXPORT_OK = qw(COMMON BSD GNU);
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use File::Spec;
|
||||||
|
use Time::Local;
|
||||||
|
use Carp qw(carp longmess);
|
||||||
|
|
||||||
|
use vars qw($VERSION);
|
||||||
|
$VERSION = '2.02';
|
||||||
|
|
||||||
|
use constant CAN_CHOWN => ($> == 0 and $^O ne 'MacOS' and $^O ne 'MSWin32');
|
||||||
|
|
||||||
|
use constant ARMAG => "!<arch>\n";
|
||||||
|
use constant SARMAG => length(ARMAG);
|
||||||
|
use constant ARFMAG => "`\n";
|
||||||
|
use constant AR_EFMT1 => "#1/";
|
||||||
|
|
||||||
|
use constant COMMON => 1;
|
||||||
|
use constant BSD => 2;
|
||||||
|
use constant GNU => 3;
|
||||||
|
|
||||||
|
my $has_io_string;
|
||||||
|
BEGIN {
|
||||||
|
$has_io_string = eval {
|
||||||
|
require IO::String;
|
||||||
|
IO::String->import();
|
||||||
|
1;
|
||||||
|
} || 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $file = shift;
|
||||||
|
my $opts = shift || 0;
|
||||||
|
my $self = bless {}, $class;
|
||||||
|
my $defopts = {
|
||||||
|
chmod => 1,
|
||||||
|
chown => 1,
|
||||||
|
same_perms => ($> == 0) ? 1:0,
|
||||||
|
symbols => undef,
|
||||||
|
};
|
||||||
|
$opts = {warn => $opts} unless ref $opts;
|
||||||
|
|
||||||
|
$self->clear();
|
||||||
|
$self->{opts} = {(%$defopts, %{$opts})};
|
||||||
|
if ($file) {
|
||||||
|
return unless $self->read($file);
|
||||||
|
}
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub set_opt {
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift;
|
||||||
|
my $val = shift;
|
||||||
|
|
||||||
|
$self->{opts}->{$name} = $val;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_opt {
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift;
|
||||||
|
|
||||||
|
return $self->{opts}->{$name};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub type {
|
||||||
|
return shift->{type};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub clear {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
$self->{names} = [];
|
||||||
|
$self->{files} = {};
|
||||||
|
$self->{type} = undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub read {
|
||||||
|
my $self = shift;
|
||||||
|
my $file = shift;
|
||||||
|
|
||||||
|
my $fh = $self->_get_handle($file);
|
||||||
|
local $/ = undef;
|
||||||
|
my $data = <$fh>;
|
||||||
|
close $fh;
|
||||||
|
|
||||||
|
return $self->read_memory($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub read_memory {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = shift;
|
||||||
|
|
||||||
|
$self->clear();
|
||||||
|
return unless $self->_parse($data);
|
||||||
|
return length($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub contains_file {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
|
||||||
|
return unless defined $filename;
|
||||||
|
return exists $self->{files}->{$filename};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub extract {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
for my $filename (@_ ? @_ : @{$self->{names}}) {
|
||||||
|
$self->extract_file($filename) or return;
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub extract_file {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $target = shift || $filename;
|
||||||
|
|
||||||
|
my $meta = $self->{files}->{$filename};
|
||||||
|
return $self->_error("$filename: not in archive") unless $meta;
|
||||||
|
open my $fh, '>', $target or return $self->_error("$target: $!");
|
||||||
|
binmode $fh;
|
||||||
|
syswrite $fh, $meta->{data} or return $self->_error("$filename: $!");
|
||||||
|
close $fh or return $self->_error("$filename: $!");
|
||||||
|
if (CAN_CHOWN && $self->{opts}->{chown}) {
|
||||||
|
chown $meta->{uid}, $meta->{gid}, $filename or
|
||||||
|
return $self->_error("$filename: $!");
|
||||||
|
}
|
||||||
|
if ($self->{opts}->{chmod}) {
|
||||||
|
my $mode = $meta->{mode};
|
||||||
|
unless ($self->{opts}->{same_perms}) {
|
||||||
|
$mode &= ~(oct(7000) | (umask | 0));
|
||||||
|
}
|
||||||
|
chmod $mode, $filename or return $self->_error("$filename: $!");
|
||||||
|
}
|
||||||
|
utime $meta->{date}, $meta->{date}, $filename or
|
||||||
|
return $self->_error("$filename: $!");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub rename {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $target = shift;
|
||||||
|
|
||||||
|
if ($self->{files}->{$filename}) {
|
||||||
|
$self->{files}->{$target} = $self->{files}->{$filename};
|
||||||
|
delete $self->{files}->{$filename};
|
||||||
|
for (@{$self->{names}}) {
|
||||||
|
if ($_ eq $filename) {
|
||||||
|
$_ = $target;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub chmod {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $mode = shift; # octal string or numeric
|
||||||
|
|
||||||
|
return unless $self->{files}->{$filename};
|
||||||
|
$self->{files}->{$filename}->{mode} =
|
||||||
|
$mode + 0 eq $mode ? $mode : oct($mode);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub chown {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $uid = shift;
|
||||||
|
my $gid = shift;
|
||||||
|
|
||||||
|
return unless $self->{files}->{$filename};
|
||||||
|
$self->{files}->{$filename}->{uid} = $uid if $uid >= 0;
|
||||||
|
$self->{files}->{$filename}->{gid} = $gid if defined $gid && $gid >= 0;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub remove {
|
||||||
|
my $self = shift;
|
||||||
|
my $files = ref $_[0] ? shift : \@_;
|
||||||
|
|
||||||
|
my $nfiles_orig = scalar @{$self->{names}};
|
||||||
|
|
||||||
|
for my $file (@$files) {
|
||||||
|
next unless $file;
|
||||||
|
if (exists($self->{files}->{$file})) {
|
||||||
|
delete $self->{files}->{$file};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->_error("$file: no such member")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
@{$self->{names}} = grep($self->{files}->{$_}, @{$self->{names}});
|
||||||
|
|
||||||
|
return $nfiles_orig - scalar @{$self->{names}};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_files {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
return wantarray ? @{$self->{names}} : $self->{names};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_files {
|
||||||
|
my $self = shift;
|
||||||
|
my $files = ref $_[0] ? shift : \@_;
|
||||||
|
|
||||||
|
for my $path (@$files) {
|
||||||
|
if (open my $fd, $path) {
|
||||||
|
my @st = stat $fd or return $self->_error("$path: $!");
|
||||||
|
local $/ = undef;
|
||||||
|
binmode $fd;
|
||||||
|
my $content = <$fd>;
|
||||||
|
close $fd;
|
||||||
|
|
||||||
|
my $filename = (File::Spec->splitpath($path))[2];
|
||||||
|
|
||||||
|
$self->_add_data($filename, $content, @st[9,4,5,2,7]);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->_error("$path: $!");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return scalar @{$self->{names}};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_data {
|
||||||
|
my $self = shift;
|
||||||
|
my $path = shift;
|
||||||
|
my $content = shift;
|
||||||
|
my $params = shift || {};
|
||||||
|
|
||||||
|
return $self->_error("No filename given") unless $path;
|
||||||
|
|
||||||
|
my $filename = (File::Spec->splitpath($path))[2];
|
||||||
|
|
||||||
|
$self->_add_data($filename, $content,
|
||||||
|
$params->{date} || timelocal(localtime()),
|
||||||
|
$params->{uid} || 0,
|
||||||
|
$params->{gid} || 0,
|
||||||
|
$params->{mode} || 0100644) or return;
|
||||||
|
|
||||||
|
return $self->{files}->{$filename}->{size};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub write {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $opts = {(%{$self->{opts}}, %{shift || {}})};
|
||||||
|
my $type = $opts->{type} || $self->{type} || COMMON;
|
||||||
|
|
||||||
|
my @body = ( ARMAG );
|
||||||
|
|
||||||
|
my %gnuindex;
|
||||||
|
my @filenames = @{$self->{names}};
|
||||||
|
if ($type eq GNU) {
|
||||||
|
#
|
||||||
|
# construct extended filename index, if needed
|
||||||
|
#
|
||||||
|
if (my @longs = grep(length($_) > 15, @filenames)) {
|
||||||
|
my $ptr = 0;
|
||||||
|
for my $long (@longs) {
|
||||||
|
$gnuindex{$long} = $ptr;
|
||||||
|
$ptr += length($long) + 2;
|
||||||
|
}
|
||||||
|
push @body, pack('A16A32A10A2', '//', '', $ptr, ARFMAG),
|
||||||
|
join("/\n", @longs, '');
|
||||||
|
push @body, "\n" if $ptr % 2; # padding
|
||||||
|
}
|
||||||
|
}
|
||||||
|
for my $fn (@filenames) {
|
||||||
|
my $meta = $self->{files}->{$fn};
|
||||||
|
my $mode = sprintf('%o', $meta->{mode});
|
||||||
|
my $size = $meta->{size};
|
||||||
|
my $name;
|
||||||
|
|
||||||
|
if ($type eq GNU) {
|
||||||
|
$fn = '' if defined $opts->{symbols} && $fn eq $opts->{symbols};
|
||||||
|
$name = $fn . '/';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$name = $fn;
|
||||||
|
}
|
||||||
|
if (length($name) <= 16 || $type eq COMMON) {
|
||||||
|
push @body, pack('A16A12A6A6A8A10A2', $name,
|
||||||
|
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG);
|
||||||
|
}
|
||||||
|
elsif ($type eq GNU) {
|
||||||
|
push @body, pack('A1A15A12A6A6A8A10A2', '/', $gnuindex{$fn},
|
||||||
|
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG);
|
||||||
|
}
|
||||||
|
elsif ($type eq BSD) {
|
||||||
|
$size += length($name);
|
||||||
|
push @body, pack('A3A13A12A6A6A8A10A2', AR_EFMT1, length($name),
|
||||||
|
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG),
|
||||||
|
$name;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return $self->_error("$type: unexpected ar type");
|
||||||
|
}
|
||||||
|
push @body, $meta->{data};
|
||||||
|
push @body, "\n" if $size % 2; # padding
|
||||||
|
}
|
||||||
|
if ($filename) {
|
||||||
|
my $fh = $self->_get_handle($filename, '>');
|
||||||
|
print $fh @body;
|
||||||
|
close $fh;
|
||||||
|
my $len = 0;
|
||||||
|
$len += length($_) for @body;
|
||||||
|
return $len;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return join '', @body;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_content {
|
||||||
|
my $self = shift;
|
||||||
|
my ($filename) = @_;
|
||||||
|
|
||||||
|
unless ($filename) {
|
||||||
|
$self->_error("get_content can't continue without a filename");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
unless (exists($self->{files}->{$filename})) {
|
||||||
|
$self->_error(
|
||||||
|
"get_content failed because there is not a file named $filename");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $self->{files}->{$filename};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_data {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
|
||||||
|
return $self->_error("$filename: no such member")
|
||||||
|
unless exists $self->{files}->{$filename};
|
||||||
|
return $self->{files}->{$filename}->{data};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_handle {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $fh;
|
||||||
|
|
||||||
|
return $self->_error("$filename: no such member")
|
||||||
|
unless exists $self->{files}->{$filename};
|
||||||
|
if ($has_io_string) {
|
||||||
|
$fh = IO::String->new($self->{files}->{$filename}->{data});
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $data = $self->{files}->{$filename}->{data};
|
||||||
|
open $fh, '<', \$data or return $self->_error("in-memory file: $!");
|
||||||
|
}
|
||||||
|
return $fh;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub error {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
return shift() ? $self->{longmess} : $self->{error};
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# deprecated
|
||||||
|
#
|
||||||
|
sub DEBUG {
|
||||||
|
my $self = shift;
|
||||||
|
my $debug = shift;
|
||||||
|
|
||||||
|
$self->{opts}->{warn} = 1 unless (defined($debug) and int($debug) == 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _parse {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = shift;
|
||||||
|
|
||||||
|
unless (substr($data, 0, SARMAG, '') eq ARMAG) {
|
||||||
|
return $self->_error("Bad magic number - not an ar archive");
|
||||||
|
}
|
||||||
|
my $type;
|
||||||
|
my $names;
|
||||||
|
while ($data =~ /\S/) {
|
||||||
|
my ($name, $date, $uid, $gid, $mode, $size, $magic) =
|
||||||
|
unpack('A16A12A6A6A8A10a2', substr($data, 0, 60, ''));
|
||||||
|
unless ($magic eq "`\n") {
|
||||||
|
return $self->_error("Bad file header");
|
||||||
|
}
|
||||||
|
if ($name =~ m|^/|) {
|
||||||
|
$type = GNU;
|
||||||
|
if ($name eq '//') {
|
||||||
|
$names = substr($data, 0, $size, '');
|
||||||
|
substr($data, 0, $size % 2, '');
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
elsif ($name eq '/') {
|
||||||
|
$name = $self->{opts}->{symbols};
|
||||||
|
unless (defined $name && $name) {
|
||||||
|
substr($data, 0, $size + $size % 2, '');
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$name = substr($names, int(substr($name, 1)));
|
||||||
|
$name =~ s/\n.*//;
|
||||||
|
chop $name;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ($name =~ m|^#1/|) {
|
||||||
|
$type = BSD;
|
||||||
|
$name = substr($data, 0, int(substr($name, 3)), '');
|
||||||
|
$size -= length($name);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ($name =~ m|/$|) {
|
||||||
|
$type ||= GNU; # only gnu has trailing slashes
|
||||||
|
chop $name;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$uid = int($uid);
|
||||||
|
$gid = int($gid);
|
||||||
|
$mode = oct($mode);
|
||||||
|
my $content = substr($data, 0, $size, '');
|
||||||
|
substr($data, 0, $size % 2, '');
|
||||||
|
|
||||||
|
$self->_add_data($name, $content, $date, $uid, $gid, $mode, $size);
|
||||||
|
}
|
||||||
|
$self->{type} = $type || COMMON;
|
||||||
|
return scalar @{$self->{names}};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _add_data {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $content = shift || '';
|
||||||
|
my $date = shift;
|
||||||
|
my $uid = shift;
|
||||||
|
my $gid = shift;
|
||||||
|
my $mode = shift;
|
||||||
|
my $size = shift;
|
||||||
|
|
||||||
|
if (exists($self->{files}->{$filename})) {
|
||||||
|
return $self->_error("$filename: entry already exists");
|
||||||
|
}
|
||||||
|
$self->{files}->{$filename} = {
|
||||||
|
name => $filename,
|
||||||
|
date => defined $date ? $date : timelocal(localtime()),
|
||||||
|
uid => defined $uid ? $uid : 0,
|
||||||
|
gid => defined $gid ? $gid : 0,
|
||||||
|
mode => defined $mode ? $mode : 0100644,
|
||||||
|
size => defined $size ? $size : length($content),
|
||||||
|
data => $content,
|
||||||
|
};
|
||||||
|
push @{$self->{names}}, $filename;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _get_handle {
|
||||||
|
my $self = shift;
|
||||||
|
my $file = shift;
|
||||||
|
my $mode = shift || '<';
|
||||||
|
|
||||||
|
if (ref $file) {
|
||||||
|
return $file if eval{*$file{IO}} or $file->isa('IO::Handle');
|
||||||
|
return $self->_error("Not a filehandle");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
open my $fh, $mode, $file or return $self->_error("$file: $!");
|
||||||
|
binmode $fh;
|
||||||
|
return $fh;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _error {
|
||||||
|
my $self = shift;
|
||||||
|
my $msg = shift;
|
||||||
|
|
||||||
|
$self->{error} = $msg;
|
||||||
|
$self->{longerror} = longmess($msg);
|
||||||
|
if ($self->{opts}->{warn} > 1) {
|
||||||
|
carp $self->{longerror};
|
||||||
|
}
|
||||||
|
elsif ($self->{opts}->{warn}) {
|
||||||
|
carp $self->{error};
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Archive::Ar - Interface for manipulating ar archives
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use Archive::Ar;
|
||||||
|
|
||||||
|
my $ar = Archive::Ar->new;
|
||||||
|
|
||||||
|
$ar->read('./foo.ar');
|
||||||
|
$ar->extract;
|
||||||
|
|
||||||
|
$ar->add_files('./bar.tar.gz', 'bat.pl')
|
||||||
|
$ar->add_data('newfile.txt','Some contents');
|
||||||
|
|
||||||
|
$ar->chmod('file1', 0644);
|
||||||
|
$ar->chown('file1', $uid, $gid);
|
||||||
|
|
||||||
|
$ar->remove('file1', 'file2');
|
||||||
|
|
||||||
|
my $filehash = $ar->get_content('bar.tar.gz');
|
||||||
|
my $data = $ar->get_data('bar.tar.gz');
|
||||||
|
my $handle = $ar->get_handle('bar.tar.gz');
|
||||||
|
|
||||||
|
my @files = $ar->list_files();
|
||||||
|
|
||||||
|
my $archive = $ar->write;
|
||||||
|
my $size = $ar->write('outbound.ar');
|
||||||
|
|
||||||
|
$ar->error();
|
||||||
|
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Archive::Ar is a pure-perl way to handle standard ar archives.
|
||||||
|
|
||||||
|
This is useful if you have those types of archives on the system, but it
|
||||||
|
is also useful because .deb packages for the Debian GNU/Linux distribution are
|
||||||
|
ar archives. This is one building block in a future chain of modules to build,
|
||||||
|
manipulate, extract, and test debian modules with no platform or architecture
|
||||||
|
dependence.
|
||||||
|
|
||||||
|
You may notice that the API to Archive::Ar is similar to Archive::Tar, and
|
||||||
|
this was done intentionally to keep similarity between the Archive::*
|
||||||
|
modules.
|
||||||
|
|
||||||
|
=head1 METHODS
|
||||||
|
|
||||||
|
=head2 new
|
||||||
|
|
||||||
|
$ar = Archive::Ar->new()
|
||||||
|
$ar = Archive::Ar->new($filename)
|
||||||
|
$ar = Archive::Ar->new($filehandle)
|
||||||
|
|
||||||
|
Returns a new Archive::Ar object. Without an argument, it returns
|
||||||
|
an empty object. If passed a filename or an open filehandle, it will
|
||||||
|
read the referenced archive into memory. If the read fails for any
|
||||||
|
reason, returns undef.
|
||||||
|
|
||||||
|
=head2 set_opt
|
||||||
|
|
||||||
|
$ar->set_opt($name, $val)
|
||||||
|
|
||||||
|
Assign option $name value $val. Possible options are:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item * warn
|
||||||
|
|
||||||
|
Warning level. Levels are zero for no warnings, 1 for brief warnings,
|
||||||
|
and 2 for warnings with a stack trace. Default is zero.
|
||||||
|
|
||||||
|
=item * chmod
|
||||||
|
|
||||||
|
Change the file permissions of files created when extracting. Default
|
||||||
|
is true (non-zero).
|
||||||
|
|
||||||
|
=item * same_perms
|
||||||
|
|
||||||
|
When setting file permissions, use the values in the archive unchanged.
|
||||||
|
If false, removes setuid bits and applies the user's umask. Default is
|
||||||
|
true for the root user, false otherwise.
|
||||||
|
|
||||||
|
=item * chown
|
||||||
|
|
||||||
|
Change the owners of extracted files, if possible. Default is true.
|
||||||
|
|
||||||
|
=item * type
|
||||||
|
|
||||||
|
Archive type. May be GNU, BSD or COMMON, or undef if no archive has
|
||||||
|
been read. Defaults to the type of the archive read, or undef.
|
||||||
|
|
||||||
|
=item * symbols
|
||||||
|
|
||||||
|
Provide a filename for the symbol table, if present. If set, the symbol
|
||||||
|
table is treated as a file that can be read from or written to an archive.
|
||||||
|
It is an error if the filename provided matches the name of a file in the
|
||||||
|
archive. If undefined, the symbol table is ignored. Defaults to undef.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head2 get_opt
|
||||||
|
|
||||||
|
$val = $ar->get_opt($name)
|
||||||
|
|
||||||
|
Returns the value of option $name.
|
||||||
|
|
||||||
|
=head2 type
|
||||||
|
|
||||||
|
$type = $ar->type()
|
||||||
|
|
||||||
|
Returns the type of the ar archive. The type is undefined until an
|
||||||
|
archive is loaded. If the archive displays characteristics of a gnu-style
|
||||||
|
archive, GNU is returned. If it looks like a bsd-style archive, BSD
|
||||||
|
is returned. Otherwise, COMMON is returned. Note that unless filenames
|
||||||
|
exceed 16 characters in length, bsd archives look like the common format.
|
||||||
|
|
||||||
|
=head2 clear
|
||||||
|
|
||||||
|
$ar->clear()
|
||||||
|
|
||||||
|
Clears the current in-memory archive.
|
||||||
|
|
||||||
|
=head2 read
|
||||||
|
|
||||||
|
$len = $ar->read($filename)
|
||||||
|
$len = $ar->read($filehandle)
|
||||||
|
|
||||||
|
This reads a new file into the object, removing any ar archive already
|
||||||
|
represented in the object. The argument may be a filename, filehandle
|
||||||
|
or IO::Handle object. Returns the size of the file contents or undef
|
||||||
|
if it fails.
|
||||||
|
|
||||||
|
=head2 read_memory
|
||||||
|
|
||||||
|
$len = $ar->read_memory($data)
|
||||||
|
|
||||||
|
Parses the string argument as an archive, reading it into memory. Replaces
|
||||||
|
any previously loaded archive. Returns the number of bytes read, or undef
|
||||||
|
if it fails.
|
||||||
|
|
||||||
|
=head2 contains_file
|
||||||
|
|
||||||
|
$bool = $ar->contains_file($filename)
|
||||||
|
|
||||||
|
Returns true if the archive contains a file with $filename. Returns
|
||||||
|
undef otherwise.
|
||||||
|
|
||||||
|
=head2 extract
|
||||||
|
|
||||||
|
$ar->extract()
|
||||||
|
$ar->extract_file($filename)
|
||||||
|
|
||||||
|
Extracts files from the archive. The first form extracts all files, the
|
||||||
|
latter extracts just the named file. Extracted files are assigned the
|
||||||
|
permissions and modification time stored in the archive, and, if possible,
|
||||||
|
the user and group ownership. Returns non-zero upon success, or undef if
|
||||||
|
failure.
|
||||||
|
|
||||||
|
=head2 rename
|
||||||
|
|
||||||
|
$ar->rename($filename, $newname)
|
||||||
|
|
||||||
|
Changes the name of a file in the in-memory archive.
|
||||||
|
|
||||||
|
=head2 chmod
|
||||||
|
|
||||||
|
$ar->chmod($filename, $mode);
|
||||||
|
|
||||||
|
Change the mode of the member to C<$mode>.
|
||||||
|
|
||||||
|
=head2 chown
|
||||||
|
|
||||||
|
$ar->chown($filename, $uid, $gid);
|
||||||
|
$ar->chown($filename, $uid);
|
||||||
|
|
||||||
|
Change the ownership of the member to user id C<$uid> and (optionally)
|
||||||
|
group id C<$gid>. Negative id values are ignored.
|
||||||
|
|
||||||
|
=head2 remove
|
||||||
|
|
||||||
|
$ar->remove(@filenames)
|
||||||
|
$ar->remove($arrayref)
|
||||||
|
|
||||||
|
Removes files from the in-memory archive. Returns the number of files
|
||||||
|
removed.
|
||||||
|
|
||||||
|
=head2 list_files
|
||||||
|
|
||||||
|
@filenames = $ar->list_files()
|
||||||
|
|
||||||
|
Returns a list of the names of all the files in the archive.
|
||||||
|
If called in a scalar context, returns a reference to an array.
|
||||||
|
|
||||||
|
=head2 add_files
|
||||||
|
|
||||||
|
$ar->add_files(@filenames)
|
||||||
|
$ar->add_files($arrayref)
|
||||||
|
|
||||||
|
Adds files to the archive. The arguments can be paths, but only the
|
||||||
|
filenames are stored in the archive. Stores the uid, gid, mode, size,
|
||||||
|
and modification timestamp of the file as returned by C<stat()>.
|
||||||
|
|
||||||
|
Returns the number of files successfully added, or undef if failure.
|
||||||
|
|
||||||
|
=head2 add_data
|
||||||
|
|
||||||
|
$ar->add_data("filename", $data)
|
||||||
|
$ar->add_data("filename", $data, $options)
|
||||||
|
|
||||||
|
Adds a file to the in-memory archive with name $filename and content
|
||||||
|
$data. File properties can be set with $optional_hashref:
|
||||||
|
|
||||||
|
$options = {
|
||||||
|
'data' => $data,
|
||||||
|
'uid' => $uid, #defaults to zero
|
||||||
|
'gid' => $gid, #defaults to zero
|
||||||
|
'date' => $date, #date in epoch seconds. Defaults to now.
|
||||||
|
'mode' => $mode, #defaults to 0100644;
|
||||||
|
}
|
||||||
|
|
||||||
|
You cannot add_data over another file however. This returns the file length in
|
||||||
|
bytes if it is successful, undef otherwise.
|
||||||
|
|
||||||
|
=head2 write
|
||||||
|
|
||||||
|
$data = $ar->write()
|
||||||
|
$len = $ar->write($filename)
|
||||||
|
|
||||||
|
Returns the archive as a string, or writes it to disk as $filename.
|
||||||
|
Returns the archive size upon success when writing to disk. Returns
|
||||||
|
undef if failure.
|
||||||
|
|
||||||
|
=head2 get_content
|
||||||
|
|
||||||
|
$content = $ar->get_content($filename)
|
||||||
|
|
||||||
|
This returns a hash with the file content in it, including the data
|
||||||
|
that the file would contain. If the file does not exist or no filename
|
||||||
|
is given, this returns undef. On success, a hash is returned:
|
||||||
|
|
||||||
|
$content = {
|
||||||
|
'name' => $filename,
|
||||||
|
'date' => $mtime,
|
||||||
|
'uid' => $uid,
|
||||||
|
'gid' => $gid,
|
||||||
|
'mode' => $mode,
|
||||||
|
'size' => $size,
|
||||||
|
'data' => $file_contents,
|
||||||
|
}
|
||||||
|
|
||||||
|
=head2 get_data
|
||||||
|
|
||||||
|
$data = $ar->get_data("filename")
|
||||||
|
|
||||||
|
Returns a scalar containing the file data of the given archive
|
||||||
|
member. Upon error, returns undef.
|
||||||
|
|
||||||
|
=head2 get_handle
|
||||||
|
|
||||||
|
$handle = $ar->get_handle("filename")>
|
||||||
|
|
||||||
|
Returns a file handle to the in-memory file data of the given archive member.
|
||||||
|
Upon error, returns undef. This can be useful for unpacking nested archives.
|
||||||
|
Uses IO::String if it's loaded.
|
||||||
|
|
||||||
|
=head2 error
|
||||||
|
|
||||||
|
$errstr = $ar->error($trace)
|
||||||
|
|
||||||
|
Returns the current error string, which is usually the last error reported.
|
||||||
|
If a true value is provided, returns the error message and stack trace.
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
See https://github.com/jbazik/Archive-Ar/issues/ to report and view bugs.
|
||||||
|
|
||||||
|
=head1 SOURCE
|
||||||
|
|
||||||
|
The source code repository for Archive::Ar can be found at http://github.com/jbazik/Archive-Ar/.
|
||||||
|
|
||||||
|
=head1 COPYRIGHT
|
||||||
|
|
||||||
|
Copyright 2009-2014 John Bazik E<lt>jbazik@cpan.orgE<gt>.
|
||||||
|
|
||||||
|
Copyright 2003 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>.
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as Perl itself.
|
||||||
|
|
||||||
|
See http://www.perl.com/perl/misc/Artistic.html
|
||||||
|
|
||||||
|
=cut
|
1694
dev-tools/src/main/resources/license-check/lib/Archive/Extract.pm
Normal file
1694
dev-tools/src/main/resources/license-check/lib/Archive/Extract.pm
Normal file
File diff suppressed because it is too large
Load Diff
2136
dev-tools/src/main/resources/license-check/lib/Archive/Zip.pm
Normal file
2136
dev-tools/src/main/resources/license-check/lib/Archive/Zip.pm
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,131 @@
|
|||||||
|
package Archive::Zip::BufferedFileHandle;
|
||||||
|
|
||||||
|
# File handle that uses a string internally and can seek
|
||||||
|
# This is given as a demo for getting a zip file written
|
||||||
|
# to a string.
|
||||||
|
# I probably should just use IO::Scalar instead.
|
||||||
|
# Ned Konz, March 2000
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use IO::File;
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
use vars qw{$VERSION};
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
$VERSION = eval $VERSION;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift || __PACKAGE__;
|
||||||
|
$class = ref($class) || $class;
|
||||||
|
my $self = bless(
|
||||||
|
{
|
||||||
|
content => '',
|
||||||
|
position => 0,
|
||||||
|
size => 0
|
||||||
|
},
|
||||||
|
$class
|
||||||
|
);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Utility method to read entire file
|
||||||
|
sub readFromFile {
|
||||||
|
my $self = shift;
|
||||||
|
my $fileName = shift;
|
||||||
|
my $fh = IO::File->new($fileName, "r");
|
||||||
|
CORE::binmode($fh);
|
||||||
|
if (!$fh) {
|
||||||
|
Carp::carp("Can't open $fileName: $!\n");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
local $/ = undef;
|
||||||
|
$self->{content} = <$fh>;
|
||||||
|
$self->{size} = length($self->{content});
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub contents {
|
||||||
|
my $self = shift;
|
||||||
|
if (@_) {
|
||||||
|
$self->{content} = shift;
|
||||||
|
$self->{size} = length($self->{content});
|
||||||
|
}
|
||||||
|
return $self->{content};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub binmode { 1 }
|
||||||
|
|
||||||
|
sub close { 1 }
|
||||||
|
|
||||||
|
sub opened { 1 }
|
||||||
|
|
||||||
|
sub eof {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->{position} >= $self->{size};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub seek {
|
||||||
|
my $self = shift;
|
||||||
|
my $pos = shift;
|
||||||
|
my $whence = shift;
|
||||||
|
|
||||||
|
# SEEK_SET
|
||||||
|
if ($whence == 0) { $self->{position} = $pos; }
|
||||||
|
|
||||||
|
# SEEK_CUR
|
||||||
|
elsif ($whence == 1) { $self->{position} += $pos; }
|
||||||
|
|
||||||
|
# SEEK_END
|
||||||
|
elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; }
|
||||||
|
else { return 0; }
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub tell { return shift->{position}; }
|
||||||
|
|
||||||
|
# Copy my data to given buffer
|
||||||
|
sub read {
|
||||||
|
my $self = shift;
|
||||||
|
my $buf = \($_[0]);
|
||||||
|
shift;
|
||||||
|
my $len = shift;
|
||||||
|
my $offset = shift || 0;
|
||||||
|
|
||||||
|
$$buf = '' if not defined($$buf);
|
||||||
|
my $bytesRead =
|
||||||
|
($self->{position} + $len > $self->{size})
|
||||||
|
? ($self->{size} - $self->{position})
|
||||||
|
: $len;
|
||||||
|
substr($$buf, $offset, $bytesRead) =
|
||||||
|
substr($self->{content}, $self->{position}, $bytesRead);
|
||||||
|
$self->{position} += $bytesRead;
|
||||||
|
return $bytesRead;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Copy given buffer to me
|
||||||
|
sub write {
|
||||||
|
my $self = shift;
|
||||||
|
my $buf = \($_[0]);
|
||||||
|
shift;
|
||||||
|
my $len = shift;
|
||||||
|
my $offset = shift || 0;
|
||||||
|
|
||||||
|
$$buf = '' if not defined($$buf);
|
||||||
|
my $bufLen = length($$buf);
|
||||||
|
my $bytesWritten =
|
||||||
|
($offset + $len > $bufLen)
|
||||||
|
? $bufLen - $offset
|
||||||
|
: $len;
|
||||||
|
substr($self->{content}, $self->{position}, $bytesWritten) =
|
||||||
|
substr($$buf, $offset, $bytesWritten);
|
||||||
|
$self->{size} = length($self->{content});
|
||||||
|
return $bytesWritten;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub clearerr() { 1 }
|
||||||
|
|
||||||
|
1;
|
@ -0,0 +1,80 @@
|
|||||||
|
package Archive::Zip::DirectoryMember;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use File::Path;
|
||||||
|
|
||||||
|
use vars qw( $VERSION @ISA );
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
@ISA = qw( Archive::Zip::Member );
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip qw(
|
||||||
|
:ERROR_CODES
|
||||||
|
:UTILITY_METHODS
|
||||||
|
);
|
||||||
|
|
||||||
|
sub _newNamed {
|
||||||
|
my $class = shift;
|
||||||
|
my $fileName = shift; # FS name
|
||||||
|
my $newName = shift; # Zip name
|
||||||
|
$newName = _asZipDirName($fileName) unless $newName;
|
||||||
|
my $self = $class->new(@_);
|
||||||
|
$self->{'externalFileName'} = $fileName;
|
||||||
|
$self->fileName($newName);
|
||||||
|
|
||||||
|
if (-e $fileName) {
|
||||||
|
|
||||||
|
# -e does NOT do a full stat, so we need to do one now
|
||||||
|
if (-d _ ) {
|
||||||
|
my @stat = stat(_);
|
||||||
|
$self->unixFileAttributes($stat[2]);
|
||||||
|
my $mod_t = $stat[9];
|
||||||
|
if ($^O eq 'MSWin32' and !$mod_t) {
|
||||||
|
$mod_t = time();
|
||||||
|
}
|
||||||
|
$self->setLastModFileDateTimeFromUnix($mod_t);
|
||||||
|
|
||||||
|
} else { # hmm.. trying to add a non-directory?
|
||||||
|
_error($fileName, ' exists but is not a directory');
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS);
|
||||||
|
$self->setLastModFileDateTimeFromUnix(time());
|
||||||
|
}
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub externalFileName {
|
||||||
|
shift->{'externalFileName'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub isDirectory {
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub extractToFileNamed {
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift; # local FS name
|
||||||
|
my $attribs = $self->unixFileAttributes() & 07777;
|
||||||
|
mkpath($name, 0, $attribs); # croaks on error
|
||||||
|
utime($self->lastModTime(), $self->lastModTime(), $name);
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub fileName {
|
||||||
|
my $self = shift;
|
||||||
|
my $newName = shift;
|
||||||
|
$newName =~ s{/?$}{/} if defined($newName);
|
||||||
|
return $self->SUPER::fileName($newName);
|
||||||
|
}
|
||||||
|
|
||||||
|
# So people don't get too confused. This way it looks like the problem
|
||||||
|
# is in their code...
|
||||||
|
sub contents {
|
||||||
|
return wantarray ? (undef, AZ_OK) : undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
@ -0,0 +1,344 @@
|
|||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Archive::Zip::FAQ - Answers to a few frequently asked questions about Archive::Zip
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
It seems that I keep answering the same questions over and over again. I
|
||||||
|
assume that this is because my documentation is deficient, rather than that
|
||||||
|
people don't read the documentation.
|
||||||
|
|
||||||
|
So this FAQ is an attempt to cut down on the number of personal answers I have
|
||||||
|
to give. At least I can now say "You I<did> read the FAQ, right?".
|
||||||
|
|
||||||
|
The questions are not in any particular order. The answers assume the current
|
||||||
|
version of Archive::Zip; some of the answers depend on newly added/fixed
|
||||||
|
functionality.
|
||||||
|
|
||||||
|
=head1 Install problems on RedHat 8 or 9 with Perl 5.8.0
|
||||||
|
|
||||||
|
B<Q:> Archive::Zip won't install on my RedHat 9 system! It's broke!
|
||||||
|
|
||||||
|
B<A:> This has become something of a FAQ.
|
||||||
|
Basically, RedHat broke some versions of Perl by setting LANG to UTF8.
|
||||||
|
They apparently have a fixed version out as an update.
|
||||||
|
|
||||||
|
You might try running CPAN or creating your Makefile after exporting the LANG
|
||||||
|
environment variable as
|
||||||
|
|
||||||
|
C<LANG=C>
|
||||||
|
|
||||||
|
L<https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682>
|
||||||
|
|
||||||
|
=head1 Why is my zip file so big?
|
||||||
|
|
||||||
|
B<Q:> My zip file is actually bigger than what I stored in it! Why?
|
||||||
|
|
||||||
|
B<A:> Some things to make sure of:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item Make sure that you are requesting COMPRESSION_DEFLATED if you are storing strings.
|
||||||
|
|
||||||
|
$member->desiredCompressionMethod( COMPRESSION_DEFLATED );
|
||||||
|
|
||||||
|
=item Don't make lots of little files if you can help it.
|
||||||
|
|
||||||
|
Since zip computes the compression tables for each member, small
|
||||||
|
members without much entropy won't compress well. Instead, if you've
|
||||||
|
got lots of repeated strings in your data, try to combine them into
|
||||||
|
one big member.
|
||||||
|
|
||||||
|
=item Make sure that you are requesting COMPRESSION_STORED if you are storing things that are already compressed.
|
||||||
|
|
||||||
|
If you're storing a .zip, .jpg, .mp3, or other compressed file in a zip,
|
||||||
|
then don't compress them again. They'll get bigger.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 Sample code?
|
||||||
|
|
||||||
|
B<Q:> Can you send me code to do (whatever)?
|
||||||
|
|
||||||
|
B<A:> Have you looked in the C<examples/> directory yet? It contains:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item examples/calcSizes.pl -- How to find out how big a Zip file will be before writing it
|
||||||
|
|
||||||
|
=item examples/copy.pl -- Copies one Zip file to another
|
||||||
|
|
||||||
|
=item examples/extract.pl -- extract file(s) from a Zip
|
||||||
|
|
||||||
|
=item examples/mailZip.pl -- make and mail a zip file
|
||||||
|
|
||||||
|
=item examples/mfh.pl -- demo for use of MockFileHandle
|
||||||
|
|
||||||
|
=item examples/readScalar.pl -- shows how to use IO::Scalar as the source of a Zip read
|
||||||
|
|
||||||
|
=item examples/selfex.pl -- a brief example of a self-extracting Zip
|
||||||
|
|
||||||
|
=item examples/unzipAll.pl -- uses Archive::Zip::Tree to unzip an entire Zip
|
||||||
|
|
||||||
|
=item examples/updateZip.pl -- shows how to read/modify/write a Zip
|
||||||
|
|
||||||
|
=item examples/updateTree.pl -- shows how to update a Zip in place
|
||||||
|
|
||||||
|
=item examples/writeScalar.pl -- shows how to use IO::Scalar as the destination of a Zip write
|
||||||
|
|
||||||
|
=item examples/writeScalar2.pl -- shows how to use IO::String as the destination of a Zip write
|
||||||
|
|
||||||
|
=item examples/zip.pl -- Constructs a Zip file
|
||||||
|
|
||||||
|
=item examples/zipcheck.pl -- One way to check a Zip file for validity
|
||||||
|
|
||||||
|
=item examples/zipinfo.pl -- Prints out information about a Zip archive file
|
||||||
|
|
||||||
|
=item examples/zipGrep.pl -- Searches for text in Zip files
|
||||||
|
|
||||||
|
=item examples/ziptest.pl -- Lists a Zip file and checks member CRCs
|
||||||
|
|
||||||
|
=item examples/ziprecent.pl -- Puts recent files into a zipfile
|
||||||
|
|
||||||
|
=item examples/ziptest.pl -- Another way to check a Zip file for validity
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 Can't Read/modify/write same Zip file
|
||||||
|
|
||||||
|
B<Q:> Why can't I open a Zip file, add a member, and write it back? I get an
|
||||||
|
error message when I try.
|
||||||
|
|
||||||
|
B<A:> Because Archive::Zip doesn't (and can't, generally) read file contents into memory,
|
||||||
|
the original Zip file is required to stay around until the writing of the new
|
||||||
|
file is completed.
|
||||||
|
|
||||||
|
The best way to do this is to write the Zip to a temporary file and then
|
||||||
|
rename the temporary file to have the old name (possibly after deleting the
|
||||||
|
old one).
|
||||||
|
|
||||||
|
Archive::Zip v1.02 added the archive methods C<overwrite()> and
|
||||||
|
C<overwriteAs()> to do this simply and carefully.
|
||||||
|
|
||||||
|
See C<examples/updateZip.pl> for an example of this technique.
|
||||||
|
|
||||||
|
=head1 File creation time not set
|
||||||
|
|
||||||
|
B<Q:> Upon extracting files, I see that their modification (and access) times are
|
||||||
|
set to the time in the Zip archive. However, their creation time is not set to
|
||||||
|
the same time. Why?
|
||||||
|
|
||||||
|
B<A:> Mostly because Perl doesn't give cross-platform access to I<creation time>.
|
||||||
|
Indeed, many systems (like Unix) don't support such a concept.
|
||||||
|
However, if yours does, you can easily set it. Get the modification time from
|
||||||
|
the member using C<lastModTime()>.
|
||||||
|
|
||||||
|
=head1 Can't use Archive::Zip on gzip files
|
||||||
|
|
||||||
|
B<Q:> Can I use Archive::Zip to extract Unix gzip files?
|
||||||
|
|
||||||
|
B<A:> No.
|
||||||
|
|
||||||
|
There is a distinction between Unix gzip files, and Zip archives that
|
||||||
|
also can use the gzip compression.
|
||||||
|
|
||||||
|
Depending on the format of the gzip file, you can use L<Compress::Raw::Zlib>, or
|
||||||
|
L<Archive::Tar> to decompress it (and de-archive it in the case of Tar files).
|
||||||
|
|
||||||
|
You can unzip PKZIP/WinZip/etc/ archives using Archive::Zip (that's what
|
||||||
|
it's for) as long as any compressed members are compressed using
|
||||||
|
Deflate compression.
|
||||||
|
|
||||||
|
=head1 Add a directory/tree to a Zip
|
||||||
|
|
||||||
|
B<Q:> How can I add a directory (or tree) full of files to a Zip?
|
||||||
|
|
||||||
|
B<A:> You can use the Archive::Zip::addTree*() methods:
|
||||||
|
|
||||||
|
use Archive::Zip;
|
||||||
|
my $zip = Archive::Zip->new();
|
||||||
|
# add all readable files and directories below . as xyz/*
|
||||||
|
$zip->addTree( '.', 'xyz' );
|
||||||
|
# add all readable plain files below /abc as def/*
|
||||||
|
$zip->addTree( '/abc', 'def', sub { -f && -r } );
|
||||||
|
# add all .c files below /tmp as stuff/*
|
||||||
|
$zip->addTreeMatching( '/tmp', 'stuff', '\.c$' );
|
||||||
|
# add all .o files below /tmp as stuff/* if they aren't writable
|
||||||
|
$zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } );
|
||||||
|
# add all .so files below /tmp that are smaller than 200 bytes as stuff/*
|
||||||
|
$zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } );
|
||||||
|
# and write them into a file
|
||||||
|
$zip->writeToFileNamed('xxx.zip');
|
||||||
|
|
||||||
|
=head1 Extract a directory/tree
|
||||||
|
|
||||||
|
B<Q:> How can I extract some (or all) files from a Zip into a different
|
||||||
|
directory?
|
||||||
|
|
||||||
|
B<A:> You can use the Archive::Zip::extractTree() method:
|
||||||
|
??? ||
|
||||||
|
|
||||||
|
# now extract the same files into /tmpx
|
||||||
|
$zip->extractTree( 'stuff', '/tmpx' );
|
||||||
|
|
||||||
|
=head1 Update a directory/tree
|
||||||
|
|
||||||
|
B<Q:> How can I update a Zip from a directory tree, adding or replacing only
|
||||||
|
the newer files?
|
||||||
|
|
||||||
|
B<A:> You can use the Archive::Zip::updateTree() method that was added in version 1.09.
|
||||||
|
|
||||||
|
=head1 Zip times might be off by 1 second
|
||||||
|
|
||||||
|
B<Q:> It bothers me greatly that my file times are wrong by one second about half
|
||||||
|
the time. Why don't you do something about it?
|
||||||
|
|
||||||
|
B<A:> Get over it. This is a result of the Zip format storing times in DOS
|
||||||
|
format, which has a resolution of only two seconds.
|
||||||
|
|
||||||
|
=head1 Zip times don't include time zone information
|
||||||
|
|
||||||
|
B<Q:> My file times don't respect time zones. What gives?
|
||||||
|
|
||||||
|
B<A:> If this is important to you, please submit patches to read the various
|
||||||
|
Extra Fields that encode times with time zones. I'm just using the DOS
|
||||||
|
Date/Time, which doesn't have a time zone.
|
||||||
|
|
||||||
|
=head1 How do I make a self-extracting Zip
|
||||||
|
|
||||||
|
B<Q:> I want to make a self-extracting Zip file. Can I do this?
|
||||||
|
|
||||||
|
B<A:> Yes. You can write a self-extracting archive stub (that is, a version of
|
||||||
|
unzip) to the output filehandle that you pass to writeToFileHandle(). See
|
||||||
|
examples/selfex.pl for how to write a self-extracting archive.
|
||||||
|
|
||||||
|
However, you should understand that this will only work on one kind of
|
||||||
|
platform (the one for which the stub was compiled).
|
||||||
|
|
||||||
|
=head1 How can I deal with Zips with prepended garbage (i.e. from Sircam)
|
||||||
|
|
||||||
|
B<Q:> How can I tell if a Zip has been damaged by adding garbage to the
|
||||||
|
beginning or inside the file?
|
||||||
|
|
||||||
|
B<A:> I added code for this for the Amavis virus scanner. You can query archives
|
||||||
|
for their 'eocdOffset' property, which should be 0:
|
||||||
|
|
||||||
|
if ($zip->eocdOffset > 0)
|
||||||
|
{ warn($zip->eocdOffset . " bytes of garbage at beginning or within Zip") }
|
||||||
|
|
||||||
|
When members are extracted, this offset will be used to adjust the start of
|
||||||
|
the member if necessary.
|
||||||
|
|
||||||
|
=head1 Can't extract Shrunk files
|
||||||
|
|
||||||
|
B<Q:> I'm trying to extract a file out of a Zip produced by PKZIP, and keep
|
||||||
|
getting this error message:
|
||||||
|
|
||||||
|
error: Unsupported compression combination: read 6, write 0
|
||||||
|
|
||||||
|
B<A:> You can't uncompress this archive member. Archive::Zip only supports uncompressed
|
||||||
|
members, and compressed members that are compressed using the compression
|
||||||
|
supported by Compress::Raw::Zlib. That means only Deflated and Stored members.
|
||||||
|
|
||||||
|
Your file is compressed using the Shrink format, which is not supported by
|
||||||
|
Compress::Raw::Zlib.
|
||||||
|
|
||||||
|
You could, perhaps, use a command-line UnZip program (like the Info-Zip
|
||||||
|
one) to extract this.
|
||||||
|
|
||||||
|
=head1 Can't do decryption
|
||||||
|
|
||||||
|
B<Q:> How do I decrypt encrypted Zip members?
|
||||||
|
|
||||||
|
B<A:> With some other program or library. Archive::Zip doesn't support decryption,
|
||||||
|
and probably never will (unless I<you> write it).
|
||||||
|
|
||||||
|
=head1 How to test file integrity?
|
||||||
|
|
||||||
|
B<Q:> How can Archive::Zip can test the validity of a Zip file?
|
||||||
|
|
||||||
|
B<A:> If you try to decompress the file, the gzip streams will report errors
|
||||||
|
if you have garbage. Most of the time.
|
||||||
|
|
||||||
|
If you try to open the file and a central directory structure can't be
|
||||||
|
found, an error will be reported.
|
||||||
|
|
||||||
|
When a file is being read, if we can't find a proper PK.. signature in
|
||||||
|
the right places we report a format error.
|
||||||
|
|
||||||
|
If there is added garbage at the beginning of a Zip file (as inserted
|
||||||
|
by some viruses), you can find out about it, but Archive::Zip will ignore it,
|
||||||
|
and you can still use the archive. When it gets written back out the
|
||||||
|
added stuff will be gone.
|
||||||
|
|
||||||
|
There are two ready-to-use utilities in the examples directory that can
|
||||||
|
be used to test file integrity, or that you can use as examples
|
||||||
|
for your own code:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item examples/zipcheck.pl shows how to use an attempted extraction to test a file.
|
||||||
|
|
||||||
|
=item examples/ziptest.pl shows how to test CRCs in a file.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 Duplicate files in Zip?
|
||||||
|
|
||||||
|
B<Q:> Archive::Zip let me put the same file in my Zip twice! Why don't you prevent this?
|
||||||
|
|
||||||
|
B<A:> As far as I can tell, this is not disallowed by the Zip spec. If you
|
||||||
|
think it's a bad idea, check for it yourself:
|
||||||
|
|
||||||
|
$zip->addFile($someFile, $someName) unless $zip->memberNamed($someName);
|
||||||
|
|
||||||
|
I can even imagine cases where this might be useful (for instance, multiple
|
||||||
|
versions of files).
|
||||||
|
|
||||||
|
=head1 File ownership/permissions/ACLS/etc
|
||||||
|
|
||||||
|
B<Q:> Why doesn't Archive::Zip deal with file ownership, ACLs, etc.?
|
||||||
|
|
||||||
|
B<A:> There is no standard way to represent these in the Zip file format. If
|
||||||
|
you want to send me code to properly handle the various extra fields that
|
||||||
|
have been used to represent these through the years, I'll look at it.
|
||||||
|
|
||||||
|
=head1 I can't compile but ActiveState only has an old version of Archive::Zip
|
||||||
|
|
||||||
|
B<Q:> I've only installed modules using ActiveState's PPM program and
|
||||||
|
repository. But they have a much older version of Archive::Zip than is in CPAN. Will
|
||||||
|
you send me a newer PPM?
|
||||||
|
|
||||||
|
B<A:> Probably not, unless I get lots of extra time. But there's no reason you
|
||||||
|
can't install the version from CPAN. Archive::Zip is pure Perl, so all you need is
|
||||||
|
NMAKE, which you can get for free from Microsoft (see the FAQ in the
|
||||||
|
ActiveState documentation for details on how to install CPAN modules).
|
||||||
|
|
||||||
|
=head1 My JPEGs (or MP3's) don't compress when I put them into Zips!
|
||||||
|
|
||||||
|
B<Q:> How come my JPEGs and MP3's don't compress much when I put them into Zips?
|
||||||
|
|
||||||
|
B<A:> Because they're already compressed.
|
||||||
|
|
||||||
|
=head1 Under Windows, things lock up/get damaged
|
||||||
|
|
||||||
|
B<Q:> I'm using Windows. When I try to use Archive::Zip, my machine locks up/makes
|
||||||
|
funny sounds/displays a BSOD/corrupts data. How can I fix this?
|
||||||
|
|
||||||
|
B<A:> First, try the newest version of Compress::Raw::Zlib. I know of
|
||||||
|
Windows-related problems prior to v1.14 of that library.
|
||||||
|
|
||||||
|
=head1 Zip contents in a scalar
|
||||||
|
|
||||||
|
B<Q:> I want to read a Zip file from (or write one to) a scalar variable instead
|
||||||
|
of a file. How can I do this?
|
||||||
|
|
||||||
|
B<A:> Use C<IO::String> and the C<readFromFileHandle()> and
|
||||||
|
C<writeToFileHandle()> methods.
|
||||||
|
See C<examples/readScalar.pl> and C<examples/writeScalar.pl>.
|
||||||
|
|
||||||
|
=head1 Reading from streams
|
||||||
|
|
||||||
|
B<Q:> How do I read from a stream (like for the Info-Zip C<funzip> program)?
|
||||||
|
|
||||||
|
B<A:> This is not currently supported, though writing to a stream is.
|
@ -0,0 +1,64 @@
|
|||||||
|
package Archive::Zip::FileMember;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw( $VERSION @ISA );
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
@ISA = qw ( Archive::Zip::Member );
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip qw(
|
||||||
|
:UTILITY_METHODS
|
||||||
|
);
|
||||||
|
|
||||||
|
sub externalFileName {
|
||||||
|
shift->{'externalFileName'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return true if I depend on the named file
|
||||||
|
sub _usesFileNamed {
|
||||||
|
my $self = shift;
|
||||||
|
my $fileName = shift;
|
||||||
|
my $xfn = $self->externalFileName();
|
||||||
|
return undef if ref($xfn);
|
||||||
|
return $xfn eq $fileName;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub fh {
|
||||||
|
my $self = shift;
|
||||||
|
$self->_openFile()
|
||||||
|
if !defined($self->{'fh'}) || !$self->{'fh'}->opened();
|
||||||
|
return $self->{'fh'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# opens my file handle from my file name
|
||||||
|
sub _openFile {
|
||||||
|
my $self = shift;
|
||||||
|
my ($status, $fh) = _newFileHandle($self->externalFileName(), 'r');
|
||||||
|
if (!$status) {
|
||||||
|
_ioError("Can't open", $self->externalFileName());
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
$self->{'fh'} = $fh;
|
||||||
|
_binmode($fh);
|
||||||
|
return $fh;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Make sure I close my file handle
|
||||||
|
sub endRead {
|
||||||
|
my $self = shift;
|
||||||
|
undef $self->{'fh'}; # _closeFile();
|
||||||
|
return $self->SUPER::endRead(@_);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _become {
|
||||||
|
my $self = shift;
|
||||||
|
my $newClass = shift;
|
||||||
|
return $self if ref($self) eq $newClass;
|
||||||
|
delete($self->{'externalFileName'});
|
||||||
|
delete($self->{'fh'});
|
||||||
|
return $self->SUPER::_become($newClass);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
1247
dev-tools/src/main/resources/license-check/lib/Archive/Zip/Member.pm
Normal file
1247
dev-tools/src/main/resources/license-check/lib/Archive/Zip/Member.pm
Normal file
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,348 @@
|
|||||||
|
package Archive::Zip::MemberRead;
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use Archive::Zip;
|
||||||
|
use Archive::Zip::MemberRead;
|
||||||
|
$zip = Archive::Zip->new("file.zip");
|
||||||
|
$fh = Archive::Zip::MemberRead->new($zip, "subdir/abc.txt");
|
||||||
|
while (defined($line = $fh->getline()))
|
||||||
|
{
|
||||||
|
print $fh->input_line_number . "#: $line\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
$read = $fh->read($buffer, 32*1024);
|
||||||
|
print "Read $read bytes as :$buffer:\n";
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
The Archive::Zip::MemberRead module lets you read Zip archive member data
|
||||||
|
just like you read data from files.
|
||||||
|
|
||||||
|
=head1 METHODS
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
|
||||||
|
|
||||||
|
use vars qw{$VERSION};
|
||||||
|
|
||||||
|
my $nl;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
$VERSION = eval $VERSION;
|
||||||
|
|
||||||
|
# Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy.
|
||||||
|
$nl = $^O eq 'MSWin32' ? "\r\n" : "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
=item Archive::Zip::Member::readFileHandle()
|
||||||
|
|
||||||
|
You can get a C<Archive::Zip::MemberRead> from an archive member by
|
||||||
|
calling C<readFileHandle()>:
|
||||||
|
|
||||||
|
my $member = $zip->memberNamed('abc/def.c');
|
||||||
|
my $fh = $member->readFileHandle();
|
||||||
|
while (defined($line = $fh->getline()))
|
||||||
|
{
|
||||||
|
# ...
|
||||||
|
}
|
||||||
|
$fh->close();
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub Archive::Zip::Member::readFileHandle {
|
||||||
|
return Archive::Zip::MemberRead->new(shift());
|
||||||
|
}
|
||||||
|
|
||||||
|
=item Archive::Zip::MemberRead->new($zip, $fileName)
|
||||||
|
|
||||||
|
=item Archive::Zip::MemberRead->new($zip, $member)
|
||||||
|
|
||||||
|
=item Archive::Zip::MemberRead->new($member)
|
||||||
|
|
||||||
|
Construct a new Archive::Zip::MemberRead on the specified member.
|
||||||
|
|
||||||
|
my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c')
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my ($class, $zip, $file) = @_;
|
||||||
|
my ($self, $member);
|
||||||
|
|
||||||
|
if ($zip && $file) # zip and filename, or zip and member
|
||||||
|
{
|
||||||
|
$member = ref($file) ? $file : $zip->memberNamed($file);
|
||||||
|
} elsif ($zip && !$file && ref($zip)) # just member
|
||||||
|
{
|
||||||
|
$member = $zip;
|
||||||
|
} else {
|
||||||
|
die(
|
||||||
|
'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
$self = {};
|
||||||
|
bless($self, $class);
|
||||||
|
$self->set_member($member);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub set_member {
|
||||||
|
my ($self, $member) = @_;
|
||||||
|
|
||||||
|
$self->{member} = $member;
|
||||||
|
$self->set_compression(COMPRESSION_STORED);
|
||||||
|
$self->rewind();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub set_compression {
|
||||||
|
my ($self, $compression) = @_;
|
||||||
|
$self->{member}->desiredCompressionMethod($compression) if $self->{member};
|
||||||
|
}
|
||||||
|
|
||||||
|
=item setLineEnd(expr)
|
||||||
|
|
||||||
|
Set the line end character to use. This is set to \n by default
|
||||||
|
except on Windows systems where it is set to \r\n. You will
|
||||||
|
only need to set this on systems which are not Windows or Unix
|
||||||
|
based and require a line end different from \n.
|
||||||
|
This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)>
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub setLineEnd {
|
||||||
|
shift;
|
||||||
|
$nl = shift;
|
||||||
|
}
|
||||||
|
|
||||||
|
=item rewind()
|
||||||
|
|
||||||
|
Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again
|
||||||
|
starting at the beginning.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub rewind {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
$self->_reset_vars();
|
||||||
|
$self->{member}->rewindData() if $self->{member};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _reset_vars {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
$self->{line_no} = 0;
|
||||||
|
$self->{at_end} = 0;
|
||||||
|
|
||||||
|
delete $self->{buffer};
|
||||||
|
}
|
||||||
|
|
||||||
|
=item input_record_separator(expr)
|
||||||
|
|
||||||
|
If the argument is given, input_record_separator for this
|
||||||
|
instance is set to it. The current setting (which may be
|
||||||
|
the global $/) is always returned.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub input_record_separator {
|
||||||
|
my $self = shift;
|
||||||
|
if (@_) {
|
||||||
|
$self->{sep} = shift;
|
||||||
|
$self->{sep_re} =
|
||||||
|
_sep_as_re($self->{sep}); # Cache the RE as an optimization
|
||||||
|
}
|
||||||
|
return exists $self->{sep} ? $self->{sep} : $/;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return the input_record_separator in use as an RE fragment
|
||||||
|
# Note that if we have a per-instance input_record_separator
|
||||||
|
# we can just return the already converted value. Otherwise,
|
||||||
|
# the conversion must be done on $/ every time since we cannot
|
||||||
|
# know whether it has changed or not.
|
||||||
|
sub _sep_re {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
# Important to phrase this way: sep's value may be undef.
|
||||||
|
return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Convert the input record separator into an RE and return it.
|
||||||
|
sub _sep_as_re {
|
||||||
|
my $sep = shift;
|
||||||
|
if (defined $sep) {
|
||||||
|
if ($sep eq '') {
|
||||||
|
return "(?:$nl){2,}";
|
||||||
|
} else {
|
||||||
|
$sep =~ s/\n/$nl/og;
|
||||||
|
return quotemeta $sep;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
=item input_line_number()
|
||||||
|
|
||||||
|
Returns the current line number, but only if you're using C<getline()>.
|
||||||
|
Using C<read()> will not update the line number.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub input_line_number {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->{line_no};
|
||||||
|
}
|
||||||
|
|
||||||
|
=item close()
|
||||||
|
|
||||||
|
Closes the given file handle.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub close {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
$self->_reset_vars();
|
||||||
|
$self->{member}->endRead();
|
||||||
|
}
|
||||||
|
|
||||||
|
=item buffer_size([ $size ])
|
||||||
|
|
||||||
|
Gets or sets the buffer size used for reads.
|
||||||
|
Default is the chunk size used by Archive::Zip.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub buffer_size {
|
||||||
|
my ($self, $size) = @_;
|
||||||
|
|
||||||
|
if (!$size) {
|
||||||
|
return $self->{chunkSize} || Archive::Zip::chunkSize();
|
||||||
|
} else {
|
||||||
|
$self->{chunkSize} = $size;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
=item getline()
|
||||||
|
|
||||||
|
Returns the next line from the currently open member.
|
||||||
|
Makes sense only for text files.
|
||||||
|
A read error is considered fatal enough to die.
|
||||||
|
Returns undef on eof. All subsequent calls would return undef,
|
||||||
|
unless a rewind() is called.
|
||||||
|
Note: The line returned has the input_record_separator (default: newline) removed.
|
||||||
|
|
||||||
|
=item getline( { preserve_line_ending => 1 } )
|
||||||
|
|
||||||
|
Returns the next line including the line ending.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getline {
|
||||||
|
my ($self, $argref) = @_;
|
||||||
|
|
||||||
|
my $size = $self->buffer_size();
|
||||||
|
my $sep = $self->_sep_re();
|
||||||
|
|
||||||
|
my $preserve_line_ending;
|
||||||
|
if (ref $argref eq 'HASH') {
|
||||||
|
$preserve_line_ending = $argref->{'preserve_line_ending'};
|
||||||
|
$sep =~ s/\\([^A-Za-z_0-9])+/$1/g;
|
||||||
|
}
|
||||||
|
|
||||||
|
for (; ;) {
|
||||||
|
if ( $sep
|
||||||
|
&& defined($self->{buffer})
|
||||||
|
&& $self->{buffer} =~ s/^(.*?)$sep//s) {
|
||||||
|
my $line = $1;
|
||||||
|
$self->{line_no}++;
|
||||||
|
if ($preserve_line_ending) {
|
||||||
|
return $line . $sep;
|
||||||
|
} else {
|
||||||
|
return $line;
|
||||||
|
}
|
||||||
|
} elsif ($self->{at_end}) {
|
||||||
|
$self->{line_no}++ if $self->{buffer};
|
||||||
|
return delete $self->{buffer};
|
||||||
|
}
|
||||||
|
my ($temp, $status) = $self->{member}->readChunk($size);
|
||||||
|
if ($status != AZ_OK && $status != AZ_STREAM_END) {
|
||||||
|
die "ERROR: Error reading chunk from archive - $status";
|
||||||
|
}
|
||||||
|
$self->{at_end} = $status == AZ_STREAM_END;
|
||||||
|
$self->{buffer} .= $$temp;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
=item read($buffer, $num_bytes_to_read)
|
||||||
|
|
||||||
|
Simulates a normal C<read()> system call.
|
||||||
|
Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>:
|
||||||
|
|
||||||
|
$fh = Archive::Zip::MemberRead->new($zip, "sreeji/secrets.bin");
|
||||||
|
while (1)
|
||||||
|
{
|
||||||
|
$read = $fh->read($buffer, 1024);
|
||||||
|
die "FATAL ERROR reading my secrets !\n" if (!defined($read));
|
||||||
|
last if (!$read);
|
||||||
|
# Do processing.
|
||||||
|
....
|
||||||
|
}
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
#
|
||||||
|
# All these $_ are required to emulate read().
|
||||||
|
#
|
||||||
|
sub read {
|
||||||
|
my $self = $_[0];
|
||||||
|
my $size = $_[2];
|
||||||
|
my ($temp, $status, $ret);
|
||||||
|
|
||||||
|
($temp, $status) = $self->{member}->readChunk($size);
|
||||||
|
if ($status != AZ_OK && $status != AZ_STREAM_END) {
|
||||||
|
$_[1] = undef;
|
||||||
|
$ret = undef;
|
||||||
|
} else {
|
||||||
|
$_[1] = $$temp;
|
||||||
|
$ret = length($$temp);
|
||||||
|
}
|
||||||
|
return $ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Sreeji K. Das E<lt>sreeji_k@yahoo.comE<gt>
|
||||||
|
|
||||||
|
See L<Archive::Zip> by Ned Konz without which this module does not make
|
||||||
|
any sense!
|
||||||
|
|
||||||
|
Minor mods by Ned Konz.
|
||||||
|
|
||||||
|
=head1 COPYRIGHT
|
||||||
|
|
||||||
|
Copyright 2002 Sreeji K. Das.
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as Perl itself.
|
||||||
|
|
||||||
|
=cut
|
@ -0,0 +1,69 @@
|
|||||||
|
package Archive::Zip::MockFileHandle;
|
||||||
|
|
||||||
|
# Output file handle that calls a custom write routine
|
||||||
|
# Ned Konz, March 2000
|
||||||
|
# This is provided to help with writing zip files
|
||||||
|
# when you have to process them a chunk at a time.
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use vars qw{$VERSION};
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
$VERSION = eval $VERSION;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift || __PACKAGE__;
|
||||||
|
$class = ref($class) || $class;
|
||||||
|
my $self = bless(
|
||||||
|
{
|
||||||
|
'position' => 0,
|
||||||
|
'size' => 0
|
||||||
|
},
|
||||||
|
$class
|
||||||
|
);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub eof {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->{'position'} >= $self->{'size'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Copy given buffer to me
|
||||||
|
sub print {
|
||||||
|
my $self = shift;
|
||||||
|
my $bytes = join('', @_);
|
||||||
|
my $bytesWritten = $self->writeHook($bytes);
|
||||||
|
if ($self->{'position'} + $bytesWritten > $self->{'size'}) {
|
||||||
|
$self->{'size'} = $self->{'position'} + $bytesWritten;
|
||||||
|
}
|
||||||
|
$self->{'position'} += $bytesWritten;
|
||||||
|
return $bytesWritten;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Called on each write.
|
||||||
|
# Override in subclasses.
|
||||||
|
# Return number of bytes written (0 on error).
|
||||||
|
sub writeHook {
|
||||||
|
my $self = shift;
|
||||||
|
my $bytes = shift;
|
||||||
|
return length($bytes);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub binmode { 1 }
|
||||||
|
|
||||||
|
sub close { 1 }
|
||||||
|
|
||||||
|
sub clearerr { 1 }
|
||||||
|
|
||||||
|
# I'm write-only!
|
||||||
|
sub read { 0 }
|
||||||
|
|
||||||
|
sub tell { return shift->{'position'} }
|
||||||
|
|
||||||
|
sub opened { 1 }
|
||||||
|
|
||||||
|
1;
|
@ -0,0 +1,77 @@
|
|||||||
|
package Archive::Zip::NewFileMember;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw( $VERSION @ISA );
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
@ISA = qw ( Archive::Zip::FileMember );
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip qw(
|
||||||
|
:CONSTANTS
|
||||||
|
:ERROR_CODES
|
||||||
|
:UTILITY_METHODS
|
||||||
|
);
|
||||||
|
|
||||||
|
# Given a file name, set up for eventual writing.
|
||||||
|
sub _newFromFileNamed {
|
||||||
|
my $class = shift;
|
||||||
|
my $fileName = shift; # local FS format
|
||||||
|
my $newName = shift;
|
||||||
|
$newName = _asZipDirName($fileName) unless defined($newName);
|
||||||
|
return undef unless (stat($fileName) && -r _ && !-d _ );
|
||||||
|
my $self = $class->new(@_);
|
||||||
|
$self->{'fileName'} = $newName;
|
||||||
|
$self->{'externalFileName'} = $fileName;
|
||||||
|
$self->{'compressionMethod'} = COMPRESSION_STORED;
|
||||||
|
my @stat = stat(_);
|
||||||
|
$self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
|
||||||
|
$self->desiredCompressionMethod(
|
||||||
|
($self->compressedSize() > 0)
|
||||||
|
? COMPRESSION_DEFLATED
|
||||||
|
: COMPRESSION_STORED
|
||||||
|
);
|
||||||
|
$self->unixFileAttributes($stat[2]);
|
||||||
|
$self->setLastModFileDateTimeFromUnix($stat[9]);
|
||||||
|
$self->isTextFile(-T _ );
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub rewindData {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my $status = $self->SUPER::rewindData(@_);
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
|
||||||
|
return AZ_IO_ERROR unless $self->fh();
|
||||||
|
$self->fh()->clearerr();
|
||||||
|
$self->fh()->seek(0, IO::Seekable::SEEK_SET)
|
||||||
|
or return _ioError("rewinding", $self->externalFileName());
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return bytes read. Note that first parameter is a ref to a buffer.
|
||||||
|
# my $data;
|
||||||
|
# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
|
||||||
|
sub _readRawChunk {
|
||||||
|
my ($self, $dataRef, $chunkSize) = @_;
|
||||||
|
return (0, AZ_OK) unless $chunkSize;
|
||||||
|
my $bytesRead = $self->fh()->read($$dataRef, $chunkSize)
|
||||||
|
or return (0, _ioError("reading data"));
|
||||||
|
return ($bytesRead, AZ_OK);
|
||||||
|
}
|
||||||
|
|
||||||
|
# If I already exist, extraction is a no-op.
|
||||||
|
sub extractToFileNamed {
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift; # local FS name
|
||||||
|
if (File::Spec->rel2abs($name) eq
|
||||||
|
File::Spec->rel2abs($self->externalFileName()) and -r $name) {
|
||||||
|
return AZ_OK;
|
||||||
|
} else {
|
||||||
|
return $self->SUPER::extractToFileNamed($name, @_);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
@ -0,0 +1,64 @@
|
|||||||
|
package Archive::Zip::StringMember;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw( $VERSION @ISA );
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
@ISA = qw( Archive::Zip::Member );
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip qw(
|
||||||
|
:CONSTANTS
|
||||||
|
:ERROR_CODES
|
||||||
|
);
|
||||||
|
|
||||||
|
# Create a new string member. Default is COMPRESSION_STORED.
|
||||||
|
# Can take a ref to a string as well.
|
||||||
|
sub _newFromString {
|
||||||
|
my $class = shift;
|
||||||
|
my $string = shift;
|
||||||
|
my $name = shift;
|
||||||
|
my $self = $class->new(@_);
|
||||||
|
$self->contents($string);
|
||||||
|
$self->fileName($name) if defined($name);
|
||||||
|
|
||||||
|
# Set the file date to now
|
||||||
|
$self->setLastModFileDateTimeFromUnix(time());
|
||||||
|
$self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _become {
|
||||||
|
my $self = shift;
|
||||||
|
my $newClass = shift;
|
||||||
|
return $self if ref($self) eq $newClass;
|
||||||
|
delete($self->{'contents'});
|
||||||
|
return $self->SUPER::_become($newClass);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Get or set my contents. Note that we do not call the superclass
|
||||||
|
# version of this, because it calls us.
|
||||||
|
sub contents {
|
||||||
|
my $self = shift;
|
||||||
|
my $string = shift;
|
||||||
|
if (defined($string)) {
|
||||||
|
$self->{'contents'} =
|
||||||
|
pack('C0a*', (ref($string) eq 'SCALAR') ? $$string : $string);
|
||||||
|
$self->{'uncompressedSize'} = $self->{'compressedSize'} =
|
||||||
|
length($self->{'contents'});
|
||||||
|
$self->{'compressionMethod'} = COMPRESSION_STORED;
|
||||||
|
}
|
||||||
|
return $self->{'contents'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return bytes read. Note that first parameter is a ref to a buffer.
|
||||||
|
# my $data;
|
||||||
|
# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
|
||||||
|
sub _readRawChunk {
|
||||||
|
my ($self, $dataRef, $chunkSize) = @_;
|
||||||
|
$$dataRef = substr($self->contents(), $self->_readOffset(), $chunkSize);
|
||||||
|
return (length($$dataRef), AZ_OK);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
@ -0,0 +1,48 @@
|
|||||||
|
package Archive::Zip::Tree;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw{$VERSION};
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip;
|
||||||
|
|
||||||
|
warn(
|
||||||
|
"Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip."
|
||||||
|
) if $^W;
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Archive::Zip::Tree - (DEPRECATED) methods for adding/extracting trees using Archive::Zip
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module is deprecated, because all its methods were moved into the main
|
||||||
|
Archive::Zip module.
|
||||||
|
|
||||||
|
It is included in the distribution merely to avoid breaking old code.
|
||||||
|
|
||||||
|
See L<Archive::Zip>.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Ned Konz, perl@bike-nomad.com
|
||||||
|
|
||||||
|
=head1 COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (c) 2000-2002 Ned Konz. All rights reserved. This program is free
|
||||||
|
software; you can redistribute it and/or modify it under the same terms
|
||||||
|
as Perl itself.
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
L<Archive::Zip>
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
@ -0,0 +1,416 @@
|
|||||||
|
package Archive::Zip::ZipFileMember;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw( $VERSION @ISA );
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
$VERSION = '1.48';
|
||||||
|
@ISA = qw ( Archive::Zip::FileMember );
|
||||||
|
}
|
||||||
|
|
||||||
|
use Archive::Zip qw(
|
||||||
|
:CONSTANTS
|
||||||
|
:ERROR_CODES
|
||||||
|
:PKZIP_CONSTANTS
|
||||||
|
:UTILITY_METHODS
|
||||||
|
);
|
||||||
|
|
||||||
|
# Create a new Archive::Zip::ZipFileMember
|
||||||
|
# given a filename and optional open file handle
|
||||||
|
#
|
||||||
|
sub _newFromZipFile {
|
||||||
|
my $class = shift;
|
||||||
|
my $fh = shift;
|
||||||
|
my $externalFileName = shift;
|
||||||
|
my $possibleEocdOffset = shift; # normally 0
|
||||||
|
|
||||||
|
my $self = $class->new(
|
||||||
|
'crc32' => 0,
|
||||||
|
'diskNumberStart' => 0,
|
||||||
|
'localHeaderRelativeOffset' => 0,
|
||||||
|
'dataOffset' => 0, # localHeaderRelativeOffset + header length
|
||||||
|
@_
|
||||||
|
);
|
||||||
|
$self->{'externalFileName'} = $externalFileName;
|
||||||
|
$self->{'fh'} = $fh;
|
||||||
|
$self->{'possibleEocdOffset'} = $possibleEocdOffset;
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub isDirectory {
|
||||||
|
my $self = shift;
|
||||||
|
return (substr($self->fileName, -1, 1) eq '/'
|
||||||
|
and $self->uncompressedSize == 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Seek to the beginning of the local header, just past the signature.
|
||||||
|
# Verify that the local header signature is in fact correct.
|
||||||
|
# Update the localHeaderRelativeOffset if necessary by adding the possibleEocdOffset.
|
||||||
|
# Returns status.
|
||||||
|
|
||||||
|
sub _seekToLocalHeader {
|
||||||
|
my $self = shift;
|
||||||
|
my $where = shift; # optional
|
||||||
|
my $previousWhere = shift; # optional
|
||||||
|
|
||||||
|
$where = $self->localHeaderRelativeOffset() unless defined($where);
|
||||||
|
|
||||||
|
# avoid loop on certain corrupt files (from Julian Field)
|
||||||
|
return _formatError("corrupt zip file")
|
||||||
|
if defined($previousWhere) && $where == $previousWhere;
|
||||||
|
|
||||||
|
my $status;
|
||||||
|
my $signature;
|
||||||
|
|
||||||
|
$status = $self->fh()->seek($where, IO::Seekable::SEEK_SET);
|
||||||
|
return _ioError("seeking to local header") unless $status;
|
||||||
|
|
||||||
|
($status, $signature) =
|
||||||
|
_readSignature($self->fh(), $self->externalFileName(),
|
||||||
|
LOCAL_FILE_HEADER_SIGNATURE);
|
||||||
|
return $status if $status == AZ_IO_ERROR;
|
||||||
|
|
||||||
|
# retry with EOCD offset if any was given.
|
||||||
|
if ($status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'}) {
|
||||||
|
$status = $self->_seekToLocalHeader(
|
||||||
|
$self->localHeaderRelativeOffset() + $self->{'possibleEocdOffset'},
|
||||||
|
$where
|
||||||
|
);
|
||||||
|
if ($status == AZ_OK) {
|
||||||
|
$self->{'localHeaderRelativeOffset'} +=
|
||||||
|
$self->{'possibleEocdOffset'};
|
||||||
|
$self->{'possibleEocdOffset'} = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return $status;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Because I'm going to delete the file handle, read the local file
|
||||||
|
# header if the file handle is seekable. If it is not, I assume that
|
||||||
|
# I've already read the local header.
|
||||||
|
# Return ( $status, $self )
|
||||||
|
|
||||||
|
sub _become {
|
||||||
|
my $self = shift;
|
||||||
|
my $newClass = shift;
|
||||||
|
return $self if ref($self) eq $newClass;
|
||||||
|
|
||||||
|
my $status = AZ_OK;
|
||||||
|
|
||||||
|
if (_isSeekable($self->fh())) {
|
||||||
|
my $here = $self->fh()->tell();
|
||||||
|
$status = $self->_seekToLocalHeader();
|
||||||
|
$status = $self->_readLocalFileHeader() if $status == AZ_OK;
|
||||||
|
$self->fh()->seek($here, IO::Seekable::SEEK_SET);
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
delete($self->{'eocdCrc32'});
|
||||||
|
delete($self->{'diskNumberStart'});
|
||||||
|
delete($self->{'localHeaderRelativeOffset'});
|
||||||
|
delete($self->{'dataOffset'});
|
||||||
|
|
||||||
|
return $self->SUPER::_become($newClass);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub diskNumberStart {
|
||||||
|
shift->{'diskNumberStart'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub localHeaderRelativeOffset {
|
||||||
|
shift->{'localHeaderRelativeOffset'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub dataOffset {
|
||||||
|
shift->{'dataOffset'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Skip local file header, updating only extra field stuff.
|
||||||
|
# Assumes that fh is positioned before signature.
|
||||||
|
sub _skipLocalFileHeader {
|
||||||
|
my $self = shift;
|
||||||
|
my $header;
|
||||||
|
my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH);
|
||||||
|
if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) {
|
||||||
|
return _ioError("reading local file header");
|
||||||
|
}
|
||||||
|
my $fileNameLength;
|
||||||
|
my $extraFieldLength;
|
||||||
|
my $bitFlag;
|
||||||
|
(
|
||||||
|
undef, # $self->{'versionNeededToExtract'},
|
||||||
|
$bitFlag,
|
||||||
|
undef, # $self->{'compressionMethod'},
|
||||||
|
undef, # $self->{'lastModFileDateTime'},
|
||||||
|
undef, # $crc32,
|
||||||
|
undef, # $compressedSize,
|
||||||
|
undef, # $uncompressedSize,
|
||||||
|
$fileNameLength,
|
||||||
|
$extraFieldLength
|
||||||
|
) = unpack(LOCAL_FILE_HEADER_FORMAT, $header);
|
||||||
|
|
||||||
|
if ($fileNameLength) {
|
||||||
|
$self->fh()->seek($fileNameLength, IO::Seekable::SEEK_CUR)
|
||||||
|
or return _ioError("skipping local file name");
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($extraFieldLength) {
|
||||||
|
$bytesRead =
|
||||||
|
$self->fh()->read($self->{'localExtraField'}, $extraFieldLength);
|
||||||
|
if ($bytesRead != $extraFieldLength) {
|
||||||
|
return _ioError("reading local extra field");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{'dataOffset'} = $self->fh()->tell();
|
||||||
|
|
||||||
|
if ($bitFlag & GPBF_HAS_DATA_DESCRIPTOR_MASK) {
|
||||||
|
|
||||||
|
# Read the crc32, compressedSize, and uncompressedSize from the
|
||||||
|
# extended data descriptor, which directly follows the compressed data.
|
||||||
|
#
|
||||||
|
# Skip over the compressed file data (assumes that EOCD compressedSize
|
||||||
|
# was correct)
|
||||||
|
$self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR)
|
||||||
|
or return _ioError("seeking to extended local header");
|
||||||
|
|
||||||
|
# these values should be set correctly from before.
|
||||||
|
my $oldCrc32 = $self->{'eocdCrc32'};
|
||||||
|
my $oldCompressedSize = $self->{'compressedSize'};
|
||||||
|
my $oldUncompressedSize = $self->{'uncompressedSize'};
|
||||||
|
|
||||||
|
my $status = $self->_readDataDescriptor();
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
|
||||||
|
# The buffer withe encrypted data is prefixed with a new
|
||||||
|
# encrypted 12 byte header. The size only changes when
|
||||||
|
# the buffer is also compressed
|
||||||
|
$self->isEncrypted && $oldUncompressedSize > $self->{uncompressedSize}
|
||||||
|
and $oldUncompressedSize -= DATA_DESCRIPTOR_LENGTH;
|
||||||
|
|
||||||
|
return _formatError(
|
||||||
|
"CRC or size mismatch while skipping data descriptor")
|
||||||
|
if ( $oldCrc32 != $self->{'crc32'}
|
||||||
|
|| $oldUncompressedSize != $self->{'uncompressedSize'});
|
||||||
|
|
||||||
|
$self->{'crc32'} = 0
|
||||||
|
if $self->compressionMethod() == COMPRESSION_STORED ;
|
||||||
|
}
|
||||||
|
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Read from a local file header into myself. Returns AZ_OK if successful.
|
||||||
|
# Assumes that fh is positioned after signature.
|
||||||
|
# Note that crc32, compressedSize, and uncompressedSize will be 0 if
|
||||||
|
# GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag.
|
||||||
|
|
||||||
|
sub _readLocalFileHeader {
|
||||||
|
my $self = shift;
|
||||||
|
my $header;
|
||||||
|
my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH);
|
||||||
|
if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) {
|
||||||
|
return _ioError("reading local file header");
|
||||||
|
}
|
||||||
|
my $fileNameLength;
|
||||||
|
my $crc32;
|
||||||
|
my $compressedSize;
|
||||||
|
my $uncompressedSize;
|
||||||
|
my $extraFieldLength;
|
||||||
|
(
|
||||||
|
$self->{'versionNeededToExtract'}, $self->{'bitFlag'},
|
||||||
|
$self->{'compressionMethod'}, $self->{'lastModFileDateTime'},
|
||||||
|
$crc32, $compressedSize,
|
||||||
|
$uncompressedSize, $fileNameLength,
|
||||||
|
$extraFieldLength
|
||||||
|
) = unpack(LOCAL_FILE_HEADER_FORMAT, $header);
|
||||||
|
|
||||||
|
if ($fileNameLength) {
|
||||||
|
my $fileName;
|
||||||
|
$bytesRead = $self->fh()->read($fileName, $fileNameLength);
|
||||||
|
if ($bytesRead != $fileNameLength) {
|
||||||
|
return _ioError("reading local file name");
|
||||||
|
}
|
||||||
|
$self->fileName($fileName);
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($extraFieldLength) {
|
||||||
|
$bytesRead =
|
||||||
|
$self->fh()->read($self->{'localExtraField'}, $extraFieldLength);
|
||||||
|
if ($bytesRead != $extraFieldLength) {
|
||||||
|
return _ioError("reading local extra field");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{'dataOffset'} = $self->fh()->tell();
|
||||||
|
|
||||||
|
if ($self->hasDataDescriptor()) {
|
||||||
|
|
||||||
|
# Read the crc32, compressedSize, and uncompressedSize from the
|
||||||
|
# extended data descriptor.
|
||||||
|
# Skip over the compressed file data (assumes that EOCD compressedSize
|
||||||
|
# was correct)
|
||||||
|
$self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR)
|
||||||
|
or return _ioError("seeking to extended local header");
|
||||||
|
|
||||||
|
my $status = $self->_readDataDescriptor();
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
} else {
|
||||||
|
return _formatError(
|
||||||
|
"CRC or size mismatch after reading data descriptor")
|
||||||
|
if ( $self->{'crc32'} != $crc32
|
||||||
|
|| $self->{'uncompressedSize'} != $uncompressedSize);
|
||||||
|
}
|
||||||
|
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
# This will read the data descriptor, which is after the end of compressed file
|
||||||
|
# data in members that have GPBF_HAS_DATA_DESCRIPTOR_MASK set in their bitFlag.
|
||||||
|
# The only reliable way to find these is to rely on the EOCD compressedSize.
|
||||||
|
# Assumes that file is positioned immediately after the compressed data.
|
||||||
|
# Returns status; sets crc32, compressedSize, and uncompressedSize.
|
||||||
|
sub _readDataDescriptor {
|
||||||
|
my $self = shift;
|
||||||
|
my $signatureData;
|
||||||
|
my $header;
|
||||||
|
my $crc32;
|
||||||
|
my $compressedSize;
|
||||||
|
my $uncompressedSize;
|
||||||
|
|
||||||
|
my $bytesRead = $self->fh()->read($signatureData, SIGNATURE_LENGTH);
|
||||||
|
return _ioError("reading header signature")
|
||||||
|
if $bytesRead != SIGNATURE_LENGTH;
|
||||||
|
my $signature = unpack(SIGNATURE_FORMAT, $signatureData);
|
||||||
|
|
||||||
|
# unfortunately, the signature appears to be optional.
|
||||||
|
if ($signature == DATA_DESCRIPTOR_SIGNATURE
|
||||||
|
&& ($signature != $self->{'crc32'})) {
|
||||||
|
$bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH);
|
||||||
|
return _ioError("reading data descriptor")
|
||||||
|
if $bytesRead != DATA_DESCRIPTOR_LENGTH;
|
||||||
|
|
||||||
|
($crc32, $compressedSize, $uncompressedSize) =
|
||||||
|
unpack(DATA_DESCRIPTOR_FORMAT, $header);
|
||||||
|
} else {
|
||||||
|
$bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH_NO_SIG);
|
||||||
|
return _ioError("reading data descriptor")
|
||||||
|
if $bytesRead != DATA_DESCRIPTOR_LENGTH_NO_SIG;
|
||||||
|
|
||||||
|
$crc32 = $signature;
|
||||||
|
($compressedSize, $uncompressedSize) =
|
||||||
|
unpack(DATA_DESCRIPTOR_FORMAT_NO_SIG, $header);
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{'eocdCrc32'} = $self->{'crc32'}
|
||||||
|
unless defined($self->{'eocdCrc32'});
|
||||||
|
$self->{'crc32'} = $crc32;
|
||||||
|
$self->{'compressedSize'} = $compressedSize;
|
||||||
|
$self->{'uncompressedSize'} = $uncompressedSize;
|
||||||
|
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Read a Central Directory header. Return AZ_OK on success.
|
||||||
|
# Assumes that fh is positioned right after the signature.
|
||||||
|
|
||||||
|
sub _readCentralDirectoryFileHeader {
|
||||||
|
my $self = shift;
|
||||||
|
my $fh = $self->fh();
|
||||||
|
my $header = '';
|
||||||
|
my $bytesRead = $fh->read($header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH);
|
||||||
|
if ($bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH) {
|
||||||
|
return _ioError("reading central dir header");
|
||||||
|
}
|
||||||
|
my ($fileNameLength, $extraFieldLength, $fileCommentLength);
|
||||||
|
(
|
||||||
|
$self->{'versionMadeBy'},
|
||||||
|
$self->{'fileAttributeFormat'},
|
||||||
|
$self->{'versionNeededToExtract'},
|
||||||
|
$self->{'bitFlag'},
|
||||||
|
$self->{'compressionMethod'},
|
||||||
|
$self->{'lastModFileDateTime'},
|
||||||
|
$self->{'crc32'},
|
||||||
|
$self->{'compressedSize'},
|
||||||
|
$self->{'uncompressedSize'},
|
||||||
|
$fileNameLength,
|
||||||
|
$extraFieldLength,
|
||||||
|
$fileCommentLength,
|
||||||
|
$self->{'diskNumberStart'},
|
||||||
|
$self->{'internalFileAttributes'},
|
||||||
|
$self->{'externalFileAttributes'},
|
||||||
|
$self->{'localHeaderRelativeOffset'}
|
||||||
|
) = unpack(CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header);
|
||||||
|
|
||||||
|
$self->{'eocdCrc32'} = $self->{'crc32'};
|
||||||
|
|
||||||
|
if ($fileNameLength) {
|
||||||
|
$bytesRead = $fh->read($self->{'fileName'}, $fileNameLength);
|
||||||
|
if ($bytesRead != $fileNameLength) {
|
||||||
|
_ioError("reading central dir filename");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($extraFieldLength) {
|
||||||
|
$bytesRead = $fh->read($self->{'cdExtraField'}, $extraFieldLength);
|
||||||
|
if ($bytesRead != $extraFieldLength) {
|
||||||
|
return _ioError("reading central dir extra field");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($fileCommentLength) {
|
||||||
|
$bytesRead = $fh->read($self->{'fileComment'}, $fileCommentLength);
|
||||||
|
if ($bytesRead != $fileCommentLength) {
|
||||||
|
return _ioError("reading central dir file comment");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# NK 10/21/04: added to avoid problems with manipulated headers
|
||||||
|
if ( $self->{'uncompressedSize'} != $self->{'compressedSize'}
|
||||||
|
and $self->{'compressionMethod'} == COMPRESSION_STORED) {
|
||||||
|
$self->{'uncompressedSize'} = $self->{'compressedSize'};
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->desiredCompressionMethod($self->compressionMethod());
|
||||||
|
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub rewindData {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my $status = $self->SUPER::rewindData(@_);
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
|
||||||
|
return AZ_IO_ERROR unless $self->fh();
|
||||||
|
|
||||||
|
$self->fh()->clearerr();
|
||||||
|
|
||||||
|
# Seek to local file header.
|
||||||
|
# The only reason that I'm doing this this way is that the extraField
|
||||||
|
# length seems to be different between the CD header and the LF header.
|
||||||
|
$status = $self->_seekToLocalHeader();
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
|
||||||
|
# skip local file header
|
||||||
|
$status = $self->_skipLocalFileHeader();
|
||||||
|
return $status unless $status == AZ_OK;
|
||||||
|
|
||||||
|
# Seek to beginning of file data
|
||||||
|
$self->fh()->seek($self->dataOffset(), IO::Seekable::SEEK_SET)
|
||||||
|
or return _ioError("seeking to beginning of file data");
|
||||||
|
|
||||||
|
return AZ_OK;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return bytes read. Note that first parameter is a ref to a buffer.
|
||||||
|
# my $data;
|
||||||
|
# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
|
||||||
|
sub _readRawChunk {
|
||||||
|
my ($self, $dataRef, $chunkSize) = @_;
|
||||||
|
return (0, AZ_OK) unless $chunkSize;
|
||||||
|
my $bytesRead = $self->fh()->read($$dataRef, $chunkSize)
|
||||||
|
or return (0, _ioError("reading data"));
|
||||||
|
return ($bytesRead, AZ_OK);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
3
pom.xml
3
pom.xml
@ -1130,7 +1130,8 @@ org.eclipse.jdt.ui.text.custom_code_templates=<?xml version\="1.0" encoding\="UT
|
|||||||
<exec failonerror="${licenses.exists}" executable="perl" dir="${elasticsearch.tools.directory}/license-check" osfamily="unix" >
|
<exec failonerror="${licenses.exists}" executable="perl" dir="${elasticsearch.tools.directory}/license-check" osfamily="unix" >
|
||||||
<arg value="check_license_and_sha.pl"/>
|
<arg value="check_license_and_sha.pl"/>
|
||||||
<arg value="--check"/>
|
<arg value="--check"/>
|
||||||
<arg value="${basedir}"/>
|
<arg value="${basedir}/licenses"/>
|
||||||
|
<arg value="${basedir}/target/releases/${project.build.finalName}.zip"/>
|
||||||
</exec>
|
</exec>
|
||||||
</target>
|
</target>
|
||||||
</configuration>
|
</configuration>
|
||||||
|
Loading…
x
Reference in New Issue
Block a user