diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO')
38 files changed, 1265 insertions, 989 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") ; } diff --git a/Master/tlpkg/tlperl/lib/IO/Dir.pm b/Master/tlpkg/tlperl/lib/IO/Dir.pm index 3a14ca8983b..3cfd5f3b480 100644 --- a/Master/tlpkg/tlperl/lib/IO/Dir.pm +++ b/Master/tlpkg/tlperl/lib/IO/Dir.pm @@ -18,7 +18,7 @@ use File::stat; use File::Spec; our @ISA = qw(Tie::Hash Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.46"; our @EXPORT_OK = qw(DIR_UNLINK); diff --git a/Master/tlpkg/tlperl/lib/IO/File.pm b/Master/tlpkg/tlperl/lib/IO/File.pm index cf51d9bf636..e2accf7d2af 100644 --- a/Master/tlpkg/tlperl/lib/IO/File.pm +++ b/Master/tlpkg/tlperl/lib/IO/File.pm @@ -135,7 +135,7 @@ require Exporter; our @ISA = qw(IO::Handle IO::Seekable Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.46"; our @EXPORT = @IO::Seekable::EXPORT; diff --git a/Master/tlpkg/tlperl/lib/IO/Handle.pm b/Master/tlpkg/tlperl/lib/IO/Handle.pm index 45b6d4f5200..2010bb831ed 100644 --- a/Master/tlpkg/tlperl/lib/IO/Handle.pm +++ b/Master/tlpkg/tlperl/lib/IO/Handle.pm @@ -270,7 +270,7 @@ use IO (); # Load the XS module require Exporter; our @ISA = qw(Exporter); -our $VERSION = "1.42"; +our $VERSION = "1.46"; our @EXPORT_OK = qw( autoflush diff --git a/Master/tlpkg/tlperl/lib/IO/Pipe.pm b/Master/tlpkg/tlperl/lib/IO/Pipe.pm index c3ceb862336..7b195ca6439 100644 --- a/Master/tlpkg/tlperl/lib/IO/Pipe.pm +++ b/Master/tlpkg/tlperl/lib/IO/Pipe.pm @@ -13,7 +13,7 @@ use strict; use Carp; use Symbol; -our $VERSION = "1.41"; +our $VERSION = "1.46"; sub new { my $type = shift; diff --git a/Master/tlpkg/tlperl/lib/IO/Poll.pm b/Master/tlpkg/tlperl/lib/IO/Poll.pm index 3fe0179626f..20f630bb736 100644 --- a/Master/tlpkg/tlperl/lib/IO/Poll.pm +++ b/Master/tlpkg/tlperl/lib/IO/Poll.pm @@ -12,7 +12,7 @@ use IO::Handle; use Exporter (); our @ISA = qw(Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.46"; our @EXPORT = qw( POLLIN POLLOUT diff --git a/Master/tlpkg/tlperl/lib/IO/Seekable.pm b/Master/tlpkg/tlperl/lib/IO/Seekable.pm index 2370dcb89a0..5d44d7af070 100644 --- a/Master/tlpkg/tlperl/lib/IO/Seekable.pm +++ b/Master/tlpkg/tlperl/lib/IO/Seekable.pm @@ -106,7 +106,7 @@ require Exporter; our @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END); our @ISA = qw(Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.46"; sub seek { @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)'; diff --git a/Master/tlpkg/tlperl/lib/IO/Select.pm b/Master/tlpkg/tlperl/lib/IO/Select.pm index 35a47ccbe05..fe07f3b2e66 100644 --- a/Master/tlpkg/tlperl/lib/IO/Select.pm +++ b/Master/tlpkg/tlperl/lib/IO/Select.pm @@ -10,7 +10,7 @@ use strict; use warnings::register; require Exporter; -our $VERSION = "1.42"; +our $VERSION = "1.46"; our @ISA = qw(Exporter); # This is only so we can do version checking diff --git a/Master/tlpkg/tlperl/lib/IO/Socket.pm b/Master/tlpkg/tlperl/lib/IO/Socket.pm index f10ac375328..b7cdf06d3a5 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket.pm @@ -23,10 +23,12 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); our @ISA = qw(IO::Handle); -our $VERSION = "1.43"; +our $VERSION = "1.46"; our @EXPORT_OK = qw(sockatmark); +our $errstr; + sub import { my $pkg = shift; if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast @@ -120,7 +122,7 @@ sub connect { if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { require IO::Select; - my $sel = new IO::Select $sock; + my $sel = IO::Select->new( $sock ); undef $!; my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout); @@ -132,11 +134,11 @@ sub connect { # set we now emulate the behavior in Linux # - Karthik Rajagopalan $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); - $@ = "connect: $err"; + $errstr = $@ = "connect: $err"; } elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); - $@ = "connect: timeout"; + $errstr = $@ = "connect: timeout"; } elsif (!connect($sock,$addr) && not ($!{EISCONN} || ($^O eq 'MSWin32' && @@ -147,12 +149,12 @@ sub connect { # Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or # EINVAL (22) (5.19.4 onwards). $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) { $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } @@ -243,10 +245,10 @@ sub accept { if(defined $timeout) { require IO::Select; - my $sel = new IO::Select $sock; + my $sel = IO::Select->new( $sock ); unless ($sel->can_read($timeout)) { - $@ = 'accept: timeout'; + $errstr = $@ = 'accept: timeout'; $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); return; } @@ -530,6 +532,18 @@ by default, be either C<AF_INET> or C<AF_UNIX>. Other domains can be used if a proper subclass for the domain family is registered. All other arguments will be passed to the C<configuration> method of the package for that domain. +If the constructor fails it will return C<undef> and set the C<$errstr> package +variable to contain an error message. + + $sock = IO::Socket->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; + +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket->new(...) + or die "Cannot create socket - $@\n"; + =head1 METHODS C<IO::Socket> inherits all methods from L<IO::Handle> and implements the @@ -832,7 +846,7 @@ Let's create a TCP server on C<localhost:3333>. LocalPort => 3333, ReusePort => 1, Listen => 5, - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Waiting on 3333"; while (1) { @@ -873,7 +887,7 @@ A client for such a server could be proto => 'tcp', PeerPort => 3333, PeerHost => '0.0.0.0', - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Sending Hello World!"; my $size = $client->send("Hello World!"); diff --git a/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm b/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm index 8688f375b5f..5b76c2e3f59 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm @@ -14,7 +14,7 @@ use Exporter; use Errno; our @ISA = qw(IO::Socket); -our $VERSION = "1.41"; +our $VERSION = "1.46"; my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; @@ -79,7 +79,7 @@ sub _sock_info { if(defined $proto && $proto =~ /\D/) { my $num = _get_proto_number($proto); unless (defined $num) { - $@ = "Bad protocol '$proto'"; + $IO::Socket::errstr = $@ = "Bad protocol '$proto'"; return; } $proto = $num; @@ -94,7 +94,7 @@ sub _sock_info { $port = $serv[2] || $defport || $pnum; unless (defined $port) { - $@ = "Bad service '$origport'"; + $IO::Socket::errstr = $@ = "Bad service '$origport'"; return; } @@ -113,7 +113,7 @@ sub _error { { local($!); my $title = ref($sock).": "; - $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); + $IO::Socket::errstr = $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); $sock->close() if(defined fileno($sock)); } @@ -404,14 +404,19 @@ Examples: Proto => udp, LocalAddr => 'localhost', Broadcast => 1 ) - or die "Can't bind : $@\n"; + or die "Can't bind : $IO::Socket::errstr\n"; -B<NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE> +If the constructor fails it will return C<undef> and set the +C<$IO::Socket::errstr> package variable to contain an error message. -As of VERSION 1.18 all IO::Socket objects have autoflush turned on -by default. This was not the case with earlier releases. + $sock = IO::Socket::INET->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; -B<NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE> +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket::INET->new(...) + or die "Cannot create socket - $@\n"; =back diff --git a/Master/tlpkg/tlperl/lib/IO/Socket/IP.pm b/Master/tlpkg/tlperl/lib/IO/Socket/IP.pm index 5a5ee7d204a..3158ef55ab6 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket/IP.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket/IP.pm @@ -1,17 +1,20 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk +# (C) Paul Evans, 2010-2020 -- leonerd@leonerd.org.uk package IO::Socket::IP; + +use v5; +use strict; +use warnings; + # $VERSION needs to be set before use base 'IO::Socket' # - https://rt.cpan.org/Ticket/Display.html?id=92107 BEGIN { - $VERSION = '0.39'; + our $VERSION = '0.41'; } -use strict; -use warnings; use base qw( IO::Socket ); use Carp; @@ -96,11 +99,10 @@ falling back to IPv4-only on systems which don't. =head1 REPLACING C<IO::Socket> DEFAULT BEHAVIOUR -By placing C<-register> in the import list, L<IO::Socket> uses -C<IO::Socket::IP> rather than C<IO::Socket::INET> as the class that handles -C<PF_INET>. C<IO::Socket> will also use C<IO::Socket::IP> rather than -C<IO::Socket::INET6> to handle C<PF_INET6>, provided that the C<AF_INET6> -constant is available. +By placing C<-register> in the import list to C<IO::Socket::IP>, it will +register itself with L<IO::Socket> as the class that handles C<PF_INET>. It +will also ask to handle C<PF_INET6> as well, provided that constant is +available. Changing C<IO::Socket>'s default behaviour means that calling the C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the @@ -167,7 +169,9 @@ sub import =cut -=head2 $sock = IO::Socket::IP->new( %args ) +=head2 new + + $sock = IO::Socket::IP->new( %args ) Creates a new C<IO::Socket::IP> object, containing a newly created socket handle according to the named arguments passed. The recognised arguments are: @@ -353,7 +357,9 @@ If the constructor fails, it will set C<$@> to an appropriate error message; this may be from C<$!> or it may be some other string; not every failure necessarily has an associated C<errno> value. -=head2 $sock = IO::Socket::IP->new( $peeraddr ) +=head2 new (one arg) + + $sock = IO::Socket::IP->new( $peeraddr ) As a special case, if the constructor is passed a single argument (as opposed to an even-sized list of key/value pairs), it is taken to be the value @@ -817,7 +823,9 @@ sub _unpack_sockaddr } } -=head2 ( $host, $service ) = $sock->sockhost_service( $numeric ) +=head2 sockhost_service + + ( $host, $service ) = $sock->sockhost_service( $numeric ) Returns the hostname and service name of the local address (that is, the socket address given by the C<sockname> method). @@ -840,19 +848,27 @@ sub sockhost_service $self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 ); } -=head2 $addr = $sock->sockhost +=head2 sockhost + + $addr = $sock->sockhost Return the numeric form of the local address as a textual representation -=head2 $port = $sock->sockport +=head2 sockport + + $port = $sock->sockport Return the numeric form of the local port number -=head2 $host = $sock->sockhostname +=head2 sockhostname + + $host = $sock->sockhostname Return the resolved name of the local address -=head2 $service = $sock->sockservice +=head2 sockservice + + $service = $sock->sockservice Return the resolved name of the local port number @@ -864,7 +880,9 @@ sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sock sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] } sub sockservice { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] } -=head2 $addr = $sock->sockaddr +=head2 sockaddr + + $addr = $sock->sockaddr Return the local address as a binary octet string @@ -872,7 +890,9 @@ Return the local address as a binary octet string sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname } -=head2 ( $host, $service ) = $sock->peerhost_service( $numeric ) +=head2 peerhost_service + + ( $host, $service ) = $sock->peerhost_service( $numeric ) Returns the hostname and service name of the peer address (that is, the socket address given by the C<peername> method), similar to the @@ -893,19 +913,27 @@ sub peerhost_service $self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 ); } -=head2 $addr = $sock->peerhost +=head2 peerhost + + $addr = $sock->peerhost Return the numeric form of the peer address as a textual representation -=head2 $port = $sock->peerport +=head2 peerport + + $port = $sock->peerport Return the numeric form of the peer port number -=head2 $host = $sock->peerhostname +=head2 peerhostname + + $host = $sock->peerhostname Return the resolved name of the peer address -=head2 $service = $sock->peerservice +=head2 peerservice + + $service = $sock->peerservice Return the resolved name of the peer port number @@ -917,7 +945,9 @@ sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peer sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] } sub peerservice { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] } -=head2 $addr = $peer->peeraddr +=head2 peeraddr + + $addr = $peer->peeraddr Return the peer address as a binary octet string @@ -967,7 +997,9 @@ BEGIN { } } -=head2 $inet = $sock->as_inet +=head2 as_inet + + $inet = $sock->as_inet Returns a new L<IO::Socket::INET> instance wrapping the same filehandle. This may be useful in cases where it is required, for backward-compatibility, to @@ -1089,7 +1121,9 @@ If the C<...Host> argument is in this special form and the corresponding C<...Service> or C<...Port> argument is also defined, the one parsed from the C<...Host> argument will take precedence and the other will be ignored. -=head2 ( $host, $port ) = IO::Socket::IP->split_addr( $addr ) +=head2 split_addr + + ( $host, $port ) = IO::Socket::IP->split_addr( $addr ) Utility method that provides the parsing functionality described above. Returns a 2-element list, containing either the split hostname and port @@ -1125,7 +1159,9 @@ sub split_addr return ( $addr, undef ); } -=head2 $addr = IO::Socket::IP->join_addr( $host, $port ) +=head2 join_addr + + $addr = IO::Socket::IP->join_addr( $host, $port ) Utility method that performs the reverse of C<split_addr>, returning a string formed by joining the specified host address and port number. The host address diff --git a/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm b/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm index 04b36eaf74b..a93456c052a 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm @@ -11,7 +11,7 @@ use IO::Socket; use Carp; our @ISA = qw(IO::Socket); -our $VERSION = "1.41"; +our $VERSION = "1.46"; IO::Socket::UNIX->register_domain( AF_UNIX ); @@ -30,6 +30,10 @@ sub configure { $sock->socket(AF_UNIX, $type, 0) or return undef; + if(exists $arg->{Blocking}) { + $sock->blocking($arg->{Blocking}) or + return undef; + } if(exists $arg->{Local}) { my $addr = sockaddr_un($arg->{Local}); $sock->bind($addr) or @@ -123,6 +127,18 @@ be a C<Peer> specification. If the C<Listen> argument is given, but false, the queue size will be set to 5. +If the constructor fails it will return C<undef> and set the +C<$IO::Socket::errstr> package variable to contain an error message. + + $sock = IO::Socket::UNIX->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; + +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket::UNIX->new(...) + or die "Cannot create socket - $@\n"; + =back =head1 METHODS diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm index 3fc176e5006..29641251057 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,19 +4,19 @@ 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, @ISA); -$VERSION = '2.093'; +$VERSION = '2.102'; sub mkUncompObject { my $small = shift || 0; my $verbosity = shift || 0; - my ($inflate, $status) = new Compress::Raw::Bunzip2(1, 1, $small, $verbosity, 1); + my ($inflate, $status) = Compress::Raw::Bunzip2->new(1, 1, $small, $verbosity, 1); return (undef, "Could not create Inflation object: $status", $status) if $status != BZ_OK ; @@ -26,8 +26,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -48,7 +48,7 @@ sub uncompr return STATUS_ERROR; } - + return STATUS_OK if $status == BZ_OK ; return STATUS_ENDSTREAM if $status == BZ_STREAM_END ; return STATUS_ERROR ; @@ -59,12 +59,12 @@ sub reset { my $self = shift ; - my ($inf, $status) = new Compress::Raw::Bunzip2(); + my ($inf, $status) = Compress::Raw::Bunzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Inflate object: $status"; + $self->{Error} = "Cannot create Inflate object: $status"; return STATUS_ERROR; } @@ -100,8 +100,8 @@ sub adler32 sub sync { my $self = shift ; - #( $self->{Inf}->inflateSync(@_) == BZ_OK) - # ? STATUS_OK + #( $self->{Inf}->inflateSync(@_) == BZ_OK) + # ? STATUS_OK # : STATUS_ERROR ; } @@ -109,4 +109,3 @@ sub sync 1; __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm index c8622a59137..4fedcae46af 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,14 +4,14 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status); +use IO::Compress::Base::Common 2.101 qw(:Status); use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.093'; +$VERSION = '2.102'; -use Compress::Raw::Zlib 2.093 (); +use Compress::Raw::Zlib 2.101 (); sub mkUncompObject { @@ -21,7 +21,7 @@ sub mkUncompObject my $crc32 = 1; #shift ; my $adler32 = shift; - bless { 'CompSize' => new U64 , # 0, + bless { 'CompSize' => U64->new(), # 0, 'UnCompSize' => 0, 'wantCRC32' => $crc32, 'CRC32' => Compress::Raw::Zlib::crc32(''), @@ -70,7 +70,7 @@ sub uncompr $ind = $len - 1 ; } } - + if ($ind >= 0) { $remainder = substr($$in, $ind) ; substr($$in, $ind) = '' ; @@ -94,7 +94,7 @@ sub uncompr $l1 = U64::newUnpack_V32(substr($remainder, 8)); $l2 = U64::newUnpack_V32(substr($remainder, 12)); } - + my $newLen = $self->{CompSize}->clone(); $newLen->add(length $$in); if ($l1->equal($l2) && $l1->equal($newLen) ) { @@ -142,7 +142,7 @@ sub reset $self->{CompSize}->reset(); $self->{UnCompSize} = 0; $self->{CRC32} = Compress::Raw::Zlib::crc32(''); - $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); + $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); return STATUS_OK ; } diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm index a27af5ba8e7..315b0c32ce5 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status); -use Compress::Raw::Zlib 2.093 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common 2.101 qw(:Status); +use Compress::Raw::Zlib 2.101 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); -$VERSION = '2.093'; +$VERSION = '2.102'; @@ -23,23 +23,23 @@ sub mkUncompObject if ($scan) { - ($inflate, $status) = new Compress::Raw::Zlib::InflateScan + ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new( #LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } else { - ($inflate, $status) = new Compress::Raw::Zlib::Inflate + ($inflate, $status) = Compress::Raw::Zlib::Inflate->new( AppendOutput => 1, LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } - return (undef, "Could not create Inflation object: $status", $status) + return (undef, "Could not create Inflation object: $status", $status) if $status != Z_OK ; return bless {'Inf' => $inflate, @@ -47,8 +47,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -67,7 +67,7 @@ sub uncompr $self->{Error} = "Inflation Error: $status"; return STATUS_ERROR; } - + return STATUS_OK if $status == Z_BUF_ERROR ; # ??? return STATUS_OK if $status == Z_OK ; return STATUS_ENDSTREAM if $status == Z_STREAM_END ; @@ -115,8 +115,8 @@ sub adler32 sub sync { my $self = shift ; - ( $self->{Inf}->inflateSync(@_) == Z_OK) - ? STATUS_OK + ( $self->{Inf}->inflateSync(@_) == Z_OK) + ? STATUS_OK : STATUS_ERROR ; } @@ -154,4 +154,3 @@ sub createDeflateStream __END__ - diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm index 6172737e26e..6de82bae878 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm @@ -6,27 +6,27 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 (); +use IO::Compress::Base::Common 2.101 qw(:Parse); -use IO::Uncompress::Adapter::Inflate 2.093 (); +use IO::Uncompress::Adapter::Inflate 2.101 (); -use IO::Uncompress::Base 2.093 ; -use IO::Uncompress::Gunzip 2.093 ; -use IO::Uncompress::Inflate 2.093 ; -use IO::Uncompress::RawInflate 2.093 ; -use IO::Uncompress::Unzip 2.093 ; +use IO::Uncompress::Base 2.101 ; +use IO::Uncompress::Gunzip 2.101 ; +use IO::Uncompress::Inflate 2.101 ; +use IO::Uncompress::RawInflate 2.101 ; +use IO::Uncompress::Unzip 2.101 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.093'; +$VERSION = '2.102'; $AnyInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyInflateError anyinflate ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -48,7 +48,6 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.093 qw(:Parse); return ( 'rawinflate' => [Parse_boolean, 0] ) ; } @@ -75,9 +74,9 @@ sub mkUncomp if ! defined $obj; *$self->{Uncomp} = $obj; - + my @possible = qw( Inflate Gunzip Unzip ); - unshift @possible, 'RawInflate' + unshift @possible, 'RawInflate' if 1 || $got->getValue('rawinflate'); my $magic = $self->ckMagic( @possible ); @@ -113,7 +112,7 @@ sub ckMagic $self->pushBack(*$self->{HeaderPending}) ; *$self->{HeaderPending} = '' ; - } + } bless $self => $keep; return undef; @@ -135,7 +134,7 @@ IO::Uncompress::AnyInflate - Uncompress zlib-based (zip, gzip) file/buffer my $status = anyinflate $input => $output [,OPTS] or die "anyinflate failed: $AnyInflateError\n"; - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "anyinflate failed: $AnyInflateError\n"; $status = $z->read($buffer) @@ -444,7 +443,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.Compressed" + my $input = IO::File->new( "<file1.txt.Compressed" ) or die "Cannot open 'file1.txt.Compressed': $!\n" ; my $buffer ; anyinflate $input => \$buffer @@ -479,7 +478,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyInflate is shown below - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n"; Returns an C<IO::Uncompress::AnyInflate> object on success and undef on failure. @@ -941,7 +940,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::AnyInflate at present. +No symbolic constants are required by IO::Uncompress::AnyInflate at present. =over 5 @@ -962,7 +961,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>. @@ -999,8 +998,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/Uncompress/AnyUncompress.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm index 251b7cf2632..c922220ac2c 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm @@ -4,21 +4,21 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 (); +use IO::Compress::Base::Common 2.101 (); -use IO::Uncompress::Base 2.093 ; +use IO::Uncompress::Base 2.101 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.093'; +$VERSION = '2.102'; $AnyUncompressError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -33,26 +33,26 @@ BEGIN # Don't trigger any __DIE__ Hooks. local $SIG{__DIE__}; - eval ' use IO::Uncompress::Adapter::Inflate 2.093 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.093 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.093 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.093 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.093 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.093 ;'; - eval ' use IO::Uncompress::Adapter::UnZstd 2.083 ;'; - eval ' use IO::Uncompress::Adapter::UnLzip 2.093 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.093 ;'; - eval ' use IO::Uncompress::UnLzop 2.093 ;'; - eval ' use IO::Uncompress::Gunzip 2.093 ;'; - eval ' use IO::Uncompress::Inflate 2.093 ;'; - eval ' use IO::Uncompress::RawInflate 2.093 ;'; - eval ' use IO::Uncompress::Unzip 2.093 ;'; - eval ' use IO::Uncompress::UnLzf 2.093 ;'; - eval ' use IO::Uncompress::UnLzma 2.093 ;'; - eval ' use IO::Uncompress::UnXz 2.093 ;'; - eval ' use IO::Uncompress::UnZstd 2.093 ;'; - eval ' use IO::Uncompress::UnLzip 2.093 ;'; + eval ' use IO::Uncompress::Adapter::Inflate 2.101 ;'; + eval ' use IO::Uncompress::Adapter::Bunzip2 2.101 ;'; + eval ' use IO::Uncompress::Adapter::LZO 2.101 ;'; + eval ' use IO::Uncompress::Adapter::Lzf 2.101 ;'; + eval ' use IO::Uncompress::Adapter::UnLzma 2.101 ;'; + eval ' use IO::Uncompress::Adapter::UnXz 2.101 ;'; + eval ' use IO::Uncompress::Adapter::UnZstd 2.101 ;'; + eval ' use IO::Uncompress::Adapter::UnLzip 2.101 ;'; + + eval ' use IO::Uncompress::Bunzip2 2.101 ;'; + eval ' use IO::Uncompress::UnLzop 2.101 ;'; + eval ' use IO::Uncompress::Gunzip 2.101 ;'; + eval ' use IO::Uncompress::Inflate 2.101 ;'; + eval ' use IO::Uncompress::RawInflate 2.101 ;'; + eval ' use IO::Uncompress::Unzip 2.101 ;'; + eval ' use IO::Uncompress::UnLzf 2.101 ;'; + eval ' use IO::Uncompress::UnLzma 2.101 ;'; + eval ' use IO::Uncompress::UnXz 2.101 ;'; + eval ' use IO::Uncompress::UnZstd 2.101 ;'; + eval ' use IO::Uncompress::UnLzip 2.101 ;'; } @@ -70,7 +70,7 @@ sub anyuncompress } sub getExtraParams -{ +{ return ( 'rawinflate' => [IO::Compress::Base::Common::Parse_boolean, 0] , 'unlzma' => [IO::Compress::Base::Common::Parse_boolean, 0] ) ; } @@ -103,13 +103,13 @@ sub mkUncomp if ! defined $obj; *$self->{Uncomp} = $obj; - + my @possible = qw( Inflate Gunzip Unzip ); - unshift @possible, 'RawInflate' + unshift @possible, 'RawInflate' if $got->getValue('rawinflate'); $magic = $self->ckMagic( @possible ); - + if ($magic) { *$self->{Info} = $self->readHeader($magic) or return undef ; @@ -126,9 +126,9 @@ sub mkUncomp if ! defined $obj; *$self->{Uncomp} = $obj; - + my @possible = qw( UnLzma ); - #unshift @possible, 'RawInflate' + #unshift @possible, 'RawInflate' # if $got->getValue('rawinflate'); if ( *$self->{Info} = $self->ckMagic( @possible )) @@ -206,7 +206,7 @@ sub mkUncomp *$self->{Info} = $self->readHeader($magic) or return undef ; - my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Zstd::mkUncompObject(); + my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnZstd::mkUncompObject(); return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; @@ -257,7 +257,7 @@ sub ckMagic $self->pushBack(*$self->{HeaderPending}) ; *$self->{HeaderPending} = '' ; - } + } bless $self => $keep; return undef; @@ -270,7 +270,7 @@ __END__ =head1 NAME -IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, xz, lzma, lzip, lzf or lzop file/buffer +IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, zstd, xz, lzma, lzip, lzf or lzop file/buffer =head1 SYNOPSIS @@ -279,7 +279,7 @@ IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, xz, lzma, lzip, lzf my $status = anyuncompress $input => $output [,OPTS] or die "anyuncompress failed: $AnyUncompressError\n"; - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "anyuncompress failed: $AnyUncompressError\n"; $status = $z->read($buffer) @@ -333,6 +333,8 @@ The formats supported are: =item zip +=item zstd (Zstandard) + =item bzip2 =item lzop @@ -598,7 +600,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ; use IO::File ; - my $input = new IO::File "<file1.txt.Compressed" + my $input = IO::File->new( "<file1.txt.Compressed" ) or die "Cannot open 'file1.txt.Compressed': $!\n" ; my $buffer ; anyuncompress $input => \$buffer @@ -633,7 +635,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyUncompress is shown below - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "IO::Uncompress::AnyUncompress failed: $AnyUncompressError\n"; Returns an C<IO::Uncompress::AnyUncompress> object on success and undef on failure. @@ -1034,7 +1036,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::AnyUncompress at present. +No symbolic constants are required by IO::Uncompress::AnyUncompress at present. =over 5 @@ -1051,7 +1053,7 @@ Same as doing this =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>. @@ -1075,8 +1077,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/Uncompress/Base.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm index b9901ca1fff..31a34eb3f05 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm @@ -9,12 +9,12 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(IO::File Exporter); -$VERSION = '2.093'; +$VERSION = '2.102'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.093 ; +use IO::Compress::Base::Common 2.101 ; use IO::File ; use Symbol; @@ -58,7 +58,7 @@ sub smartRead if (defined *$self->{FH}) { if ($offset) { - # Not using this + # Not using this # # *$self->{FH}->read($$out, $get_size, $offset); # @@ -75,7 +75,7 @@ sub smartRead elsif (defined *$self->{InputEvent}) { my $got = 1 ; while (length $$out < $size) { - last + last if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0; } @@ -93,13 +93,13 @@ sub smartRead substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size); if (*$self->{ConsumeInput}) { substr($$buf, 0, $get_size) = '' } - else + else { *$self->{BufferOffset} += length($$out) - $offset } } - *$self->{InputLengthRemaining} -= length($$out) #- $offset + *$self->{InputLengthRemaining} -= length($$out) #- $offset if defined *$self->{InputLength}; - + if (! defined $status) { $self->saveStatus($!) ; return STATUS_ERROR; @@ -169,7 +169,7 @@ sub smartTell if (defined *$self->{FH}) { return *$self->{FH}->tell() } - else + else { return *$self->{BufferOffset} } } @@ -179,7 +179,7 @@ sub smartWrite my $out_data = shift ; if (defined *$self->{FH}) { - # flush needed for 5.8.0 + # flush needed for 5.8.0 defined *$self->{FH}->write($out_data, length $out_data) && defined *$self->{FH}->flush() ; } @@ -199,7 +199,7 @@ sub smartReadExact sub smartEof { my ($self) = $_[0]; - local $.; + local $.; return 0 if length *$self->{Prime} || *$self->{PushMode}; @@ -207,15 +207,15 @@ sub smartEof { # Could use # - # *$self->{FH}->eof() + # *$self->{FH}->eof() # # here, but this can cause trouble if # the filehandle is itself a tied handle, but it uses sysread. - # Then we get into mixing buffered & non-buffered IO, + # Then we get into mixing buffered & non-buffered IO, # which will cause trouble my $info = $self->getErrInfo(); - + my $buffer = ''; my $status = $self->smartRead(\$buffer, 1); $self->pushBack($buffer) if length $buffer; @@ -225,7 +225,7 @@ sub smartEof } elsif (defined *$self->{InputEvent}) { *$self->{EventEof} } - else + else { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) } } @@ -347,7 +347,7 @@ sub checkParams my $class = shift ; my $got = shift || IO::Compress::Base::Parameters::new(); - + my $Valid = { 'blocksize' => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024], 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -362,7 +362,7 @@ sub checkParams #'decode' => [IO::Compress::Base::Common::Parse_any, undef], #'consumeinput' => [IO::Compress::Base::Common::Parse_boolean, 0], - + $self->getExtraParams(), #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0, @@ -371,11 +371,11 @@ sub checkParams $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef] if *$self->{OneShot} ; - - $got->parse($Valid, @_ ) + + $got->parse($Valid, @_ ) or $self->croakError("${class}: " . $got->getError()) ; - $self->postCheckParams($got) + $self->postCheckParams($got) or $self->croakError("${class}: " . $self->error()) ; return $got; @@ -403,7 +403,7 @@ sub _create my $inType = whatIsInput($inValue, 1); - $obj->ckInputParam($class, $inValue, 1) + $obj->ckInputParam($class, $inValue, 1) or return undef ; *$obj->{InNew} = 1; @@ -412,8 +412,8 @@ sub _create or $obj->croakError("${class}: " . *$obj->{Error}); if ($inType eq 'buffer' || $inType eq 'code') { - *$obj->{Buffer} = $inValue ; - *$obj->{InputEvent} = $inValue + *$obj->{Buffer} = $inValue ; + *$obj->{InputEvent} = $inValue if $inType eq 'code' ; } else { @@ -422,18 +422,18 @@ sub _create *$obj->{Handle} = 1 ; # Need to rewind for Scan - *$obj->{FH}->seek(0, SEEK_SET) + *$obj->{FH}->seek(0, SEEK_SET) if $got->getValue('scan'); - } - else { + } + else { no warnings ; my $mode = '<'; $mode = '+<' if $got->getValue('scan'); *$obj->{StdIO} = ($inValue eq '-'); - *$obj->{FH} = new IO::File "$mode $inValue" + *$obj->{FH} = IO::File->new( "$mode $inValue" ) or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ; } - + *$obj->{LineNo} = $. = 0; setBinModeInput(*$obj->{FH}) ; @@ -441,7 +441,7 @@ sub _create *$obj->{Buffer} = \$buff ; } -# if ($got->getValue('decode')) { +# if ($got->getValue('decode')) { # my $want_encoding = $got->getValue('decode'); # *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding); # } @@ -449,7 +449,7 @@ sub _create # *$obj->{Encoding} = undef; # } - *$obj->{InputLength} = $got->parsed('inputlength') + *$obj->{InputLength} = $got->parsed('inputlength') ? $got->getValue('inputlength') : undef ; *$obj->{InputLengthRemaining} = $got->getValue('inputlength'); @@ -465,7 +465,7 @@ sub _create # TODO - move these two into RawDeflate *$obj->{Scan} = $got->getValue('scan'); - *$obj->{ParseExtra} = $got->getValue('parseextra') + *$obj->{ParseExtra} = $got->getValue('parseextra') || $got->getValue('strict') ; *$obj->{Type} = ''; *$obj->{Prime} = $got->getValue('prime') || '' ; @@ -473,8 +473,8 @@ sub _create *$obj->{Plain} = 0; *$obj->{PlainBytesRead} = 0; *$obj->{InflatedBytesRead} = 0; - *$obj->{UnCompSize} = new U64; - *$obj->{CompSize} = new U64; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; *$obj->{TotalInflatedBytesRead} = 0; *$obj->{NewStream} = 0 ; *$obj->{EventEof} = 0 ; @@ -494,19 +494,19 @@ sub _create *$obj->{InNew} = 0; *$obj->{Closed} = 0; - - return $obj + + return $obj if *$obj->{Pause} ; if ($status) { # Need to try uncompressing to catch the case # where the compressed file uncompresses to an # empty string - so eof is set immediately. - + my $out_buffer = ''; $status = $obj->read(\$out_buffer); - + if ($status < 0) { *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ]; } @@ -515,7 +515,7 @@ sub _create if length $out_buffer; } else { - return undef + return undef unless *$obj->{Transparent}; $obj->clearError(); @@ -549,7 +549,7 @@ sub ckInputParam # # if ($_[0] ne '-' && ! -e $_[0] ) # { -# return $self->saveErrorString(1, +# return $self->saveErrorString(1, # "input file '$_[0]' does not exist", STATUS_ERROR); # } # } @@ -573,13 +573,13 @@ sub _inf 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}; *$obj->{OneShot} = 1 ; - + my $got = $obj->checkParams($name, undef, @_) or return undef ; @@ -589,25 +589,25 @@ sub _inf # warn "TD $value "; # #$value = $$value; ## warn "TD $value $$value "; -# +# # return retErr($obj, "Parameter 'TrailingData' not writable") -# if readonly $$value ; +# if readonly $$value ; # -# if (ref $$value) +# if (ref $$value) # { # return retErr($obj,"Parameter 'TrailingData' not a scalar reference") # if ref $$value ne 'SCALAR' ; -# +# # *$obj->{TrailingData} = $$value ; # } -# else +# else # { # return retErr($obj,"Parameter 'TrailingData' not a scalar") -# if ref $value ne 'SCALAR' ; +# if ref $value ne 'SCALAR' ; # # *$obj->{TrailingData} = $value ; # } - + *$obj->{TrailingData} = $got->getValue('trailingdata'); } @@ -620,7 +620,7 @@ sub _inf # { # while (my($k, $v) = each %$input) # { -# $v = \$input->{$k} +# $v = \$input->{$k} # unless defined $v ; # # $obj->_singleTarget($x, $k, $v, @_) @@ -629,7 +629,7 @@ sub _inf # # return keys %$input ; # } - + if ($x->{GlobMap}) { $x->{oneInput} = 1 ; @@ -645,11 +645,11 @@ sub _inf if (! $x->{oneOutput} ) { - my $inFile = ($x->{inType} eq 'filenames' + my $inFile = ($x->{inType} eq 'filenames' || $x->{inType} eq 'filename'); $x->{inType} = $inFile ? 'filename' : 'buffer'; - + foreach my $in ($x->{oneInput} ? $input : @$input) { my $out ; @@ -684,7 +684,7 @@ sub _singleTarget my $x = shift ; my $input = shift; my $output = shift; - + my $buff = ''; $x->{buff} = \$buff ; @@ -693,7 +693,7 @@ sub _singleTarget my $mode = '>' ; $mode = '>>' if $x->{Got}->getValue('append') ; - $x->{fh} = new IO::File "$mode $output" + $x->{fh} = IO::File->new( "$mode $output" ) or return retErr($x, "cannot open file '$output': $!") ; binmode $x->{fh} ; @@ -708,10 +708,10 @@ sub _singleTarget } } - + elsif ($x->{outType} eq 'buffer' ) { - $$output = '' + $$output = '' unless $x->{Got}->getValue('append'); $x->{buff} = $output ; } @@ -719,22 +719,22 @@ sub _singleTarget if ($x->{oneInput}) { defined $self->_rd2($x, $input, $output) - or return undef; + or return undef; } else { for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) { - defined $self->_rd2($x, $element, $output) + defined $self->_rd2($x, $element, $output) or return undef ; } } - if ( ($x->{outType} eq 'filename' && $output ne '-') || + if ( ($x->{outType} eq 'filename' && $output ne '-') || ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) { - $x->{fh}->close() - or return retErr($x, $!); + $x->{fh}->close() + or return retErr($x, $!); delete $x->{fh}; } @@ -747,15 +747,15 @@ sub _rd2 my $x = shift ; my $input = shift; my $output = shift; - + my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error}); - + $z->_create($x->{Got}, 1, $input, @_) or return undef ; my $status ; my $fh = $x->{fh}; - + while (1) { while (($status = $z->read($x->{buff})) > 0) { @@ -770,9 +770,9 @@ sub _rd2 if (! $x->{oneOutput} ) { my $ot = $x->{outType} ; - if ($ot eq 'array') + if ($ot eq 'array') { push @$output, $x->{buff} } - elsif ($ot eq 'hash') + elsif ($ot eq 'hash') { $output->{$input} = $x->{buff} } my $buff = ''; @@ -781,12 +781,12 @@ sub _rd2 last if $status < 0 || $z->smartEof(); - last + last unless *$self->{MultiStream}; $status = $z->nextStream(); - last + last unless $status == 1 ; } @@ -796,7 +796,7 @@ sub _rd2 ${ *$self->{TrailingData} } = $z->trailingData() if defined *$self->{TrailingData} ; - $z->close() + $z->close() or return undef ; return 1 ; @@ -808,7 +808,7 @@ sub TIEHANDLE die "OOPS\n" ; } - + sub UNTIE { my $self = shift ; @@ -836,7 +836,7 @@ sub readBlock $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} ); *$self->{CompressedInputLengthRemaining} -= $size ; } - + my $status = $self->smartRead($buff, $size) ; return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!) if $status == STATUS_ERROR ; @@ -861,7 +861,7 @@ sub _raw_read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; return G_EOF if *$self->{Closed} ; @@ -873,8 +873,8 @@ sub _raw_read if (*$self->{Plain}) { my $tmp_buff ; my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ; - - return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) + + return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) if $len == STATUS_ERROR ; if ($len == 0 ) { @@ -898,13 +898,13 @@ sub _raw_read $$buffer .= *$self->{Pending} ; my $len = length *$self->{Pending} ; *$self->{Pending} = ''; - return $len; + return $len; } my $temp_buf = ''; my $outSize = 0; my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ; - + return G_ERR if $status == STATUS_ERROR ; @@ -915,18 +915,18 @@ sub _raw_read $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer, defined *$self->{CompressedInputLengthDone} || $self->smartEof(), $outSize); - + # Remember the input buffer if it wasn't consumed completely $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput}; return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo}) - if $self->saveStatus($status) == STATUS_ERROR; + if $self->saveStatus($status) == STATUS_ERROR; $self->postBlockChk($buffer, $before_len) == STATUS_OK or return G_ERR; $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0; - + *$self->{CompSize}->add($beforeC_len - length $temp_buf) ; *$self->{InflatedBytesRead} += $buf_len ; @@ -960,7 +960,7 @@ sub _raw_read or return G_ERR; } else { - return $self->TrailerError("trailer truncated. Expected " . + return $self->TrailerError("trailer truncated. Expected " . "$trailer_size bytes, got $got") if *$self->{Strict}; $self->pushBack($trailer) ; @@ -978,7 +978,7 @@ sub _raw_read } } - + # return the number of uncompressed bytes read return $buf_len ; @@ -1029,7 +1029,7 @@ sub gotoNextStream # TODO - make this more efficient if know the offset for the end of # the stream and seekable - $status = $self->read($buffer) + $status = $self->read($buffer) while $status > 0 ; return $status @@ -1074,7 +1074,7 @@ sub gotoNextStream push @{ *$self->{InfoList} }, *$self->{Info} ; - return 1; + return 1; } sub streamCount @@ -1090,7 +1090,7 @@ sub read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; if (defined *$self->{ReadStatus} ) { @@ -1123,7 +1123,7 @@ sub read my $offset = $_[2] || 0; if (! *$self->{AppendOutput}) { - if (! $offset) { + if (! $offset) { $$buffer = '' ; } @@ -1161,13 +1161,13 @@ sub read } else { my $len = 0; - $len = $self->_raw_read($buffer) + $len = $self->_raw_read($buffer) while ! *$self->{EndStream} && $len == 0 ; return $len ; } } - # Need to jump through more hoops - either length or offset + # Need to jump through more hoops - either length or offset # or both are specified. my $out_buffer = *$self->{Pending} ; *$self->{Pending} = ''; @@ -1176,17 +1176,17 @@ sub read while (! *$self->{EndStream} && length($out_buffer) < $length) { my $buf_len = $self->_raw_read(\$out_buffer); - return $buf_len + return $buf_len if $buf_len < 0 ; } - $length = length $out_buffer + $length = length $out_buffer if length($out_buffer) < $length ; - return 0 + return 0 if $length == 0 ; - $$buffer = '' + $$buffer = '' if ! defined $$buffer; $offset = length $$buffer @@ -1223,7 +1223,7 @@ sub _getline # Paragraph Mode if ( ! length $/ ) { - my $paragraph ; + my $paragraph ; while (($status = $self->read($paragraph)) > 0 ) { if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; @@ -1236,13 +1236,13 @@ sub _getline # $/ isn't empty, or a reference, so it's Line Mode. { - my $line ; + my $line ; my $p = \*$self->{Pending} ; while (($status = $self->read($line)) > 0 ) { my $offset = index($line, $/); if ($offset >= 0) { my $l = substr($line, 0, $offset + length $/ ); - substr($line, 0, $offset + length $/) = ''; + substr($line, 0, $offset + length $/) = ''; $$p = $line; return (1, \$l); } @@ -1262,7 +1262,7 @@ sub getline return undef; } - return undef + return undef if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ; my $current_append = *$self->{AppendOutput} ; @@ -1271,7 +1271,7 @@ sub getline my ($status, $lineref) = $self->_getline(); *$self->{AppendOutput} = $current_append; - return undef + return undef if $status < 0 || length $$lineref == 0 ; $. = ++ *$self->{LineNo} ; @@ -1282,10 +1282,10 @@ sub getline sub getlines { my $self = shift; - $self->croakError(*$self->{ClassName} . + $self->croakError(*$self->{ClassName} . "::getlines: called in scalar context\n") unless wantarray; my($line, @lines); - push(@lines, $line) + push(@lines, $line) while defined($line = $self->getline); return @lines; } @@ -1307,8 +1307,8 @@ sub getc sub ungetc { my $self = shift; - *$self->{Pending} = "" unless defined *$self->{Pending} ; - *$self->{Pending} = $_[0] . *$self->{Pending} ; + *$self->{Pending} = "" unless defined *$self->{Pending} ; + *$self->{Pending} = $_[0] . *$self->{Pending} ; } @@ -1332,7 +1332,7 @@ sub eof my $self = shift ; return (*$self->{Closed} || - (!length *$self->{Pending} + (!length *$self->{Pending} && ( $self->smartEof() || *$self->{EndStream}))) ; } @@ -1362,14 +1362,14 @@ sub close return 1 if *$self->{Closed} ; - untie *$self + untie *$self if $] >= 5.008 ; my $status = 1 ; if (defined *$self->{FH}) { if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { - local $.; + local $.; $! = 0 ; $status = *$self->{FH}->close(); return $self->saveErrorString(0, $!, $!) @@ -1449,8 +1449,8 @@ sub seek sub fileno { my $self = shift ; - return defined *$self->{FH} - ? fileno *$self->{FH} + return defined *$self->{FH} + ? fileno *$self->{FH} : undef ; } @@ -1458,8 +1458,8 @@ sub binmode { 1; # my $self = shift ; -# return defined *$self->{FH} -# ? binmode *$self->{FH} +# return defined *$self->{FH} +# ? binmode *$self->{FH} # : 1 ; } @@ -1472,8 +1472,8 @@ sub opened sub autoflush { my $self = shift ; - return defined *$self->{FH} - ? *$self->{FH}->autoflush(@_) + return defined *$self->{FH} + ? *$self->{FH}->autoflush(@_) : undef ; } @@ -1485,33 +1485,35 @@ sub input_line_number return $last; } - -*BINMODE = \&binmode; -*SEEK = \&seek; -*READ = \&read; -*sysread = \&read; -*TELL = \&tell; -*EOF = \&eof; - -*FILENO = \&fileno; -*CLOSE = \&close; - sub _notAvailable { my $name = shift ; return sub { croak "$name Not Available: File opened only for intput" ; } ; } - -*print = _notAvailable('print'); -*PRINT = _notAvailable('print'); -*printf = _notAvailable('printf'); -*PRINTF = _notAvailable('printf'); -*write = _notAvailable('write'); -*WRITE = _notAvailable('write'); - -#*sysread = \&read; -#*syswrite = \&_notAvailable; +{ + no warnings 'once'; + + *BINMODE = \&binmode; + *SEEK = \&seek; + *READ = \&read; + *sysread = \&read; + *TELL = \&tell; + *EOF = \&eof; + + *FILENO = \&fileno; + *CLOSE = \&close; + + *print = _notAvailable('print'); + *PRINT = _notAvailable('print'); + *printf = _notAvailable('printf'); + *PRINTF = _notAvailable('printf'); + *write = _notAvailable('write'); + *WRITE = _notAvailable('write'); + + #*sysread = \&read; + #*syswrite = \&_notAvailable; +} @@ -1536,7 +1538,7 @@ purpose is to be sub-classed by IO::Uncompress 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>. @@ -1560,8 +1562,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/Uncompress/Bunzip2.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm index 8e805d4c9e2..38fff645a3f 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ 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 IO::Uncompress::Base 2.093 ; -use IO::Uncompress::Adapter::Bunzip2 2.093 ; +use IO::Uncompress::Base 2.101 ; +use IO::Uncompress::Adapter::Bunzip2 2.101 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error); -$VERSION = '2.093'; +$VERSION = '2.102'; $Bunzip2Error = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -72,7 +72,7 @@ sub mkUncomp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + *$self->{Uncomp} = $obj; return 1; @@ -88,15 +88,15 @@ sub ckMagic $self->smartReadExact(\$magic, 4); *$self->{HeaderPending} = $magic ; - - return $self->HeaderError("Header size is " . - 4 . " bytes") + + return $self->HeaderError("Header size is " . + 4 . " bytes") if length $magic != 4; return $self->HeaderError("Bad Magic.") if ! isBzip2Magic($magic) ; - - + + *$self->{Type} = 'bzip2'; return $magic; } @@ -117,7 +117,7 @@ sub readHeader 'TrailerLength' => 0, 'Header' => '$magic' }; - + } sub chkTrailer @@ -149,7 +149,7 @@ IO::Uncompress::Bunzip2 - Read bzip2 files/buffers my $status = bunzip2 $input => $output [,OPTS] or die "bunzip2 failed: $Bunzip2Error\n"; - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "bunzip2 failed: $Bunzip2Error\n"; $status = $z->read($buffer) @@ -440,7 +440,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ; use IO::File ; - my $input = new IO::File "<file1.txt.bz2" + my $input = IO::File->new( "<file1.txt.bz2" ) or die "Cannot open 'file1.txt.bz2': $!\n" ; my $buffer ; bunzip2 $input => \$buffer @@ -475,7 +475,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Bunzip2 is shown below - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "IO::Uncompress::Bunzip2 failed: $Bunzip2Error\n"; Returns an C<IO::Uncompress::Bunzip2> object on success and undef on failure. @@ -858,7 +858,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::Bunzip2 at present. +No symbolic constants are required by IO::Uncompress::Bunzip2 at present. =over 5 @@ -879,7 +879,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>. @@ -907,8 +907,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/Uncompress/Gunzip.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm index 6e57e961184..54757132a62 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm @@ -9,12 +9,12 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.093 ; +use IO::Uncompress::RawInflate 2.101 ; -use Compress::Raw::Zlib 2.093 () ; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Compress::Gzip::Constants 2.093 ; -use IO::Compress::Zlib::Extra 2.093 ; +use Compress::Raw::Zlib 2.101 () ; +use IO::Compress::Base::Common 2.101 qw(:Status ); +use IO::Compress::Gzip::Constants 2.101 ; +use IO::Compress::Zlib::Extra 2.101 ; require Exporter ; @@ -28,7 +28,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.093'; +$VERSION = '2.102'; sub new { @@ -70,9 +70,9 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") if ! isGzipMagic($magic) ; @@ -95,10 +95,10 @@ sub chkTrailer my $self = shift; my $trailer = shift; - # Check CRC & ISIZE + # Check CRC & ISIZE my ($CRC32, $ISIZE) = unpack("V V", $trailer) ; - *$self->{Info}{CRC32} = $CRC32; - *$self->{Info}{ISIZE} = $ISIZE; + *$self->{Info}{CRC32} = $CRC32; + *$self->{Info}{ISIZE} = $ISIZE; if (*$self->{Strict}) { return $self->TrailerError("CRC mismatch") @@ -130,9 +130,9 @@ sub _readFullGzipHeader($) *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") @@ -150,7 +150,7 @@ sub _readGzipHeader($) my ($buffer) = '' ; $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE) - or return $self->HeaderError("Minimum header size is " . + or return $self->HeaderError("Minimum header size is " . GZIP_MIN_HEADER_SIZE . " bytes") ; my $keep = $magic . $buffer ; @@ -159,22 +159,22 @@ sub _readGzipHeader($) # now split out the various parts my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ; - $cm == GZIP_CM_DEFLATED + $cm == GZIP_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; # check for use of reserved bits return $self->HeaderError("Use of Reserved Bits in FLG field.") - if $flag & GZIP_FLG_RESERVED ; + if $flag & GZIP_FLG_RESERVED ; my $EXTRA ; my @EXTRA = () ; if ($flag & GZIP_FLG_FEXTRA) { $EXTRA = "" ; - $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) + $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) or return $self->TruncatedHeader("FEXTRA Length") ; my ($XLEN) = unpack("v", $buffer) ; - $self->smartReadExact(\$EXTRA, $XLEN) + $self->smartReadExact(\$EXTRA, $XLEN) or return $self->TruncatedHeader("FEXTRA Body"); $keep .= $buffer . $EXTRA ; @@ -190,10 +190,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FNAME) { $origname = "" ; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FNAME"); last if $buffer eq GZIP_NULL_BYTE ; - $origname .= $buffer + $origname .= $buffer } $keep .= $origname . GZIP_NULL_BYTE ; @@ -205,10 +205,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FCOMMENT) { $comment = ""; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FCOMMENT"); last if $buffer eq GZIP_NULL_BYTE ; - $comment .= $buffer + $comment .= $buffer } $keep .= $comment . GZIP_NULL_BYTE ; @@ -217,7 +217,7 @@ sub _readGzipHeader($) } if ($flag & GZIP_FLG_FHCRC) { - $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) + $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) or return $self->TruncatedHeader("FHCRC"); $HeaderCRC = unpack("v", $buffer) ; @@ -254,7 +254,7 @@ sub _readGzipHeader($) 'Comment' => $comment, 'Time' => $mtime, 'OsID' => $os, - 'OsName' => defined $GZIP_OS_Names{$os} + 'OsName' => defined $GZIP_OS_Names{$os} ? $GZIP_OS_Names{$os} : "Unknown", 'HeaderCRC' => $HeaderCRC, 'Flags' => $flag, @@ -286,7 +286,7 @@ IO::Uncompress::Gunzip - Read RFC 1952 files/buffers my $status = gunzip $input => $output [,OPTS] or die "gunzip failed: $GunzipError\n"; - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "gunzip failed: $GunzipError\n"; $status = $z->read($buffer) @@ -579,7 +579,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; use IO::File ; - my $input = new IO::File "<file1.txt.gz" + my $input = IO::File->new( "<file1.txt.gz" ) or die "Cannot open 'file1.txt.gz': $!\n" ; my $buffer ; gunzip $input => \$buffer @@ -614,7 +614,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Gunzip is shown below - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "IO::Uncompress::Gunzip failed: $GunzipError\n"; Returns an C<IO::Uncompress::Gunzip> object on success and undef on failure. @@ -1064,7 +1064,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::Gunzip at present. +No symbolic constants are required by IO::Uncompress::Gunzip at present. =over 5 @@ -1085,7 +1085,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>. @@ -1122,8 +1122,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/Uncompress/Inflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm index 993a1dddc89..26d2e38acaf 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Compress::Zlib::Constants 2.093 ; +use IO::Compress::Base::Common 2.101 qw(:Status ); +use IO::Compress::Zlib::Constants 2.101 ; -use IO::Uncompress::RawInflate 2.093 ; +use IO::Uncompress::RawInflate 2.101 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.093'; +$VERSION = '2.102'; $InflateError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -62,14 +62,14 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Header size is " . - ZLIB_HEADER_SIZE . " bytes") + return $self->HeaderError("Header size is " . + ZLIB_HEADER_SIZE . " bytes") if length $magic != ZLIB_HEADER_SIZE; #return $self->HeaderError("CRC mismatch.") return undef if ! $self->isZlibMagic($magic) ; - + *$self->{Type} = 'rfc1950'; return $magic; } @@ -88,7 +88,7 @@ sub chkTrailer my $trailer = shift; my $ADLER32 = unpack("N", $trailer) ; - *$self->{Info}{ADLER32} = $ADLER32; + *$self->{Info}{ADLER32} = $ADLER32; return $self->TrailerError("CRC mismatch") if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ; @@ -102,7 +102,7 @@ sub isZlibMagic my $self = shift; my $buffer = shift ; - return 0 + return 0 if length $buffer < ZLIB_HEADER_SIZE ; my $hdr = unpack("n", $buffer) ; @@ -114,16 +114,16 @@ sub isZlibMagic my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; # Only Deflate supported - return $self->HeaderError("Not Deflate (CM is $cm)") + return $self->HeaderError("Not Deflate (CM is $cm)") if $cm != ZLIB_CMF_CM_DEFLATED ; # Max window value is 7 for Deflate. my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ; - return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . - " (CINFO is $cinfo)") + return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . + " (CINFO is $cinfo)") if $cinfo > ZLIB_CMF_CINFO_MAX ; - return 1; + return 1; } sub bits @@ -145,19 +145,19 @@ sub _readDeflateHeader # # *$self->{HeaderPending} = $buffer ; # -# return $self->HeaderError("Header size is " . -# ZLIB_HEADER_SIZE . " bytes") +# return $self->HeaderError("Header size is " . +# ZLIB_HEADER_SIZE . " bytes") # if length $buffer != ZLIB_HEADER_SIZE; # # return $self->HeaderError("CRC mismatch.") # if ! isZlibMagic($buffer) ; # } - + my ($CMF, $FLG) = unpack "C C", $buffer; my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS ), my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; - $cm == ZLIB_CMF_CM_DEFLATED + $cm == ZLIB_CMF_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; my $DICTID; @@ -208,7 +208,7 @@ IO::Uncompress::Inflate - Read RFC 1950 files/buffers my $status = inflate $input => $output [,OPTS] or die "inflate failed: $InflateError\n"; - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "inflate failed: $InflateError\n"; $status = $z->read($buffer) @@ -501,7 +501,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Inflate qw(inflate $InflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.1950" + my $input = IO::File->new( "<file1.txt.1950" ) or die "Cannot open 'file1.txt.1950': $!\n" ; my $buffer ; inflate $input => \$buffer @@ -536,7 +536,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Inflate is shown below - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "IO::Uncompress::Inflate failed: $InflateError\n"; Returns an C<IO::Uncompress::Inflate> object on success and undef on failure. @@ -936,7 +936,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::Inflate at present. +No symbolic constants are required by IO::Uncompress::Inflate at present. =over 5 @@ -957,7 +957,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>. @@ -994,8 +994,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/Uncompress/RawInflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm index 2fa318816ac..5d7d2e02588 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.093 ; -use IO::Compress::Base::Common 2.093 qw(:Status ); +use Compress::Raw::Zlib 2.101 ; +use IO::Compress::Base::Common 2.101 qw(:Status ); -use IO::Uncompress::Base 2.093 ; -use IO::Uncompress::Adapter::Inflate 2.093 ; +use IO::Uncompress::Base 2.101 ; +use IO::Uncompress::Adapter::Inflate 2.101 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.093'; +$VERSION = '2.102'; $RawInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -25,16 +25,16 @@ push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); #{ -# # Execute at runtime +# # Execute at runtime # my %bad; # for my $module (qw(Compress::Raw::Zlib IO::Compress::Base::Common IO::Uncompress::Base IO::Uncompress::Adapter::Inflate)) # { # my $ver = ${ $module . "::VERSION"} ; -# +# # $bad{$module} = $ver # if $ver ne $VERSION; # } -# +# # if (keys %bad) # { # my $string = join "\n", map { "$_ $bad{$_}" } keys %bad; @@ -148,14 +148,14 @@ sub _isRawx my $buffer = ''; - $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 + $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 or return $self->saveErrorString(undef, "No data to read"); my $temp_buf = $magic . $buffer ; - *$self->{HeaderPending} = $temp_buf ; + *$self->{HeaderPending} = $temp_buf ; $buffer = ''; my $status = *$self->{Uncomp}->uncompr(\$temp_buf, \$buffer, $self->smartEof()) ; - + return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR) if $status == STATUS_ERROR; @@ -163,12 +163,12 @@ sub _isRawx return $self->saveErrorString(undef, "unexpected end of file", STATUS_ERROR) if $self->smartEof() && $status != STATUS_ENDSTREAM; - + #my $buf_len = *$self->{Uncomp}->uncompressedBytes(); my $buf_len = length $buffer; if ($status == STATUS_ENDSTREAM) { - if (*$self->{MultiStream} + if (*$self->{MultiStream} && (length $temp_buf || ! $self->smartEof())){ *$self->{NewStream} = 1 ; *$self->{EndStream} = 0 ; @@ -177,9 +177,9 @@ sub _isRawx *$self->{EndStream} = 1 ; } } - *$self->{HeaderPending} = $buffer ; - *$self->{InflatedBytesRead} = $buf_len ; - *$self->{TotalInflatedBytesRead} += $buf_len ; + *$self->{HeaderPending} = $buffer ; + *$self->{InflatedBytesRead} = $buf_len ; + *$self->{TotalInflatedBytesRead} += $buf_len ; *$self->{Type} = 'rfc1951'; $self->saveStatus(STATUS_OK); @@ -229,7 +229,7 @@ sub inflateSync return $self->saveErrorString(0, "unexpected end of file", STATUS_ERROR); } } - + $status = *$self->{Uncomp}->sync($temp_buf) ; if ($status == STATUS_OK) @@ -251,23 +251,23 @@ sub inflateSync # my $status ; # my $end_offset = 0; # -# $status = $self->scan() +# $status = $self->scan() # #or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $self->errorNo) ; # or return $self->saveErrorString(G_ERR, "Error Scanning: $status") # -# $status = $self->zap($end_offset) +# $status = $self->zap($end_offset) # or return $self->saveErrorString(G_ERR, "Error Zapping: $status"); # #or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $self->errorNo) ; # # #(*$obj->{Deflate}, $status) = $inf->createDeflate(); # ## *$obj->{Header} = *$inf->{Info}{Header}; -## *$obj->{UnCompSize_32bit} = +## *$obj->{UnCompSize_32bit} = ## *$obj->{BytesWritten} = *$inf->{UnCompSize_32bit} ; ## *$obj->{CompSize_32bit} = *$inf->{CompSize_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} ; @@ -275,11 +275,11 @@ sub inflateSync ## *$obj->{FH}->flush() ; ## *$obj->{Handle} = 1 if $outType eq 'handle'; ## -## #seek(*$obj->{FH}, $end_offset, SEEK_SET) -## *$obj->{FH}->seek($end_offset, SEEK_SET) +## #seek(*$obj->{FH}, $end_offset, SEEK_SET) +## *$obj->{FH}->seek($end_offset, SEEK_SET) ## or return $obj->saveErrorString(undef, $!, $!) ; ## } -# +# #} sub scan @@ -292,7 +292,7 @@ sub scan my $buffer = '' ; my $len = 0; - $len = $self->_raw_read(\$buffer, 1) + $len = $self->_raw_read(\$buffer, 1) while ! *$self->{EndStream} && $len >= 0 ; #return $len if $len < 0 ? $len : 0 ; @@ -310,16 +310,16 @@ sub zap #printf "# block_offset $block_offset %x\n", $block_offset; my $byte ; ( $self->smartSeek($block_offset) && - $self->smartRead(\$byte, 1) ) - or return $self->saveErrorString(0, $!, $!); + $self->smartRead(\$byte, 1) ) + or return $self->saveErrorString(0, $!, $!); #printf "#byte is %x\n", unpack('C*',$byte); *$self->{Uncomp}->resetLastBlockByte($byte); #printf "#to byte is %x\n", unpack('C*',$byte); - ( $self->smartSeek($block_offset) && + ( $self->smartSeek($block_offset) && $self->smartWrite($byte) ) - or return $self->saveErrorString(0, $!, $!); + or return $self->saveErrorString(0, $!, $!); #$self->smartSeek($end_offset, 1); @@ -335,12 +335,12 @@ sub createDeflate -CRC32 => *$self->{Params}->getValue('crc32'), -ADLER32 => *$self->{Params}->getValue('adler32'), ); - - return wantarray ? ($status, $def) : $def ; + + return wantarray ? ($status, $def) : $def ; } -1; +1; __END__ @@ -356,7 +356,7 @@ IO::Uncompress::RawInflate - Read RFC 1951 files/buffers my $status = rawinflate $input => $output [,OPTS] or die "rawinflate failed: $RawInflateError\n"; - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "rawinflate failed: $RawInflateError\n"; $status = $z->read($buffer) @@ -646,7 +646,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.1951" + my $input = IO::File->new( "<file1.txt.1951" ) or die "Cannot open 'file1.txt.1951': $!\n" ; my $buffer ; rawinflate $input => \$buffer @@ -681,7 +681,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::RawInflate is shown below - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "IO::Uncompress::RawInflate failed: $RawInflateError\n"; Returns an C<IO::Uncompress::RawInflate> object on success and undef on failure. @@ -1064,7 +1064,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::RawInflate at present. +No symbolic constants are required by IO::Uncompress::RawInflate at present. =over 5 @@ -1085,7 +1085,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>. @@ -1122,8 +1122,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/Uncompress/Unzip.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm index 856487f8fcd..98fcea71a99 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm @@ -9,24 +9,28 @@ use warnings; use bytes; use IO::File; -use IO::Uncompress::RawInflate 2.093 ; -use IO::Compress::Base::Common 2.093 qw(:Status ); -use IO::Uncompress::Adapter::Inflate 2.093 ; -use IO::Uncompress::Adapter::Identity 2.093 ; -use IO::Compress::Zlib::Extra 2.093 ; -use IO::Compress::Zip::Constants 2.093 ; +use IO::Uncompress::RawInflate 2.101 ; +use IO::Compress::Base::Common 2.101 qw(:Status ); +use IO::Uncompress::Adapter::Inflate 2.101 ; +use IO::Uncompress::Adapter::Identity 2.101 ; +use IO::Compress::Zlib::Extra 2.101 ; +use IO::Compress::Zip::Constants 2.101 ; -use Compress::Raw::Zlib 2.093 () ; +use Compress::Raw::Zlib 2.101 () ; BEGIN { # Don't trigger any __DIE__ Hooks. local $SIG{__DIE__}; - + eval{ require IO::Uncompress::Adapter::Bunzip2 ; - import IO::Uncompress::Adapter::Bunzip2 } ; + IO::Uncompress::Adapter::Bunzip2->import() } ; eval{ require IO::Uncompress::Adapter::UnLzma ; - import IO::Uncompress::Adapter::UnLzma } ; + IO::Uncompress::Adapter::UnLzma->import() } ; + eval{ require IO::Uncompress::Adapter::UnXz ; + IO::Uncompress::Adapter::UnXz->import() } ; + eval{ require IO::Uncompress::Adapter::UnZstd ; + IO::Uncompress::Adapter::UnZstd->import() } ; } @@ -34,7 +38,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.093'; +$VERSION = '2.102'; $UnzipError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -52,6 +56,15 @@ Exporter::export_ok_tags('all'); ZIP64_DIGITAL_SIGNATURE_SIG, \&skipDigitalSignature, ); +my %MethodNames = ( + ZIP_CM_DEFLATE() => 'Deflated', + ZIP_CM_BZIP2() => 'Bzip2', + ZIP_CM_LZMA() => 'Lzma', + ZIP_CM_STORE() => 'Stored', + ZIP_CM_XZ() => 'Xz', + ZIP_CM_ZSTD() => 'Zstd', + ); + sub new { my $class = shift ; @@ -67,18 +80,18 @@ sub unzip sub getExtraParams { - + return ( # # Zip header fields 'name' => [IO::Compress::Base::Common::Parse_any, undef], 'stream' => [IO::Compress::Base::Common::Parse_boolean, 0], 'efs' => [IO::Compress::Base::Common::Parse_boolean, 0], - + # TODO - This means reading the central directory to get # 1. the local header offsets # 2. The compressed data length - ); + ); } sub ckParams @@ -119,9 +132,9 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - 4 . " bytes") - if length $magic != 4 ; + return $self->HeaderError("Minimum header size is " . + 4 . " bytes") + if length $magic != 4 ; return $self->HeaderError("Bad Magic") if ! _isZipMagic($magic) ; @@ -189,9 +202,9 @@ sub readHeader $status = *$self->{Uncomp}->uncompr(\$b, \$temp_buf, 0, $out); - return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, + return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo}) - if $self->saveStatus($status) == STATUS_ERROR; + if $self->saveStatus($status) == STATUS_ERROR; $self->pushBack($b) ; @@ -248,7 +261,7 @@ sub chkTrailer if $sig != ZIP_DATA_HDR_SIG; } else { - ($CRC32, $cSize, $uSize) = + ($CRC32, $cSize, $uSize) = (*$self->{ZipData}{Crc32}, *$self->{ZipData}{CompressedLen}, *$self->{ZipData}{UnCompressedLen}); @@ -334,7 +347,7 @@ sub skipCentralDirectory my $buffer; $self->smartReadExact(\$buffer, 46 - 4) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . 46 . " bytes") ; my $keep = $magic . $buffer ; @@ -348,7 +361,7 @@ sub skipCentralDirectory #my $crc32 = unpack ("V", substr($buffer, 16-4, 4)); my $compressedLength = unpack ("V", substr($buffer, 20-4, 4)); my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4)); - my $filename_length = unpack ("v", substr($buffer, 28-4, 2)); + my $filename_length = unpack ("v", substr($buffer, 28-4, 2)); my $extra_length = unpack ("v", substr($buffer, 30-4, 2)); my $comment_length = unpack ("v", substr($buffer, 32-4, 2)); #my $disk_start = unpack ("v", substr($buffer, 34-4, 2)); @@ -356,7 +369,7 @@ sub skipCentralDirectory #my $ext_file_attrib = unpack ("V", substr($buffer, 38-4, 2)); #my $lcl_hdr_offset = unpack ("V", substr($buffer, 42-4, 2)); - + my $filename; my $extraField; my $comment ; @@ -391,7 +404,7 @@ sub skipArchiveExtra my $buffer; $self->smartReadExact(\$buffer, 4) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . 4 . " bytes") ; my $keep = $magic . $buffer ; @@ -399,7 +412,7 @@ sub skipArchiveExtra my $size = unpack ("V", $buffer); $self->smartReadExact(\$buffer, $size) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . $size . " bytes") ; $keep .= $buffer ; @@ -416,7 +429,7 @@ sub skipCentralDirectory64Rec my $buffer; $self->smartReadExact(\$buffer, 8) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . 8 . " bytes") ; my $keep = $magic . $buffer ; @@ -425,7 +438,7 @@ sub skipCentralDirectory64Rec my $size = $sizeHi * U64::MAX32 + $sizeLo; $self->fastForward($size) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . $size . " bytes") ; #$keep .= $buffer ; @@ -450,7 +463,7 @@ sub skipCentralDirectory64Loc my $buffer; $self->smartReadExact(\$buffer, 20 - 4) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . 20 . " bytes") ; my $keep = $magic . $buffer ; @@ -471,7 +484,7 @@ sub skipEndCentralDirectory my $buffer; $self->smartReadExact(\$buffer, 22 - 4) - or return $self->TrailerError("Minimum header size is " . + or return $self->TrailerError("Minimum header size is " . 22 . " bytes") ; my $keep = $magic . $buffer ; @@ -485,7 +498,7 @@ sub skipEndCentralDirectory #my $offsetToCD = unpack ("V", substr($buffer, 16-4, 4)); my $comment_length = unpack ("v", substr($buffer, 20-4, 2)); - + my $comment ; if ($comment_length) { @@ -516,9 +529,9 @@ sub _readFullZipHeader($) *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - 30 . " bytes") - if length $magic != 4 ; + return $self->HeaderError("Minimum header size is " . + 30 . " bytes") + if length $magic != 4 ; return $self->HeaderError("Bad Magic") @@ -536,7 +549,7 @@ sub _readZipHeader($) my ($buffer) = '' ; $self->smartReadExact(\$buffer, 30 - 4) - or return $self->HeaderError("Minimum header size is " . + or return $self->HeaderError("Minimum header size is " . 30 . " bytes") ; my $keep = $magic . $buffer ; @@ -549,13 +562,19 @@ sub _readZipHeader($) my $crc32 = unpack ("V", substr($buffer, 14-4, 4)); my $compressedLength = U64::newUnpack_V32 substr($buffer, 18-4, 4); my $uncompressedLength = U64::newUnpack_V32 substr($buffer, 22-4, 4); - my $filename_length = unpack ("v", substr($buffer, 26-4, 2)); + my $filename_length = unpack ("v", substr($buffer, 26-4, 2)); my $extra_length = unpack ("v", substr($buffer, 28-4, 2)); my $filename; my $extraField; my @EXTRA = (); - my $streamingMode = ($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) ? 1 : 0 ; + + # Some programs (some versions of LibreOffice) mark entries as streamed, but still fill out + # compressedLength/uncompressedLength & crc32 in the local file header. + # The expected data descriptor is not populated. + # So only assume streaming if the Streaming bit is set AND the compressed length is zero + my $streamingMode = (($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) && $crc32 == 0) ? 1 : 0 ; + my $efs_flag = ($gpFlag & ZIP_GP_FLAG_LANGUAGE_ENCODING) ? 1 : 0; return $self->HeaderError("Encrypted content not supported") @@ -577,7 +596,7 @@ sub _readZipHeader($) require Encode; eval { $filename = Encode::decode_utf8($filename, 1) } or Carp::croak "Zip Filename not UTF-8" ; - } + } $keep .= $filename ; } @@ -601,7 +620,7 @@ sub _readZipHeader($) { $Extra{$_->[0]} = \$_->[1]; } - + if (defined $Extra{ZIP_EXTRA_ID_ZIP64()}) { $zip64 = 1 ; @@ -616,7 +635,7 @@ sub _readZipHeader($) my $offset = 0 ; if (U64::full32 $uncompressedLength->get32bit() ) { - $uncompressedLength + $uncompressedLength = U64::newUnpack_V64 substr($buff, 0, 8); $offset += 8 ; @@ -624,7 +643,7 @@ sub _readZipHeader($) if (U64::full32 $compressedLength->get32bit() ) { - $compressedLength + $compressedLength = U64::newUnpack_V64 substr($buff, $offset, 8); $offset += 8 ; @@ -657,18 +676,40 @@ sub _readZipHeader($) { return $self->HeaderError("Unsupported Compression format $compressedMethod") if ! defined $IO::Uncompress::Adapter::Bunzip2::VERSION ; - + *$self->{Type} = 'zip-bzip2'; - + my $obj = IO::Uncompress::Adapter::Bunzip2::mkUncompObject(); *$self->{Uncomp} = $obj; } + elsif ($compressedMethod == ZIP_CM_XZ) + { + return $self->HeaderError("Unsupported Compression format $compressedMethod") + if ! defined $IO::Uncompress::Adapter::UnXz::VERSION ; + + *$self->{Type} = 'zip-xz'; + + my $obj = IO::Uncompress::Adapter::UnXz::mkUncompObject(); + + *$self->{Uncomp} = $obj; + } + elsif ($compressedMethod == ZIP_CM_ZSTD) + { + return $self->HeaderError("Unsupported Compression format $compressedMethod") + if ! defined $IO::Uncompress::Adapter::UnZstd::VERSION ; + + *$self->{Type} = 'zip-zstd'; + + my $obj = IO::Uncompress::Adapter::UnZstd::mkUncompObject(); + + *$self->{Uncomp} = $obj; + } elsif ($compressedMethod == ZIP_CM_LZMA) { return $self->HeaderError("Unsupported Compression format $compressedMethod") if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ; - + *$self->{Type} = 'zip-lzma'; my $LzmaHeader; $self->smartReadExact(\$LzmaHeader, 4) @@ -695,7 +736,7 @@ sub _readZipHeader($) elsif ($compressedMethod == ZIP_CM_STORE) { *$self->{Type} = 'zip-stored'; - + my $obj = IO::Uncompress::Adapter::Identity::mkUncompObject($streamingMode, $zip64); @@ -724,15 +765,7 @@ sub _readZipHeader($) 'Stream' => $streamingMode, 'MethodID' => $compressedMethod, - 'MethodName' => $compressedMethod == ZIP_CM_DEFLATE - ? "Deflated" - : $compressedMethod == ZIP_CM_BZIP2 - ? "Bzip2" - : $compressedMethod == ZIP_CM_LZMA - ? "Lzma" - : $compressedMethod == ZIP_CM_STORE - ? "Stored" - : "Unknown" , + 'MethodName' => $MethodNames{$compressedMethod} || 'Unknown', # 'TextFlag' => $flag & GZIP_FLG_FTEXT ? 1 : 0, # 'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0, @@ -741,7 +774,7 @@ sub _readZipHeader($) # 'ExtraFlag' => $flag & GZIP_FLG_FEXTRA ? 1 : 0, # 'Comment' => $comment, # 'OsID' => $os, -# 'OsName' => defined $GZIP_OS_Names{$os} +# 'OsName' => defined $GZIP_OS_Names{$os} # ? $GZIP_OS_Names{$os} : "Unknown", # 'HeaderCRC' => $HeaderCRC, # 'Flags' => $flag, @@ -763,7 +796,7 @@ sub filterUncompressed else { *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}, $_[1]); } -} +} # from Archive::Zip & info-zip @@ -805,7 +838,7 @@ sub _dosToUnixTime # # # Now walk the Central Directory Records # my $buffer ; -# while ($self->smartReadExact(\$buffer, 46) && +# while ($self->smartReadExact(\$buffer, 46) && # unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { # # my $compressedLength = unpack ("V", substr($buffer, 20, 4)); @@ -813,7 +846,7 @@ sub _dosToUnixTime # my $extra_length = unpack ("v", substr($buffer, 30, 2)); # my $comment_length = unpack ("v", substr($buffer, 32, 2)); # -# $self->smarkSeek($filename_length + $extra_length + $comment_length, 0, SEEK_CUR) +# $self->smarkSeek($filename_length + $extra_length + $comment_length, 0, SEEK_CUR) # if $extra_length || $comment_length || $filename_length; # push @CD, $compressedLength ; # } @@ -833,7 +866,7 @@ sub _dosToUnixTime # my $buffer; # $self->smartReadExact(\$buffer, 22) ; # -# my $zip64 = 0; +# my $zip64 = 0; # my $centralDirOffset ; # if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { # $centralDirOffset = unpack ("V", substr($buffer, 16, 2)); @@ -864,7 +897,7 @@ sub skip else { $self->smartSeek($size, SEEK_CUR); } - + } @@ -888,7 +921,7 @@ sub scanCentralDirectory # Now walk the Central Directory Records my $buffer ; - while ($self->smartReadExact(\$buffer, 46) && + while ($self->smartReadExact(\$buffer, 46) && unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { my $compressedLength = unpack("V", substr($buffer, 20, 4)); @@ -899,11 +932,11 @@ sub scanCentralDirectory $self->skip($filename_length ) ; - my $v64 = new U64 $compressedLength ; + my $v64 = U64->new( $compressedLength ); if (U64::full32 $compressedLength ) { $self->smartReadExact(\$buffer, $extra_length) ; - die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer) + die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer) if length($buffer) != $extra_length; my $got = $self->get64Extra($buffer, U64::full32 $uncompressedLength); @@ -915,7 +948,7 @@ sub scanCentralDirectory } $self->skip($comment_length ) ; - + push @CD, $v64 ; } @@ -932,7 +965,7 @@ sub get64Extra my $is_uncomp = shift ; my $extra = IO::Compress::Zlib::Extra::findID(0x0001, $buffer); - + if (! defined $extra) { return undef; @@ -941,7 +974,7 @@ sub get64Extra { my $u64 = U64::newUnpack_V64(substr($extra, $is_uncomp ? 8 : 0)) ; return $u64; - } + } } sub offsetFromZip64 @@ -949,20 +982,20 @@ sub offsetFromZip64 my $self = shift ; my $here = shift; - $self->smartSeek($here - 20, 0, SEEK_SET) + $self->smartSeek($here - 20, 0, SEEK_SET) or die "xx $!" ; my $buffer; my $got = 0; - $self->smartReadExact(\$buffer, 20) + $self->smartReadExact(\$buffer, 20) or die "xxx $here $got $!" ; if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) { my $cd64 = U64::Value_VV64 substr($buffer, 8, 8); - + $self->smartSeek($cd64, 0, SEEK_SET) ; - $self->smartReadExact(\$buffer, 4) + $self->smartReadExact(\$buffer, 4) or die "xxx" ; if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) { @@ -977,7 +1010,7 @@ sub offsetFromZip64 return $cd64 ; } - + die "zzz"; } @@ -998,10 +1031,10 @@ sub findCentralDirectoryOffset my $here = $self->tell(); my $buffer; - $self->smartReadExact(\$buffer, 22) + $self->smartReadExact(\$buffer, 22) or die "xxx" ; - my $zip64 = 0; + my $zip64 = 0; my $centralDirOffset ; if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { $centralDirOffset = unpack("V", substr($buffer, 16, 4)); @@ -1019,7 +1052,7 @@ sub findCentralDirectoryOffset $seekTo = 0; $want = $fileLen ; } - $self->smartSeek( $seekTo, 0, SEEK_SET) + $self->smartSeek( $seekTo, 0, SEEK_SET) or die "xxx $!" ; my $got; $self->smartReadExact($buffer, $want) @@ -1060,7 +1093,7 @@ IO::Uncompress::Unzip - Read zip files/buffers my $status = unzip $input => $output [,OPTS] or die "unzip failed: $UnzipError\n"; - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "unzip failed: $UnzipError\n"; $status = $z->read($buffer) @@ -1105,6 +1138,39 @@ zlib files/buffers. For writing zip files/buffers, see the companion module IO::Compress::Zip. +The primary purpose of this module is to provide I<streaming> read access to +zip files and buffers. + +At present the following compression methods are supported by IO::Uncompress::Unzip + +=over 5 + +=item Store (0) + +=item Deflate (8) + +=item Bzip2 (12) + +To read Bzip2 content, the module C<IO::Uncompress::Bunzip2> must +be installed. + +=item Lzma (14) + +To read LZMA content, the module C<IO::Uncompress::UnLzma> must +be installed. + +=item Xz (95) + +To read Xz content, the module C<IO::Uncompress::UnXz> must +be installed. + +=item Zstandard (93) + +To read Zstandard content, the module C<IO::Uncompress::UnZstd> must +be installed. + +=back + =head1 Functional Interface A top-level function, C<unzip>, is provided to carry out @@ -1379,7 +1445,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Unzip qw(unzip $UnzipError) ; use IO::File ; - my $input = new IO::File "<file1.zip" + my $input = IO::File->new( "<file1.zip" ) or die "Cannot open 'file1.zip': $!\n" ; my $buffer ; unzip $input => \$buffer @@ -1391,7 +1457,7 @@ uncompressed data to a buffer, C<$buffer>. The format of the constructor for IO::Uncompress::Unzip is shown below - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "IO::Uncompress::Unzip failed: $UnzipError\n"; Returns an C<IO::Uncompress::Unzip> object on success and undef on failure. @@ -1449,7 +1515,7 @@ Open "membername" from the zip file for reading. =item C<< Efs => 0| 1 >> -When this option is set to true AND the zip archive being read has +When this option is set to true AND the zip archive being read has the "Language Encoding Flag" (EFS) set, the member name is assumed to be encoded in UTF-8. If the member name in the zip archive is not valid UTF-8 when this optionn is true, @@ -1797,7 +1863,7 @@ C<InputLength> option in the constructor. =head1 Importing -No symbolic constants are required by this IO::Uncompress::Unzip at present. +No symbolic constants are required by IO::Uncompress::Unzip at present. =over 5 @@ -1824,13 +1890,13 @@ stream at a time. use IO::Uncompress::Unzip qw($UnzipError); my $zipfile = "somefile.zip"; - my $u = new IO::Uncompress::Unzip $zipfile + my $u = IO::Uncompress::Unzip->new( $zipfile ) or die "Cannot open $zipfile: $UnzipError"; my $status; for ($status = 1; $status > 0; $status = $u->nextStream()) { - + my $name = $u->getHeaderInfo()->{Name}; warn "Processing member $name\n" ; @@ -1862,7 +1928,7 @@ The script is available from L<https://gist.github.com/eqhmcow/5389877> =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>. @@ -1899,8 +1965,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/Zlib.pm b/Master/tlpkg/tlperl/lib/IO/Zlib.pm index 55534b4f374..84aa5e428fd 100644 --- a/Master/tlpkg/tlperl/lib/IO/Zlib.pm +++ b/Master/tlpkg/tlperl/lib/IO/Zlib.pm @@ -6,8 +6,6 @@ package IO::Zlib; -$VERSION = "1.10"; - =head1 NAME IO::Zlib - IO:: style interface to L<Compress::Zlib> @@ -286,129 +284,170 @@ it and/or modify it under the same terms as Perl itself. require 5.006; use strict; -use vars qw($VERSION $AUTOLOAD @ISA); +use warnings; use Carp; use Fcntl qw(SEEK_SET); +use Symbol; +use Tie::Handle; + +our $VERSION = "1.11"; +our $AUTOLOAD; +our @ISA = qw(Tie::Handle); my $has_Compress_Zlib; +my $gzip_external; +my $gzip_used; +my $gzip_read_open = "gzip -dc %s |"; +my $gzip_write_open = "| gzip > %s"; my $aliased; -sub has_Compress_Zlib { - $has_Compress_Zlib; -} - BEGIN { eval { require Compress::Zlib }; $has_Compress_Zlib = $@ || $Compress::Zlib::VERSION < 2.000 ? 0 : 1; } -use Symbol; -use Tie::Handle; - -# These might use some $^O logic. -my $gzip_read_open = "gzip -dc %s |"; -my $gzip_write_open = "| gzip > %s"; - -my $gzip_external; -my $gzip_used; +sub has_Compress_Zlib +{ + $has_Compress_Zlib; +} -sub gzip_read_open { - $gzip_read_open; +sub gzip_external +{ + $gzip_external; } -sub gzip_write_open { - $gzip_write_open; +sub gzip_used +{ + $gzip_used; } -sub gzip_external { - $gzip_external; +sub gzip_read_open +{ + $gzip_read_open; } -sub gzip_used { - $gzip_used; +sub gzip_write_open +{ + $gzip_write_open; } -sub can_gunzip { +sub can_gunzip +{ $has_Compress_Zlib || $gzip_external; } -sub _import { +sub _import +{ my $import = shift; - while (@_) { - if ($_[0] eq ':gzip_external') { - shift; - if (@_) { - $gzip_external = shift; - } else { - croak "$import: ':gzip_external' requires an argument"; - } - } - elsif ($_[0] eq ':gzip_read_open') { - shift; - if (@_) { - $gzip_read_open = shift; - croak "$import: ':gzip_read_open' '$gzip_read_open' is illegal" - unless $gzip_read_open =~ /^.+%s.+\|\s*$/; - } else { - croak "$import: ':gzip_read_open' requires an argument"; - } - } - elsif ($_[0] eq ':gzip_write_open') { - shift; - if (@_) { - $gzip_write_open = shift; - croak "$import: ':gzip_write_open' '$gzip_read_open' is illegal" - unless $gzip_write_open =~ /^\s*\|.+%s.*$/; - } else { - croak "$import: ':gzip_write_open' requires an argument"; - } - } - else { - last; - } + + while (@_) + { + if ($_[0] eq ':gzip_external') + { + shift; + + if (@_) + { + $gzip_external = shift; + } + else + { + croak "$import: ':gzip_external' requires an argument"; + } + } + elsif ($_[0] eq ':gzip_read_open') + { + shift; + + if (@_) + { + $gzip_read_open = shift; + + croak "$import: ':gzip_read_open' '$gzip_read_open' is illegal" + unless $gzip_read_open =~ /^.+%s.+\|\s*$/; + } + else + { + croak "$import: ':gzip_read_open' requires an argument"; + } + } + elsif ($_[0] eq ':gzip_write_open') + { + shift; + + if (@_) + { + $gzip_write_open = shift; + + croak "$import: ':gzip_write_open' '$gzip_read_open' is illegal" + unless $gzip_write_open =~ /^\s*\|.+%s.*$/; + } + else + { + croak "$import: ':gzip_write_open' requires an argument"; + } + } + else + { + last; + } } + return @_; } -sub _alias { +sub _alias +{ my $import = shift; - if ((!$has_Compress_Zlib && !defined $gzip_external) || $gzip_external) { - # The undef *gzopen is really needed only during - # testing where we eval several 'use IO::Zlib's. - undef *gzopen; - *gzopen = \&gzopen_external; - *IO::Handle::gzread = \&gzread_external; - *IO::Handle::gzwrite = \&gzwrite_external; + + if ($gzip_external || (!$has_Compress_Zlib && !defined($gzip_external))) + { + require IO::Handle; + + undef *gzopen; + *gzopen = \&gzopen_external; + + *IO::Handle::gzread = \&gzread_external; + *IO::Handle::gzwrite = \&gzwrite_external; *IO::Handle::gzreadline = \&gzreadline_external; - *IO::Handle::gzeof = \&gzeof_external; - *IO::Handle::gzclose = \&gzclose_external; - $gzip_used = 1; - } else { - croak "$import: no Compress::Zlib and no external gzip" - unless $has_Compress_Zlib; - *gzopen = \&Compress::Zlib::gzopen; - *gzread = \&Compress::Zlib::gzread; - *gzwrite = \&Compress::Zlib::gzwrite; + *IO::Handle::gzeof = \&gzeof_external; + *IO::Handle::gzclose = \&gzclose_external; + + $gzip_used = 1; + } + elsif ($has_Compress_Zlib) + { + *gzopen = \&Compress::Zlib::gzopen; + *gzread = \&Compress::Zlib::gzread; + *gzwrite = \&Compress::Zlib::gzwrite; *gzreadline = \&Compress::Zlib::gzreadline; - *gzeof = \&Compress::Zlib::gzeof; + *gzeof = \&Compress::Zlib::gzeof; + } + else + { + croak "$import: no Compress::Zlib and no external gzip"; } + $aliased = 1; } -sub import { - shift; +sub import +{ + my $class = shift; my $import = "IO::Zlib::import"; - if (@_) { - if (_import($import, @_)) { - croak "$import: '@_' is illegal"; - } + + if (@_) + { + if (_import($import, @_)) + { + croak "$import: '@_' is illegal"; + } } + _alias($import); } -@ISA = qw(Tie::Handle); - sub TIEHANDLE { my $class = shift; @@ -537,7 +576,7 @@ sub getlines my $self = shift; croak "IO::Zlib::getlines: must be called in list context" - unless wantarray; + unless wantarray; return tied(*{$self})->READLINE(); } @@ -559,89 +598,138 @@ sub AUTOLOAD return tied(*{$self})->$AUTOLOAD(@_); } -sub gzopen_external { - my ($filename, $mode) = @_; - require IO::Handle; +sub gzopen_external +{ + my $filename = shift; + my $mode = shift; my $fh = IO::Handle->new(); - if ($mode =~ /r/) { - # Because someone will try to read ungzipped files - # with this we peek and verify the signature. Yes, - # this means that we open the file twice (if it is - # gzipped). - # Plenty of race conditions exist in this code, but - # the alternative would be to capture the stderr of - # gzip and parse it, which would be a portability nightmare. - if (-e $filename && open($fh, $filename)) { - binmode $fh; - my $sig; - my $rdb = read($fh, $sig, 2); - if ($rdb == 2 && $sig eq "\x1F\x8B") { - my $ropen = sprintf $gzip_read_open, $filename; - if (open($fh, $ropen)) { - binmode $fh; - return $fh; - } else { - return undef; - } - } - seek($fh, 0, SEEK_SET) or - die "IO::Zlib: open('$filename', 'r'): seek: $!"; - return $fh; - } else { - return undef; - } - } elsif ($mode =~ /w/) { - my $level = ''; - $level = "-$1" if $mode =~ /([1-9])/; - # To maximize portability we would need to open - # two filehandles here, one for "| gzip $level" - # and another for "> $filename", and then when - # writing copy bytes from the first to the second. - # We are using IO::Handle objects for now, however, - # and they can only contain one stream at a time. - my $wopen = sprintf $gzip_write_open, $filename; - if (open($fh, $wopen)) { - $fh->autoflush(1); - binmode $fh; - return $fh; - } else { - return undef; - } - } else { - croak "IO::Zlib::gzopen_external: mode '$mode' is illegal"; + + if ($mode =~ /r/) + { + # Because someone will try to read ungzipped files + # with this we peek and verify the signature. Yes, + # this means that we open the file twice (if it is + # gzipped). + # Plenty of race conditions exist in this code, but + # the alternative would be to capture the stderr of + # gzip and parse it, which would be a portability nightmare. + if (-e $filename && open($fh, $filename)) + { + binmode $fh; + + my $sig; + my $rdb = read($fh, $sig, 2); + + if ($rdb == 2 && $sig eq "\x1F\x8B") + { + my $ropen = sprintf($gzip_read_open, $filename); + + if (open($fh, $ropen)) + { + binmode $fh; + + return $fh; + } + else + { + return undef; + } + } + + seek($fh, 0, SEEK_SET) or + die "IO::Zlib: open('$filename', 'r'): seek: $!"; + + return $fh; + } + else + { + return undef; + } } + elsif ($mode =~ /w/) + { + my $level = $mode =~ /([1-9])/ ? "-$1" : ""; + + # To maximize portability we would need to open + # two filehandles here, one for "| gzip $level" + # and another for "> $filename", and then when + # writing copy bytes from the first to the second. + # We are using IO::Handle objects for now, however, + # and they can only contain one stream at a time. + my $wopen = sprintf($gzip_write_open, $filename); + + if (open($fh, $wopen)) + { + $fh->autoflush(1); + binmode $fh; + + return $fh; + } + else + { + return undef; + } + } + else + { + croak "IO::Zlib::gzopen_external: mode '$mode' is illegal"; + } + return undef; } -sub gzread_external { - # Use read() instead of syswrite() because people may +sub gzread_external +{ + my $file = shift; + my $bufref = \$_[0]; + my $nbytes = $_[1] || 4096; + + # Use read() instead of sysread() because people may # mix reads and readlines, and we don't want to mess # the stdio buffering. See also gzreadline_external() # and gzwrite_external(). - my $nread = read($_[0], $_[1], @_ == 3 ? $_[2] : 4096); - defined $nread ? $nread : -1; + my $nread = read($file, $$bufref, $nbytes); + + return defined $nread ? $nread : -1; } -sub gzwrite_external { +sub gzwrite_external +{ + my $file = shift; + my $buf = shift; + # Using syswrite() is okay (cf. gzread_external()) # since the bytes leave this process and buffering # is therefore not an issue. - my $nwrote = syswrite($_[0], $_[1]); - defined $nwrote ? $nwrote : -1; + my $nwrote = syswrite($file, $buf); + + return defined $nwrote ? $nwrote : -1; } -sub gzreadline_external { +sub gzreadline_external +{ + my $file = shift; + my $bufref = \$_[0]; + # See the comment in gzread_external(). - $_[1] = readline($_[0]); - return defined $_[1] ? length($_[1]) : -1; + $$bufref = readline($file); + + return defined $$bufref ? length($$bufref) : -1; } -sub gzeof_external { - return eof($_[0]); +sub gzeof_external +{ + my $file = shift; + + return eof($file); } -sub gzclose_external { - close($_[0]); +sub gzclose_external +{ + my $file = shift; + + close($file); + # I am not entirely certain why this is needed but it seems # the above close() always fails (as if the stream would have # been already closed - something to do with using external |