File Coverage

blib/lib/IO/Uncompress/Untar.pm

Criterion	Covered	Total	%
statement	15	74	20.2
branch	0	26	0.0
condition	0	11	0.0
subroutine	5	10	50.0
pod	4	5	80.0
total	24	126	19.0

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];
  die "non zero offset not implimented" if($offset);
  my $maxleft=$this->{header}->{size}-$this->{i};
  $bytes=$maxleft if($bytes>$maxleft);
  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);
  $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__