diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2022-03-14 10:08:50 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2022-03-14 10:08:50 +0000 |
commit | 49b9d8ffc05bf0c271287eb1390cabad28c6a47a (patch) | |
tree | e2e1779b1d4795d6b2c3bf92a4e2e4154d82124b /Master/tlpkg/tlperl/lib/IO/Compress | |
parent | f03a75ebd3b935ecde4dde32687fbe86161c30ed (diff) |
New tlperl 5.34
git-svn-id: svn://tug.org/texlive/trunk@62701 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Compress')
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm | 33 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm | 39 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm | 19 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Base.pm | 57 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm | 10 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm | 35 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm | 30 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod | 70 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm | 52 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm | 12 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm | 63 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm | 307 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm | 17 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm | 40 |
15 files changed, 423 insertions, 365 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm index a8a7762ce70..c157520f087 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status); +use IO::Compress::Base::Common 2.101 qw(:Status); -use Compress::Raw::Bzip2 2.093 ; +use Compress::Raw::Bzip2 2.101 ; our ($VERSION); -$VERSION = '2.093'; +$VERSION = '2.102'; sub mkCompObject { @@ -21,7 +21,7 @@ sub mkCompObject $WorkFactor = 0 if ! defined $WorkFactor ; $Verbosity = 0 if ! defined $Verbosity ; - my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, + my ($def, $status) = Compress::Raw::Bzip2->new(1, $BlockSize100K, $WorkFactor, $Verbosity); return (undef, "Could not create Deflate object: $status", $status) @@ -30,7 +30,7 @@ sub mkCompObject return bless {'Def' => $def, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -44,11 +44,11 @@ sub compr if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -62,12 +62,12 @@ sub flush if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } sub close @@ -81,12 +81,12 @@ sub close if ($status != BZ_STREAM_END) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } @@ -96,18 +96,18 @@ sub reset my $outer = $self->{Outer}; - my ($def, $status) = new Compress::Raw::Bzip2(); + my ($def, $status) = Compress::Raw::Bzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Deflate object: $status"; + $self->{Error} = "Cannot create Deflate object: $status"; return STATUS_ERROR; } $self->{Def} = $def; - return STATUS_OK; + return STATUS_OK; } sub compressedBytes @@ -151,4 +151,3 @@ sub uncompressedBytes 1; __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm index 140d29ff29f..1048dbda829 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm @@ -4,13 +4,13 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status); -use Compress::Raw::Zlib 2.093 qw( !crc32 !adler32 ) ; - -require Exporter; +use IO::Compress::Base::Common 2.101 qw(:Status); +use Compress::Raw::Zlib 2.101 qw( !crc32 !adler32 ) ; + +require Exporter; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); -$VERSION = '2.093'; +$VERSION = '2.102'; @ISA = qw(Exporter); @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; @@ -24,20 +24,20 @@ sub mkCompObject my $level = shift ; my $strategy = shift ; - my ($def, $status) = new Compress::Raw::Zlib::Deflate + my ($def, $status) = Compress::Raw::Zlib::Deflate->new( -AppendOutput => 1, -CRC32 => $crc32, -ADLER32 => $adler32, -Level => $level, -Strategy => $strategy, - -WindowBits => - MAX_WBITS; + -WindowBits => - MAX_WBITS); - return (undef, "Cannot create Deflate object: $status", $status) - if $status != Z_OK; + return (undef, "Cannot create Deflate object: $status", $status) + if $status != Z_OK; return bless {'Def' => $def, 'Error' => '', - } ; + } ; } sub compr @@ -51,11 +51,11 @@ sub compr if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -70,11 +70,11 @@ sub flush if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub close @@ -97,14 +97,14 @@ sub reset $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; @@ -114,11 +114,11 @@ sub deflateParams $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "deflateParams Error: $status"; + $self->{Error} = "deflateParams Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } @@ -167,4 +167,3 @@ sub adler32 1; __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm index 487cfa7b476..8b92a3cea61 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status); +use IO::Compress::Base::Common 2.101 qw(:Status); our ($VERSION); -$VERSION = '2.093'; +$VERSION = '2.102'; sub mkCompObject { @@ -19,7 +19,7 @@ sub mkCompObject 'UnCompSize' => 0, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -30,7 +30,7 @@ sub compr $self->{CompSize} += length ${ $_[0] } ; $self->{UnCompSize} = $self->{CompSize} ; - if ( ref $_[1] ) + if ( ref $_[1] ) { ${ $_[1] } .= ${ $_[0] } } else { $_[1] .= ${ $_[0] } } @@ -43,14 +43,14 @@ sub flush { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub close { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub reset @@ -60,14 +60,14 @@ sub reset $self->{CompSize} = 0; $self->{UnCompSize} = 0; - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } #sub total_out @@ -98,4 +98,3 @@ sub uncompressedBytes __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm index f817d13b472..269f10c7a45 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm @@ -6,7 +6,7 @@ require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.093 ; +use IO::Compress::Base::Common 2.101 ; use IO::File (); ; use Scalar::Util (); @@ -20,7 +20,7 @@ use Symbol(); our (@ISA, $VERSION); @ISA = qw(IO::File Exporter); -$VERSION = '2.093'; +$VERSION = '2.102'; #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. @@ -254,8 +254,8 @@ sub _create *$obj->{Compress} = $obj->mkComp($got) or return undef; - *$obj->{UnCompSize} = new U64 ; - *$obj->{CompSize} = new U64 ; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; if ( $outType eq 'buffer') { ${ *$obj->{Buffer} } = '' @@ -279,7 +279,7 @@ sub _create my $mode = '>' ; $mode = '>>' if $appendOutput; - *$obj->{FH} = new IO::File "$mode $outValue" + *$obj->{FH} = IO::File->new( "$mode $outValue" ) or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; *$obj->{StdIO} = ($outValue eq '-'); setBinModeOutput(*$obj->{FH}) ; @@ -340,7 +340,7 @@ sub _def my $haveOut = @_ ; my $output = shift ; - my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) + my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output) or return undef ; push @_, $output if $haveOut && $x->{Hash}; @@ -493,7 +493,7 @@ sub _wr2 if ( ! $isFilehandle ) { - $fh = new IO::File "<$input" + $fh = IO::File->new( "<$input" ) or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; } binmode $fh ; @@ -983,23 +983,27 @@ sub _notAvailable return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; } -*read = _notAvailable('read'); -*READ = _notAvailable('read'); -*readline = _notAvailable('readline'); -*READLINE = _notAvailable('readline'); -*getc = _notAvailable('getc'); -*GETC = _notAvailable('getc'); - -*FILENO = \&fileno; -*PRINT = \&print; -*PRINTF = \&printf; -*WRITE = \&syswrite; -*write = \&syswrite; -*SEEK = \&seek; -*TELL = \&tell; -*EOF = \&eof; -*CLOSE = \&close; -*BINMODE = \&binmode; +{ + no warnings 'once'; + + *read = _notAvailable('read'); + *READ = _notAvailable('read'); + *readline = _notAvailable('readline'); + *READLINE = _notAvailable('readline'); + *getc = _notAvailable('getc'); + *GETC = _notAvailable('getc'); + + *FILENO = \&fileno; + *PRINT = \&print; + *PRINTF = \&printf; + *WRITE = \&syswrite; + *write = \&syswrite; + *SEEK = \&seek; + *TELL = \&tell; + *EOF = \&eof; + *CLOSE = \&close; + *BINMODE = \&binmode; +} #*sysread = \&_notAvailable; #*syswrite = \&_write; @@ -1023,7 +1027,7 @@ purpose is to be sub-classed by IO::Compress modules. =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. @@ -1047,8 +1051,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm index 87af18b6de8..67882cf5158 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm @@ -11,7 +11,7 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); -$VERSION = '2.093'; +$VERSION = '2.102'; @EXPORT = qw( isaFilehandle isaFilename isaScalar whatIsInput whatIsOutput @@ -160,7 +160,7 @@ sub whatIsInput($;$) #use IO::File; $got = 'handle'; $_[0] = *STDIN; - #$_[0] = new IO::File("<-"); + #$_[0] = IO::File->new("<-"); } return $got; @@ -174,7 +174,7 @@ sub whatIsOutput($;$) { $got = 'handle'; $_[0] = *STDOUT; - #$_[0] = new IO::File(">-"); + #$_[0] = IO::File->new(">-"); } return $got; @@ -267,7 +267,7 @@ sub IO::Compress::Base::Validator::new { $data{GlobMap} = 1 ; $data{inType} = $data{outType} = 'filename'; - my $mapper = new File::GlobMapper($_[0], $_[1]); + my $mapper = File::GlobMapper->new($_[0], $_[1]); if ( ! $mapper ) { return $obj->saveErrorString($File::GlobMapper::Error) ; @@ -509,7 +509,7 @@ sub ParseParameters return $_[1] if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters"); - my $p = new IO::Compress::Base::Parameters() ; + my $p = IO::Compress::Base::Parameters->new(); $p->parse(@_) or croak "$sub: $p->[IxError]" ; diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm index 13d3b4674df..2d333fd1e6d 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.093 ; +use IO::Compress::Base 2.101 ; -use IO::Compress::Base::Common 2.093 qw(); -use IO::Compress::Adapter::Bzip2 2.093 ; +use IO::Compress::Base::Common 2.101 qw(); +use IO::Compress::Adapter::Bzip2 2.101 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.093'; +$VERSION = '2.102'; $Bzip2Error = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -40,7 +40,7 @@ sub bzip2 } -sub mkHeader +sub mkHeader { my $self = shift ; return ''; @@ -51,9 +51,9 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.093 qw(:Parse); - - return ( + use IO::Compress::Base::Common 2.101 qw(:Parse); + + return ( 'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned, 1], 'workfactor' => [IO::Compress::Base::Common::Parse_unsigned, 0], 'verbosity' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -66,7 +66,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + # check that BlockSize100K is a number between 1 & 9 if ($got->parsed('blocksize100k')) { my $value = $got->getValue('blocksize100k'); @@ -101,7 +101,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + return $obj; } @@ -133,7 +133,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } 1; @@ -151,7 +151,7 @@ IO::Compress::Bzip2 - Write bzip2 files/buffers my $status = bzip2 $input => $output [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "bzip2 failed: $Bzip2Error\n"; $z->print($string); @@ -426,7 +426,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; bzip2 $input => \$buffer @@ -463,7 +463,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Bzip2> is shown below - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "IO::Compress::Bzip2 failed: $Bzip2Error\n"; It returns an C<IO::Compress::Bzip2> object on success and undef on failure. @@ -765,7 +765,7 @@ See the L</"Constructor Options"> section for more details. =head1 Importing -No symbolic constants are required by this IO::Compress::Bzip2 at present. +No symbolic constants are required by IO::Compress::Bzip2 at present. =over 5 @@ -790,7 +790,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. @@ -818,8 +818,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm index 5ecac19b889..9e71977df49 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm @@ -8,16 +8,16 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.093 (); -use IO::Compress::Adapter::Deflate 2.093 ; +use IO::Compress::RawDeflate 2.101 (); +use IO::Compress::Adapter::Deflate 2.101 ; -use IO::Compress::Zlib::Constants 2.093 ; -use IO::Compress::Base::Common 2.093 qw(); +use IO::Compress::Zlib::Constants 2.101 ; +use IO::Compress::Base::Common 2.101 qw(); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.093'; +$VERSION = '2.102'; $DeflateError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -80,7 +80,7 @@ sub mkDeflateHdr($$$;$) return $hdr; } -sub mkHeader +sub mkHeader { my $self = shift ; my $param = shift ; @@ -89,7 +89,7 @@ sub mkHeader my $strategy = $param->getValue('strategy'); my $lflag ; - $level = 6 + $level = 6 if $level == Z_DEFAULT_COMPRESSION ; if (ZLIB_VERNUM >= 0x1210) @@ -118,7 +118,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + $got->setValue('adler32' => 1); return 1 ; } @@ -149,6 +149,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError); } @@ -158,7 +159,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } @@ -178,7 +179,7 @@ IO::Compress::Deflate - Write RFC 1950 files/buffers my $status = deflate $input => $output [,OPTS] or die "deflate failed: $DeflateError\n"; - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "deflate failed: $DeflateError\n"; $z->print($string); @@ -455,7 +456,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Deflate qw(deflate $DeflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; deflate $input => \$buffer @@ -492,7 +493,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Deflate> is shown below - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "IO::Compress::Deflate failed: $DeflateError\n"; It returns an C<IO::Compress::Deflate> object on success and undef on failure. @@ -914,7 +915,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. @@ -951,8 +952,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod b/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod index 697f0f3d3b0..367468ec078 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod +++ b/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod @@ -79,7 +79,7 @@ write a C<.tar.Z> file use Archive::Tar; use IO::File; - my $fh = new IO::File "| compress -c >$filename"; + my $fh = IO::File->new( "| compress -c >$filename" ); my $tar = Archive::Tar->new(); ... $tar->write($fh); @@ -101,7 +101,7 @@ recompression. my $gzipFile = "somefile.gz"; my $bzipFile = "somefile.bz2"; - my $gunzip = new IO::Uncompress::Gunzip $gzipFile + my $gunzip = IO::Uncompress::Gunzip->new( $gzipFile ) or die "Cannot gunzip $gzipFile: $GunzipError\n" ; bzip2 $gunzip => $bzipFile @@ -167,8 +167,8 @@ by including the C<Zip64> option. If you want to create a zip64 zip file with the OO interface you must specify the C<Zip64> option. - my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; - + my $zip = IO::Compress::Zip->new( "whatever", Zip64 => 1 ); + When uncompressing with C<IO-Uncompress-Unzip>, it will automatically detect if the zip file is zip64. @@ -300,14 +300,14 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm package Apache::GZip; #File: Apache::GZip.pm - + use strict vars; use Apache::Constants ':common'; use Compress::Zlib; use IO::File; use constant GZIP_MAGIC => 0x1f8b; use constant OS_MAGIC => 0x03; - + sub handler { my $r = shift; my ($fh,$gz); @@ -316,28 +316,28 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm $r->header_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; - + tie *STDOUT,'Apache::GZip',$r; print($_) while <$fh>; untie *STDOUT; return OK; } - + sub TIEHANDLE { my($class,$r) = @_; # initialize a deflation stream my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; - + # gzip header -- don't ask how I found out $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); - + return bless { r => $r, crc => crc32(undef), d => $d, l => 0 },$class; } - + sub PRINT { my $self = shift; foreach (@_) { @@ -349,18 +349,18 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm $self->{crc} = crc32($_,$self->{crc}); } } - + sub DESTROY { my $self = shift; - + # flush the output buffers my $data = $self->{d}->flush; $self->{r}->print($data); - + # print the CRC and the total length (uncompressed) $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); } - + 1; Here's the Apache configuration entry you'll need to make use of it. Once @@ -401,12 +401,12 @@ C<IO::Compress::Gzip> is used instead of C<Compress::Zlib> the whole tied filehandle code can be removed. Here is the rewritten code. package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip; use IO::File; - + sub handler { my $r = shift; my ($fh,$gz); @@ -416,22 +416,22 @@ filehandle code can be removed. Here is the rewritten code. $r->send_http_header; return OK if $r->header_only; - my $gz = new IO::Compress::Gzip '-', Minimal => 1 + my $gz = IO::Compress::Gzip->new( '-', Minimal => 1 ) or return DECLINED ; print $gz $_ while <$fh>; - + return OK; } - + or even more succinctly, like this, using a one-shot gzip package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip qw(gzip); - + sub handler { my $r = shift; $r->header_out('Content-Encoding'=>'gzip'); @@ -443,7 +443,7 @@ or even more succinctly, like this, using a one-shot gzip return OK; } - + 1; The use of one-shot C<gzip> above just reads from C<< $r->filename >> and @@ -468,7 +468,7 @@ read from the FTP Server. use Net::FTP; use IO::Uncompress::Gunzip qw(:all); - my $ftp = new Net::FTP ... + my $ftp = Net::FTP->new( ... ) my $retr_fh = $ftp->retr($compressed_filename); gunzip $retr_fh => $outFilename, AutoClose => 1 @@ -518,7 +518,7 @@ the other C<IO::Uncompress::*> modules. my $file = $ARGV[0] ; - my $fh = new IO::File "<$file" + my $fh = IO::File->new( "<$file" ) or die "Cannot open '$file': $!\n"; while (1) @@ -566,9 +566,9 @@ the other C<IO::Uncompress::*> modules. # Done reading the Local Header - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -585,14 +585,14 @@ The majority of the code above is concerned with reading the zip local header data. The code that I want to focus on is at the bottom. while (1) { - + # read local zip header data # get $filename # get $compressedLength - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -618,7 +618,7 @@ byte directly after the compressed data stream. Now consider what the code looks like without C<InputLength> while (1) { - + # read local zip header data # get $filename # get $compressedLength @@ -626,8 +626,8 @@ Now consider what the code looks like without C<InputLength> # read all the compressed data into $data read($fh, $data, $compressedLength); - my $inf = new IO::Uncompress::RawInflate \$data, - Transparent => 1, + my $inf = IO::Uncompress::RawInflate->new( \$data, + Transparent => 1 ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -658,7 +658,7 @@ file. =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs//issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=>. @@ -682,7 +682,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm index 3fd13695083..4111d079381 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm @@ -8,24 +8,24 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.093 () ; -use IO::Compress::Adapter::Deflate 2.093 ; +use IO::Compress::RawDeflate 2.101 () ; +use IO::Compress::Adapter::Deflate 2.101 ; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Compress::Gzip::Constants 2.093 ; -use IO::Compress::Zlib::Extra 2.093 ; +use IO::Compress::Base::Common 2.101 qw(:Status ); +use IO::Compress::Gzip::Constants 2.101 ; +use IO::Compress::Zlib::Extra 2.101 ; BEGIN { - if (defined &utf8::downgrade ) + if (defined &utf8::downgrade ) { *noUTF8 = \&utf8::downgrade } else - { *noUTF8 = sub {} } + { *noUTF8 = sub {} } } our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.093'; +$VERSION = '2.102'; $GzipError = '' ; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -65,7 +65,7 @@ sub getExtraParams return ( # zlib behaviour $self->getZlibParams(), - + # Gzip header fields 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 'comment' => [IO::Compress::Base::Common::Parse_any, undef], @@ -105,7 +105,7 @@ sub ckParams # Also check that they only contain ISO 8859-1 chars. if ($got->parsed('name') && defined $got->getValue('name')) { my $name = $got->getValue('name'); - + return $self->saveErrorString(undef, "Null Character found in Name", Z_DATA_ERROR) if $strict && $name =~ /\x00/ ; @@ -132,16 +132,16 @@ sub ckParams return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'") if $value < 0 || $value > 255 ; - + } # gzip only supports Deflate at present $got->setValue('method' => Z_DEFLATED) ; if ( ! $got->parsed('extraflags')) { - $got->setValue('extraflags' => 2) + $got->setValue('extraflags' => 2) if $got->getValue('level') == Z_BEST_COMPRESSION ; - $got->setValue('extraflags' => 4) + $got->setValue('extraflags' => 4) if $got->getValue('level') == Z_BEST_SPEED ; } @@ -161,12 +161,13 @@ sub ckParams sub mkTrailer { my $self = shift ; - return pack("V V", *$self->{Compress}->crc32(), + return pack("V V", *$self->{Compress}->crc32(), *$self->{UnCompSize}->get32bit()); } sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError); } @@ -184,7 +185,7 @@ sub getFileInfo $params->setValue('name' => $filename) if ! $params->parsed('name') ; - $params->setValue('time' => $defaultTime) + $params->setValue('time' => $defaultTime) if ! $params->parsed('time') ; } @@ -207,7 +208,7 @@ sub mkHeader $flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ; $flags |= GZIP_FLG_FNAME if $param->wantValue('name') ; $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ; - + # MTIME my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ; @@ -218,7 +219,7 @@ sub mkHeader my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ; - my $out = pack("C4 V C C", + my $out = pack("C4 V C C", GZIP_ID1, # ID1 GZIP_ID2, # ID2 $method, # Compression Method @@ -240,7 +241,7 @@ sub mkHeader $name =~ s/\x00.*$//; $out .= $name ; # Terminate the filename with NULL unless it already is - $out .= GZIP_NULL_BYTE + $out .= GZIP_NULL_BYTE if !length $name or substr($name, 1, -1) ne GZIP_NULL_BYTE ; } @@ -257,7 +258,7 @@ sub mkHeader } # HEADER CRC - $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) + $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->getValue('headercrc') ; noUTF8($out); @@ -270,7 +271,7 @@ sub mkFinalTrailer return ''; } -1; +1; __END__ @@ -285,7 +286,7 @@ IO::Compress::Gzip - Write RFC 1952 files/buffers my $status = gzip $input => $output [,OPTS] or die "gzip failed: $GzipError\n"; - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "gzip failed: $GzipError\n"; $z->print($string); @@ -573,7 +574,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Gzip qw(gzip $GzipError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; gzip $input => \$buffer @@ -610,7 +611,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Gzip> is shown below - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "IO::Compress::Gzip failed: $GzipError\n"; It returns an C<IO::Compress::Gzip> object on success and undef on failure. @@ -1226,7 +1227,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Copress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Copress>. @@ -1263,8 +1264,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm index 1d18fc4004c..a3d09e2e214 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.093'; +$VERSION = '2.102'; @ISA = qw(Exporter); @@ -89,22 +89,22 @@ use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE + GZIP_FEXTRA_SUBFIELD_LEN_SIZE; -use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - +use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ; if (ord('A') == 193) { - # EBCDIC + # EBCDIC $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]'; - + } else { $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x1F\x7F-\x9F]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x09\x11-\x1F\x7F-\x9F]'; -} +} use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip @@ -140,7 +140,7 @@ use constant GZIP_OS_DEFAULT=> 0xFF ; GZIP_OS_DEFAULT() => 'Unknown', ) ; -use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", +use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ; diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm index c833f5e98b0..6a0ff6e0f3d 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm @@ -6,15 +6,16 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base 2.093 ; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Compress::Adapter::Deflate 2.093 ; +use IO::Compress::Base 2.101 ; +use IO::Compress::Base::Common 2.101 qw(:Status :Parse); +use IO::Compress::Adapter::Deflate 2.101 ; +use Compress::Raw::Zlib 2.101 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.093'; +$VERSION = '2.102'; $RawDeflateError = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -28,8 +29,8 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; my %seen; foreach (keys %EXPORT_TAGS ) { - push @{$EXPORT_TAGS{constants}}, - grep { !$seen{$_}++ } + push @{$EXPORT_TAGS{constants}}, + grep { !$seen{$_}++ } @{ $EXPORT_TAGS{$_} } } $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ; @@ -41,7 +42,7 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; #push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); - + sub new @@ -82,7 +83,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - return $obj; + return $obj; } @@ -116,8 +117,6 @@ sub getExtraParams return getZlibParams(); } -use IO::Compress::Base::Common 2.093 qw(:Parse); -use Compress::Raw::Zlib 2.093 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); our %PARAMS = ( #'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED], 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION], @@ -125,17 +124,18 @@ our %PARAMS = ( 'crc32' => [IO::Compress::Base::Common::Parse_boolean, 0], 'adler32' => [IO::Compress::Base::Common::Parse_boolean, 0], - 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], ); - + sub getZlibParams { - return %PARAMS; + return %PARAMS; } sub getInverseClass { - return ('IO::Uncompress::RawInflate', + no warnings 'once'; + return ('IO::Uncompress::RawInflate', \$IO::Uncompress::RawInflate::RawInflateError); } @@ -144,7 +144,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } use Fcntl qw(SEEK_SET); @@ -156,20 +156,20 @@ sub createMerge my $outType = shift ; my ($invClass, $error_ref) = $self->getInverseClass(); - eval "require $invClass" + eval "require $invClass" or die "aaaahhhh" ; - my $inf = $invClass->new( $outValue, - Transparent => 0, + my $inf = $invClass->new( $outValue, + Transparent => 0, #Strict => 1, AutoClose => 0, Scan => 1) or return $self->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) ; my $end_offset = 0; - $inf->scan() + $inf->scan() or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ; - $inf->zap($end_offset) + $inf->zap($end_offset) or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ; my $def = *$self->{Compress} = $inf->createDeflate(); @@ -178,10 +178,10 @@ sub createMerge *$self->{UnCompSize} = *$inf->{UnCompSize}->clone(); *$self->{CompSize} = *$inf->{CompSize}->clone(); # TODO -- fix this - #*$self->{CompSize} = new U64(0, *$self->{UnCompSize_32bit}); + #*$self->{CompSize} = U64->new(0, *$self->{UnCompSize_32bit}); - if ( $outType eq 'buffer') + if ( $outType eq 'buffer') { substr( ${ *$self->{Buffer} }, $end_offset) = '' } elsif ($outType eq 'handle' || $outType eq 'filename') { *$self->{FH} = *$inf->{FH} ; @@ -189,8 +189,8 @@ sub createMerge *$self->{FH}->flush() ; *$self->{Handle} = 1 if $outType eq 'handle'; - #seek(*$self->{FH}, $end_offset, SEEK_SET) - *$self->{FH}->seek($end_offset, SEEK_SET) + #seek(*$self->{FH}, $end_offset, SEEK_SET) + *$self->{FH}->seek($end_offset, SEEK_SET) or return $self->saveErrorString(undef, $!, $!) ; } @@ -199,7 +199,7 @@ sub createMerge #### zlib specific methods -sub deflateParams +sub deflateParams { my $self = shift ; @@ -210,7 +210,7 @@ sub deflateParams return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; - return 1; + return 1; } @@ -231,7 +231,7 @@ IO::Compress::RawDeflate - Write RFC 1951 files/buffers my $status = rawdeflate $input => $output [,OPTS] or die "rawdeflate failed: $RawDeflateError\n"; - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "rawdeflate failed: $RawDeflateError\n"; $z->print($string); @@ -511,7 +511,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; rawdeflate $input => \$buffer @@ -548,7 +548,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::RawDeflate> is shown below - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "IO::Compress::RawDeflate failed: $RawDeflateError\n"; It returns an C<IO::Compress::RawDeflate> object on success and undef on failure. @@ -970,7 +970,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. @@ -1007,8 +1007,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm index 70b98b80d6e..fea487af678 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm @@ -4,30 +4,41 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Compress::RawDeflate 2.093 (); -use IO::Compress::Adapter::Deflate 2.093 ; -use IO::Compress::Adapter::Identity 2.093 ; -use IO::Compress::Zlib::Extra 2.093 ; -use IO::Compress::Zip::Constants 2.093 ; +use IO::Compress::Base::Common 2.101 qw(:Status ); +use IO::Compress::RawDeflate 2.101 (); +use IO::Compress::Adapter::Deflate 2.101 ; +use IO::Compress::Adapter::Identity 2.101 ; +use IO::Compress::Zlib::Extra 2.101 ; +use IO::Compress::Zip::Constants 2.101 ; use File::Spec(); use Config; -use Compress::Raw::Zlib 2.093 (); +use Compress::Raw::Zlib 2.101 (); BEGIN { - eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.093 ; - require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.093 ; + eval { require IO::Compress::Adapter::Bzip2 ; + IO::Compress::Adapter::Bzip2->import( 2.101 ); + require IO::Compress::Bzip2 ; + IO::Compress::Bzip2->import( 2.101 ); } ; - - eval { require IO::Compress::Adapter::Lzma ; - import IO::Compress::Adapter::Lzma 2.093 ; - require IO::Compress::Lzma ; - import IO::Compress::Lzma 2.093 ; + + eval { require IO::Compress::Adapter::Lzma ; + IO::Compress::Adapter::Lzma->import( 2.101 ); + require IO::Compress::Lzma ; + IO::Compress::Lzma->import( 2.101 ); + } ; + + eval { require IO::Compress::Adapter::Xz ; + IO::Compress::Adapter::Xz->import( 2.101 ); + require IO::Compress::Xz ; + IO::Compress::Xz->import( 2.101 ); + } ; + eval { require IO::Compress::Adapter::Zstd ; + IO::Compress::Adapter::Zstd->import( 2.101 ); + require IO::Compress::Zstd ; + IO::Compress::Zstd->import( 2.101 ); } ; } @@ -36,7 +47,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.093'; +$VERSION = '2.102'; $ZipError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -45,7 +56,7 @@ $ZipError = ''; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; -$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA)]; +$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_XZ ZIP_CM_ZSTD)]; push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} }; Exporter::export_ok_tags('all'); @@ -54,34 +65,42 @@ sub new { my $class = shift ; - my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError); $obj->_create(undef, @_); } sub zip { - my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError); return $obj->_def(@_); } sub isMethodAvailable { my $method = shift; - + # Store & Deflate are always available return 1 if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ; - - return 1 - if $method == ZIP_CM_BZIP2 and + + return 1 + if $method == ZIP_CM_BZIP2 and defined $IO::Compress::Adapter::Bzip2::VERSION; - + return 1 if $method == ZIP_CM_LZMA and defined $IO::Compress::Adapter::Lzma::VERSION; - - return 0; + + return 1 + if $method == ZIP_CM_XZ and + defined $IO::Compress::Adapter::Xz::VERSION; + + return 1 + if $method == ZIP_CM_ZSTD and + defined $IO::Compress::Adapter::ZSTD::VERSION; + + return 0; } sub beforePayload @@ -94,12 +113,12 @@ sub beforePayload my $sparse = *$self->{ZipData}{Sparse} ; *$self->{CompSize}->add( $sparse ); *$self->{UnCompSize}->add( $sparse ); - + *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR); - + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32}) for 1 .. int $sparse / $inc; - *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc), + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc), *$self->{ZipData}{CRC32}) if $sparse % $inc; } @@ -141,19 +160,31 @@ sub mkComp ); *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); } + elsif (*$self->{ZipData}{Method} == ZIP_CM_XZ) { + ($obj, $errstr, $errno) = IO::Compress::Adapter::Xz::mkCompObject($got->getValue('preset'), + $got->getValue('extreme'), + 0 + ); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); + } + elsif (*$self->{ZipData}{Method} == ZIP_CM_ZSTD) { + ($obj, $errstr, $errno) = IO::Compress::Adapter::Zstd::mkCompObject(defined $got->getValue('level') ? $got->getValue('level') : 3, + ); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); + } return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; if (! defined *$self->{ZipData}{SizesOffset}) { *$self->{ZipData}{SizesOffset} = 0; - *$self->{ZipData}{Offset} = new U64 ; + *$self->{ZipData}{Offset} = U64->new(); } *$self->{ZipData}{AnyZip64} = 0 if ! defined *$self->{ZipData}{AnyZip64} ; - return $obj; + return $obj; } sub reset @@ -163,7 +194,7 @@ sub reset *$self->{Compress}->reset(); *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(''); - return STATUS_OK; + return STATUS_OK; } sub filterUncompressed @@ -187,7 +218,7 @@ sub canonicalName # separators become slashes, etc.). # Will translate internal slashes in path components (i.e. on Macs) to # underscores. Discards volume names. - # When $forceDir is set, returns paths with trailing slashes + # When $forceDir is set, returns paths with trailing slashes # # input output # . '.' @@ -204,8 +235,8 @@ sub canonicalName my ( $volume, $directories, $file ) = File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); - - my @dirs = map { $_ =~ s{/}{_}g; $_ } + + my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories); if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component @@ -229,9 +260,9 @@ sub mkHeader { my $self = shift; my $param = shift ; - + *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset}); - + my $comment = ''; $comment = $param->valueOrDefault('comment') ; @@ -256,7 +287,7 @@ sub mkHeader utf8::downgrade($comment, 1) or Carp::croak "Wide character in zip comment"; } - } + } my $hdr = ''; @@ -267,19 +298,19 @@ sub mkHeader my $empty = 0; my $osCode = $param->getValue('os_code') ; my $extFileAttr = 0 ; - + # This code assumes Unix. # TODO - revisit this - $extFileAttr = 0100644 << 16 + $extFileAttr = 0100644 << 16 if $osCode == ZIP_OS_CODE_UNIX ; if (*$self->{ZipData}{Zip64}) { $empty = IO::Compress::Base::Common::MAX32; my $x = ''; - $x .= pack "V V", 0, 0 ; # uncompressedLength - $x .= pack "V V", 0, 0 ; # compressedLength - + $x .= pack "V V", 0, 0 ; # uncompressedLength + $x .= pack "V V", 0, 0 ; # compressedLength + # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x); @@ -288,8 +319,8 @@ sub mkHeader if (! $param->getValue('minimal')) { if ($param->parsed('mtime')) { - $extra .= mkExtendedTime($param->getValue('mtime'), - $param->getValue('atime'), + $extra .= mkExtendedTime($param->getValue('mtime'), + $param->getValue('atime'), $param->getValue('ctime')); $ctlExtra .= mkExtendedTime($param->getValue('mtime')); @@ -299,30 +330,30 @@ sub mkHeader { if ( $param->getValue('want_exunixn') ) { - my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') }); + my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') }); $extra .= $ux3; $ctlExtra .= $ux3; } if ( $param->getValue('exunix2') ) { - $extra .= mkUnix2Extra( @{ $param->getValue('exunix2') }); + $extra .= mkUnix2Extra( @{ $param->getValue('exunix2') }); $ctlExtra .= mkUnix2Extra(); } } - $extFileAttr = $param->getValue('extattr') + $extFileAttr = $param->getValue('extattr') if defined $param->getValue('extattr') ; - $extra .= $param->getValue('extrafieldlocal') + $extra .= $param->getValue('extrafieldlocal') if defined $param->getValue('extrafieldlocal'); - $ctlExtra .= $param->getValue('extrafieldcentral') + $ctlExtra .= $param->getValue('extrafieldcentral') if defined $param->getValue('extrafieldcentral'); } my $method = *$self->{ZipData}{Method} ; - my $gpFlag = 0 ; + my $gpFlag = 0 ; $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK if *$self->{ZipData}{Stream} ; @@ -356,7 +387,7 @@ sub mkHeader $hdr .= pack 'V', $empty ; # uncompressed length - 0 when streaming $hdr .= pack 'v', length $filename ; # filename length $hdr .= pack 'v', length $extra ; # extra length - + $hdr .= $filename ; # Remember the offset for the compressed & uncompressed lengths in the @@ -391,18 +422,18 @@ sub mkHeader $ctl .= pack 'v', length $ctlExtra ; # extra length $ctl .= pack 'v', length $comment ; # file comment length - $ctl .= pack 'v', 0 ; # disk number start + $ctl .= pack 'v', 0 ; # disk number start $ctl .= pack 'v', $ifa ; # internal file attributes $ctl .= pack 'V', $extFileAttr ; # external file attributes # offset to local hdr - if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { + if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ; } else { - $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; + $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; } - + $ctl .= $filename ; *$self->{ZipData}{Offset}->add32(length $hdr) ; @@ -424,7 +455,7 @@ sub mkTrailer $crc32 = pack "V", *$self->{ZipData}{CRC32}; } - my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} }; + my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} }; my $sizes ; if (! *$self->{ZipData}{Zip64}) { @@ -450,7 +481,7 @@ sub mkTrailer else { $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14, $crc32) or return undef; - $self->writeAt(*$self->{ZipData}{SizesOffset}, + $self->writeAt(*$self->{ZipData}{SizesOffset}, *$self->{ZipData}{Zip64} ? $xtrasize : $sizes) or return undef; } @@ -463,31 +494,31 @@ sub mkTrailer # uncompressed length - only set zip64 if needed if (*$self->{UnCompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) { - $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ; + $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ; } else { substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ; } # compressed length - only set zip64 if needed if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) { - $zip64Payload .= *$self->{CompSize}->getPacked_V64() ; + $zip64Payload .= *$self->{CompSize}->getPacked_V64() ; } else { substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ; } # Local Header offset $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64() - if *$self->{ZipData}{LocalHdrOffset}->is64bit() ; + if *$self->{ZipData}{LocalHdrOffset}->is64bit() ; # disk no - always zero, so don't need to include it. - #$zip64Payload .= pack "V", 0 ; + #$zip64Payload .= pack "V", 0 ; my $zip64Xtra = ''; - + if (length $zip64Payload) { $zip64Xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $zip64Payload); - - substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) = + + substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) = pack 'v', *$self->{ZipData}{ExtraSize} + length $zip64Xtra; *$self->{ZipData}{AnyZip64} = 1; @@ -496,7 +527,7 @@ sub mkTrailer # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details $ctl .= $zip64Xtra . $ctlExtra . $comment; - + *$self->{ZipData}{Offset}->add32(length($hdr)); *$self->{ZipData}{Offset}->add( *$self->{CompSize} ); push @{ *$self->{ZipData}{CentralDir} }, $ctl ; @@ -507,17 +538,17 @@ sub mkTrailer sub mkFinalTrailer { my $self = shift ; - + my $comment = ''; $comment = *$self->{ZipData}{ZipComment} ; my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir my $entries = @{ *$self->{ZipData}{CentralDir} }; - - *$self->{ZipData}{AnyZip64} = 1 - if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ; - + + *$self->{ZipData}{AnyZip64} = 1 + if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ; + my $cd = join '', @{ *$self->{ZipData}{CentralDir} }; my $cd_len = length $cd ; @@ -540,12 +571,12 @@ sub mkFinalTrailer . U64::pack_V64(length $z64e) . $z64e ; - *$self->{ZipData}{Offset}->add32(length $cd) ; + *$self->{ZipData}{Offset}->add32(length $cd) ; $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature $z64e .= pack 'V', 0 ; # number of disk with central dir $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir - $z64e .= pack 'V', 1 ; # Total number of disks + $z64e .= pack 'V', 1 ; # Total number of disks $cd_offset = IO::Compress::Base::Common::MAX32 ; $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ; @@ -570,7 +601,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + $got->setValue('crc32' => 1); if (! $got->parsed('time') ) { @@ -581,7 +612,7 @@ sub ckParams if ($got->parsed('extime') ) { my $timeRef = $got->getValue('extime'); if ( defined $timeRef) { - return $self->saveErrorString(undef, "exTime not a 3-element array ref") + return $self->saveErrorString(undef, "exTime not a 3-element array ref") if ref $timeRef ne 'ARRAY' || @$timeRef != 3; } @@ -589,14 +620,14 @@ sub ckParams $got->setValue("atime", $timeRef->[0]); $got->setValue("ctime", $timeRef->[2]); } - + # Unix2/3 Extended Attribute for my $name (qw(exunix2 exunixn)) { if ($got->parsed($name) ) { my $idRef = $got->getValue($name); if ( defined $idRef) { - return $self->saveErrorString(undef, "$name not a 2-element array ref") + return $self->saveErrorString(undef, "$name not a 2-element array ref") if ref $idRef ne 'ARRAY' || @$idRef != 2; } @@ -612,15 +643,15 @@ sub ckParams *$self->{ZipData}{Stream} = $got->getValue('stream'); my $method = $got->getValue('method'); - return $self->saveErrorString(undef, "Unknown Method '$method'") + return $self->saveErrorString(undef, "Unknown Method '$method'") if ! defined $ZIP_CM_MIN_VERSIONS{$method}; return $self->saveErrorString(undef, "Bzip2 not available") - if $method == ZIP_CM_BZIP2 and + if $method == ZIP_CM_BZIP2 and ! defined $IO::Compress::Adapter::Bzip2::VERSION; return $self->saveErrorString(undef, "Lzma not available") - if $method == ZIP_CM_LZMA + if $method == ZIP_CM_LZMA and ! defined $IO::Compress::Adapter::Lzma::VERSION; *$self->{ZipData}{Method} = $method; @@ -673,11 +704,11 @@ sub outputPayload #} -our %PARAMS = ( +our %PARAMS = ( 'stream' => [IO::Compress::Base::Common::Parse_boolean, 1], #'store' => [IO::Compress::Base::Common::Parse_boolean, 0], 'method' => [IO::Compress::Base::Common::Parse_unsigned, ZIP_CM_DEFLATE], - + # # Zip header fields 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 'zip64' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -689,14 +720,14 @@ our %PARAMS = ( 'efs' => [IO::Compress::Base::Common::Parse_boolean, 0], 'time' => [IO::Compress::Base::Common::Parse_any, undef], 'extime' => [IO::Compress::Base::Common::Parse_any, undef], - 'exunix2' => [IO::Compress::Base::Common::Parse_any, undef], - 'exunixn' => [IO::Compress::Base::Common::Parse_any, undef], - 'extattr' => [IO::Compress::Base::Common::Parse_any, - $Compress::Raw::Zlib::gzip_os_code == 3 - ? 0100644 << 16 + 'exunix2' => [IO::Compress::Base::Common::Parse_any, undef], + 'exunixn' => [IO::Compress::Base::Common::Parse_any, undef], + 'extattr' => [IO::Compress::Base::Common::Parse_any, + $Compress::Raw::Zlib::gzip_os_code == 3 + ? 0100644 << 16 : 0], 'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], - + 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0], 'extrafieldlocal' => [IO::Compress::Base::Common::Parse_any, undef], 'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any, undef], @@ -705,15 +736,15 @@ our %PARAMS = ( 'preset' => [IO::Compress::Base::Common::Parse_unsigned, 6], 'extreme' => [IO::Compress::Base::Common::Parse_boolean, 0], - # For internal use only + # For internal use only 'sparse' => [IO::Compress::Base::Common::Parse_unsigned, 0], IO::Compress::RawDeflate::getZlibParams(), defined $IO::Compress::Bzip2::VERSION ? IO::Compress::Bzip2::getExtraParams() : () - - + + ); sub getExtraParams @@ -723,6 +754,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Unzip', \$IO::Uncompress::Unzip::UnzipError); } @@ -744,12 +776,12 @@ sub getFileInfo my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ; if ( $params->parsed('storelinks') ) { - ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) = (lstat($filename))[2, 4,5,7, 8,9,10] ; } else { - ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) = (stat($filename))[2, 4,5,7, 8,9,10] ; } @@ -762,9 +794,9 @@ sub getFileInfo $params->setValue('name' => $filename) if ! $params->parsed('name') ; - $params->setValue('time' => $mtime) + $params->setValue('time' => $mtime) if ! $params->parsed('time') ; - + if ( ! $params->parsed('extime')) { $params->setValue('mtime' => $mtime) ; @@ -780,14 +812,14 @@ sub getFileInfo my $attr = $mode << 16; $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ; $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ; - + $params->setValue('extattr' => $attr); } $params->setValue('want_exunixn', [$uid, $gid]); $params->setValue('uid' => $uid) ; $params->setValue('gid' => $gid) ; - + } sub mkExtendedTime @@ -821,7 +853,7 @@ sub mkUnix2Extra $ids .= pack("v", $id); } - return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2, + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2, $ids); } @@ -838,7 +870,7 @@ sub mkUnixNExtra $ids .= pack "C", $Config{gidsize}; $ids .= pack "V", $gid; - return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, $ids); } @@ -847,8 +879,8 @@ sub mkUnixNExtra sub _unixToDosTime # Archive::Zip::Member { my $time_t = shift; - - # TODO - add something to cope with unix time < 1980 + + # TODO - add something to cope with unix time < 1980 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); my $dt = 0; $dt += ( $sec >> 1 ); @@ -875,7 +907,7 @@ IO::Compress::Zip - Write zip files/buffers my $status = zip $input => $output [,OPTS] or die "zip failed: $ZipError\n"; - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "zip failed: $ZipError\n"; $z->print($string); @@ -916,19 +948,35 @@ This module provides a Perl interface that allows writing zip compressed data to files or buffer. The primary purpose of this module is to provide streaming write access to -zip files and buffers. It is not a general-purpose file archiver. If that -is what you want, check out C<Archive::Zip> or C<Archive::Zip::SimpleZip>. +zip files and buffers. -At present the following compression methods are supported by IO::Compress::Zip, -namely Store (no compression at all), Deflate, Bzip2 and LZMA. - -B<Note> +At present the following compression methods are supported by IO::Compress::Zip =over 5 -=item * To use Bzip2 compression, the module C<IO::Compress::Bzip2> must be installed. +=item Store (0) + +=item Deflate (8) + +=item Bzip2 (12) + +To write Bzip2 content, the module C<IO::Uncompress::Bunzip2> must +be installed. + +=item Lzma (14) + +To write LZMA content, the module C<IO::Uncompress::UnLzma> must +be installed. + +=item Zstandard (93) + +To write Zstandard content, the module C<IO::Compress::Zstd> must +be installed. -=item * To use LZMA compression, the module C<IO::Compress::Lzma> must be installed. +=item Xz (95) + +To write Xz content, the module C<IO::Uncompress::UnXz> must +be installed. =back @@ -1205,7 +1253,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Zip qw(zip $ZipError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; zip $input => \$buffer @@ -1246,7 +1294,7 @@ or more succinctly The format of the constructor for C<IO::Compress::Zip> is shown below - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "IO::Compress::Zip failed: $ZipError\n"; It returns an C<IO::Compress::Zip> object on success and undef on failure. @@ -1338,7 +1386,7 @@ This parameter defaults to 0. =head3 File Naming Options -A quick bit of zip file terminology -- A zip archive consists of one or more I<archive members>, where each member has an associated +A quick bit of zip file terminology -- A zip archive consists of one or more I<archive members>, where each member has an associated filename, known as the I<archive member name>. The options listed in this section control how the I<archive member name> (or filename) is stored the zip archive. @@ -1355,7 +1403,7 @@ By default when adding a filename to the zip archive, the I<archive member name> You should only need to use this option if you want the I<archive member name> to be different from the uncompressed filename or when the input is a filehandle or a buffer. -The default behaviour for what I<archive member name> is used when the C<Name> option +The default behaviour for what I<archive member name> is used when the C<Name> option is I<not> specified depends on the form of the C<$input> parameter: =over 5 @@ -1365,11 +1413,11 @@ is I<not> specified depends on the form of the C<$input> parameter: If the C<$input> parameter is a filename, the value of C<$input> will be used for the I<archive member name> . -=item * +=item * If the C<$input> parameter is not a filename, the I<archive member name> will be an empty string. -=back +=back Note that both the C<CanonicalName> and C<FilterName> options can modify the value used for the I<archive member name>. @@ -1484,7 +1532,7 @@ archive. The default is 0. -=back +=back =head3 Deflate Compression Options @@ -1553,7 +1601,7 @@ The default is 0. =back -=head3 Lzma Compression Options +=head3 Lzma and Xz Compression Options =over 5 @@ -1683,11 +1731,11 @@ By default, no comment field is written to the zip file. =item C<< Method => $method >> -Controls which compression method is used. At present four compression -methods are supported, namely Store (no compression at all), Deflate, -Bzip2 and Lzma. +Controls which compression method is used. At present the compression +methods supported are: Store (no compression at all), Deflate, +Bzip2, Zstd, Xz and Lzma. -The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2 and ZIP_CM_LZMA +The symbols ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_ZSTD, ZIP_CM_XZ and ZIP_CM_LZMA are used to select the compression method. These constants are not imported by C<IO::Compress::Zip> by default. @@ -1704,6 +1752,14 @@ Note that to create Lzma content, the module C<IO::Compress::Lzma> must be installed. A fatal error will be thrown if you attempt to create Lzma content when C<IO::Compress::Lzma> is not available. +Note that to create Xz content, the module C<IO::Compress::Xz> must +be installed. A fatal error will be thrown if you attempt to create Xz +content when C<IO::Compress::Xz> is not available. + +Note that to create Zstd content, the module C<IO::Compress::Zstd> must +be installed. A fatal error will be thrown if you attempt to create Zstd +content when C<IO::Compress::Zstd> is not available. + The default method is ZIP_CM_DEFLATE. =item C<< TextFlag => 0|1 >> @@ -2050,7 +2106,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT -General feedback/questions/bug reports should be sent to +General feedback/questions/bug reports should be sent to L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. @@ -2087,8 +2143,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2019 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm index edae0c29d27..7982fc32f6e 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.093'; +$VERSION = '2.102'; @ISA = qw(Exporter); @@ -18,7 +18,9 @@ $VERSION = '2.093'; ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_PPMD - + ZIP_CM_XZ + ZIP_CM_ZSTD + ZIP_LOCAL_HDR_SIG ZIP_DATA_HDR_SIG ZIP_CENTRAL_HDR_SIG @@ -40,7 +42,7 @@ $VERSION = '2.093'; ZIP_EXTRA_ID_INFO_ZIP_UNIX2 ZIP_EXTRA_ID_INFO_ZIP_UNIXN ZIP_EXTRA_ID_INFO_ZIP_Upath - ZIP_EXTRA_ID_INFO_ZIP_Ucom + ZIP_EXTRA_ID_INFO_ZIP_Ucom ZIP_EXTRA_ID_JAVA_EXE ZIP_OS_CODE_UNIX @@ -55,7 +57,7 @@ $VERSION = '2.093'; ZIP_A_HIDDEN ZIP_A_SYSTEM ZIP_A_LABEL - ZIP_A_DIR + ZIP_A_DIR ZIP_A_ARCHIVE ); @@ -63,7 +65,9 @@ $VERSION = '2.093'; use constant ZIP_CM_STORE => 0 ; use constant ZIP_CM_DEFLATE => 8 ; use constant ZIP_CM_BZIP2 => 12 ; -use constant ZIP_CM_LZMA => 14 ; # Not Supported yet +use constant ZIP_CM_LZMA => 14 ; +use constant ZIP_CM_ZSTD => 93 ; +use constant ZIP_CM_XZ => 95 ; use constant ZIP_CM_PPMD => 98 ; # Not Supported yet # General Purpose Flag @@ -116,10 +120,11 @@ use constant ZIP64_MIN_VERSION => 45; ZIP_CM_BZIP2() => 46, ZIP_CM_LZMA() => 63, ZIP_CM_PPMD() => 63, + ZIP_CM_ZSTD() => 20, # Winzip needs these to be 20 + ZIP_CM_XZ() => 20, ); 1; __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm index c2fecba974f..937101e4274 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.093'; +$VERSION = '2.102'; @ISA = qw(Exporter); @@ -23,7 +23,7 @@ $VERSION = '2.093'; ZLIB_CMF_CM_DEFLATED ZLIB_CMF_CINFO_OFFSET - ZLIB_CMF_CINFO_BITS + ZLIB_CMF_CINFO_BITS ZLIB_CMF_CINFO_MAX ZLIB_FLG_FCHECK_OFFSET diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm index 6e13d4fb2f1..ab7446a4643 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.093'; +$VERSION = '2.102'; -use IO::Compress::Gzip::Constants 2.093 ; +use IO::Compress::Gzip::Constants 2.101 ; sub ExtraFieldError { @@ -36,11 +36,11 @@ sub validateExtraFieldPair return ExtraFieldError("SubField Data is a reference") if ref $pair->[1] ; - # ID is exactly two chars + # ID is exactly two chars return ExtraFieldError("SubField ID not two chars long") unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; - # Check that the 2nd byte of the ID isn't 0 + # Check that the 2nd byte of the ID isn't 0 return ExtraFieldError("SubField ID 2nd byte is 0x00") if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ; @@ -74,7 +74,7 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -84,8 +84,8 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + $subLen > $XLEN ; - my $bad = validateExtraFieldPair( [$id, - substr($data, $offset, $subLen)], + my $bad = validateExtraFieldPair( [$id, + substr($data, $offset, $subLen)], $strict, $gzipMode ); return $bad if $bad ; push @$extraRef, [$id => substr($data, $offset, $subLen)] @@ -94,7 +94,7 @@ sub parseRawExtra $offset += $subLen ; } - + return undef ; } @@ -111,7 +111,7 @@ sub findID return undef if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -126,7 +126,7 @@ sub findID $offset += $subLen ; } - + return undef ; } @@ -165,7 +165,7 @@ sub parseExtraField # $id2 => $data2, # ... # } - + if ( ! ref $dataRef ) { return undef @@ -177,7 +177,7 @@ sub parseExtraField my $data = $dataRef; my $out = '' ; - if (ref $data eq 'ARRAY') { + if (ref $data eq 'ARRAY') { if (ref $data->[0]) { foreach my $pair (@$data) { @@ -188,30 +188,30 @@ sub parseExtraField return $bad if $bad ; $out .= mkSubField(@$pair); - } - } + } + } else { return ExtraFieldError("Not even number of elements") unless @$data % 2 == 0; for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { my $bad = validateExtraFieldPair([$data->[$ix], - $data->[$ix+1]], + $data->[$ix+1]], $strict, $gzipMode) ; return $bad if $bad ; $out .= mkSubField($data->[$ix], $data->[$ix+1]); - } + } } - } - elsif (ref $data eq 'HASH') { + } + elsif (ref $data eq 'HASH') { while (my ($id, $info) = each %$data) { my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode); return $bad if $bad ; $out .= mkSubField($id, $info); - } - } + } + } else { return ExtraFieldError("Not a scalar, array ref or hash ref") ; } |