File manager - Edit - /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/IO/Uncompress/Untar.pm
Back
package IO::Uncompress::Untar; require 5.006; use strict; use warnings; use IO::File; use Archive::Tar::Stream; use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ; require Exporter; our @ISA = qw(Exporter); our($VERSION)='1.02'; our($UntarError) = ''; our %EXPORT_TAGS = ( 'all' => [ qw( $UntarError ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); sub new { my $class = shift; my $this={}; $this->{handle}=shift; if(!defined $this->{handle}){warn "undef handle"; return undef;} $this->{z} = new IO::Uncompress::AnyUncompress $this->{handle} or return undef; $this->{ts} = Archive::Tar::Stream->new(infh => $this->{z}) or return undef; $this->{ts}->SafeCopy(0); $this->{opt}=shift; $this->{raw}=''; $this->{header}={}; $this->{loc}=0; $this->{i}=0; $this->{readoffset}=0; bless $this,$class; return $this; } # new sub nextStream { my $this = shift ; $this->{readoffset}=0; if(!$this->{loc}) { $this->{header}=$this->{ts}->ReadHeader(); $this->{loc}+=512; } else { while(($this->{header}->{size} > $this->{i} )&&(defined $this->{raw})) { my $blks=int(($this->{header}->{size}-$this->{i}-1)/512)+1; $blks=1602 if($blks>1602); $this->{raw} = $this->{ts}->ReadBlocks($blks); $this->{i}+=$blks*512; $this->{loc}+=$blks*512; } $this->{header}=$this->{ts}->ReadHeader(); $this->{loc}+=512; $this->{i}=0; } return 0 if(!((defined $this->{raw})&&(ref $this->{header}))); return 1; } # nextStream sub getHeaderInfo { my $this = shift ; $this->nextStream() unless($this->{loc}); return undef if(!ref $this->{header}); $this->{header}->{UncompressedLength}=$this->{header}->{size}; $this->{header}->{Name}=$this->{header}->{name}; $this->{header}->{Time}=$this->{header}->{mtime}; return $this->{header}; } # getHeaderInfo sub read { my $this = shift; my $bytes = $_[1] || 512*1600; ++$this->{rec}; # debugging - block accidental recursion #warn "$this $bytes r=" . $this->{rec}; my $offset = $_[2]; my $at_end = 0; die "non zero offset not implimented" if($offset); my $maxleft=$this->{header}->{size}-$this->{i}; if($bytes>$maxleft) { $bytes=$maxleft; $at_end = 1; } if((!defined $this->{raw})||($bytes>length($this->{raw}))) { my $blks=int(($bytes-length( $this->{raw} )-1 )/512)+1; $this->{raw}.=$this->{ts}->ReadBlocks($blks) if($this->{rec}<2); warn "Blocked recursion $this->{rec}" if($this->{rec}>1); $this->{i}+=$blks*512; $this->{loc}+=$blks*512; } --$this->{rec}; $_[0]=substr($this->{raw},$this->{readoffset},$bytes); if($at_end) { $this->{raw}=''; } else { $this->{raw}=substr($this->{raw},$bytes); } #$this->{readoffset}+=$bytes; #warn "$this got=" . length($_[0]); return length($_[0]); } # read sub close { my $this = shift; # $this->{ts}->close(); $this->{z}->close(); } 1; __END__ =head1 NAME IO::Uncompress::Untar - Pure-perl extension to read tar (and tgz and .tar.bz2 etc) files/buffers =head1 SYNOPSIS #!/usr/bin/perl -w use strict; use warnings; use IO::Uncompress::Untar qw($UntarError); my $u = new IO::Uncompress::Untar *STDIN or die "Cannot open"; # Prints the names of all the files in the tar / tgz / tar.bz2 / etc. my $status; for ($status = 1; $status > 0; $status = $u->nextStream()) { my $hdr = $u->getHeaderInfo(); my $fn = $hdr->{Name}; last if(!defined $fn); my @sz= ref $hdr->{UncompressedLength} ? @{$hdr->{UncompressedLength}} : ($hdr->{UncompressedLength}); my $buff; while (($status = $u->read($buff)) > 0) { # Do something here } print "$hdr->{Time}\t$sz[0]\t$fn\n"; last if $status < 0; } # for status =head1 DESCRIPTION This module provides a minimal pure-Perl interface that allows the reading of tar files/buffers. It maintains basic compatability/functionality of IO::Uncompress::Unzip =head2 EXPORT None by default. =head2 Notes Only these are implimented: new nextStream getHeaderInfo read =head2 new my $u = new IO::Uncompress::Untar *STDIN or die "Cannot open"; my $u = new IO::Uncompress::Untar 'somefile.tgz' or die "Cannot open"; Uses AnyUncompress internally, so the stream or file can be a plain tar, or a gzip, bzip2, Z, or anything else compressed that AnyUncompress knows. =head2 read Usage is $status = $z->read($buffer, $length) $status = $z->read($buffer, $length, $offset) $status = read($z, $buffer, $length) $status = read($z, $buffer, $length, $offset) Attempt to read C<$length> bytes of uncompressed data into C<$buffer>. =head2 getHeaderInfo Usage is $hdr = $z->getHeaderInfo(); @hdrs = $z->getHeaderInfo(); This method returns a hash reference (in scalar context) that contains information about the current file =head2 nextStream Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new compressed data stream is found, the eof marker will be cleared and C<$.> will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. =head1 SEE ALSO L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> =head1 AUTHOR This module was written by Chris Drake F<cdrake@cpan.org>. =head1 COPYRIGHT AND LICENSE Copyright (c) 2019 Chris Drake. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.18.2 or, at your option, any later version of Perl 5 you may have available. =cut
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | Generation time: 0.04 |
proxy
|
phpinfo
|
Settings