File Coverage

blib/lib/Archive/Heritrix.pm

Criterion	Covered	Total	%
statement	74	80	92.5
branch	18	26	69.2
condition	4	6	66.6
subroutine	11	11	100.0
pod	0	3	0.0
total	107	126	84.9

package Archive::Heritrix;

use 5.008005;
use strict;
use warnings;
use Compress::Zlib;
use File::Find;
use HTTP::Response;

our $VERSION = 0.02;

sub new {
  my ( $class, %arg ) = @_;
  my $self = bless {}, $class;

  if ( $arg{ 'file' } && $arg{ 'directory' } ) {
    die "file or directory, not both";
  }

  my @files = ();

  if ( $arg{ 'file' } ) {
    if ( ! -f $arg{ 'file' } ) {
      die "no such file";
    }
    @files = ( $arg{ 'file' } );
  }
  if ( $arg{ 'directory' } ) {
    if ( ! -d $arg{ 'directory' } ) {
      die "no such directory";
    }
    find( sub { push @files, $File::Find::name if $File::Find::name =~ /\.arc\.gz$/ },  $arg{ 'directory' } );
  }

  $self->{ 'files' } = \@files;
  $self->next_file();
  return $self;
}

sub next_file {
  my $self = shift;
  my $f = shift @{ $self->{ 'files' } };
  if ( ! $f ) {
    $self->{ '_fh' } = undef;
    return undef;
  }
  my $gz = gzopen( $f, 'rb' );
  return undef unless $gz;
  $self->{ '_fh' } = $gz;
}

sub next_record {
  my $self = shift;
  my $fh = $self->_fh();

  if ( ! $fh ) {
    if ( $self->next_file() ) {
      $fh = $self->_fh();
    }
    else {
      return undef;
    }
  }

  my $head;
  $fh->gzreadline( $head );
  chomp $head;
  my ($url,$ip,$stamp,$type,$length) = $head =~ m/^(.+?) ([\d\.]+) (\d+) (\S+) (\d+)$/;
  if ( ! $url ) {
    $self->next_file();
    $fh = $self->_fh();
    return undef unless $fh;
    $fh->gzreadline( $head );
    chomp $head;
    ($url,$ip,$stamp,$type,$length) = $head =~ m/^(.+?) ([\d\.]+) (\d+) (\S+) (\d+)$/;
  }
  return undef unless $url;

  my $buf = undef;
  my $read = 0;
  my $l0 = undef;
  while ( $read <= $length ) {
    my $bbuf;
    $fh->gzreadline( $bbuf );
    $l0 ||= $bbuf;
    my $got = length( $bbuf );
    $buf .= $bbuf;
    $read += $got;
  }
  my ( $code, $msg ) = $l0 =~ m#(\d{3})\s+(.+?)[\r\n]*$#;
  my $res = HTTP::Response->parse( $buf );
  $res->{'_headers'}->content_length($length);
  $res->{'_headers'}->referer($url);
  $res->code( $code );
  $res->message( $msg );

  return $res;
}

sub _fh {
  return shift->{ '_fh' };
}

1;
__END__