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