File Coverage

blib/lib/WARC/Record/Replay/HTTP/Request.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	6	6	100.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	47	47	100.0

package WARC::Record::Replay::HTTP::Request;			# -*- CPerl -*-

use strict;
use warnings;

require HTTP::Request;
require WARC::Record::Replay::HTTP::Message;
our @ISA = qw(WARC::Record::Replay::HTTP::Message HTTP::Request);

use WARC; *WARC::Record::Replay::HTTP::Request::VERSION = \$WARC::VERSION;

require WARC::Record::Replay;

WARC::Record::Replay::register
  { $_->field('Content-Type') =~ m|^application/http; msgtype=request| }
  \&_load_record;
WARC::Record::Replay::register
  { $_->field('Content-Type') =~ m|^application/http| && $_->type eq 'request' }
  \&_load_record;

BEGIN {
  use WARC::Record::Replay::HTTP;
  $WARC::Record::Replay::HTTP::Request::{$_} =
    $WARC::Record::Replay::HTTP::{$_}
      for WARC::Record::Replay::HTTP::HTTP_PARSE_REs;
}


sub _load_record {
  my $record = shift;

  my $handle = $record->open_continued;

  if ($record->field('Content-Length')
      < $WARC::Record::Replay::HTTP::Content_Deferred_Loading_Threshold) {
    # The entire WARC block is smaller than the deferred loading threshold;
    # this is an easy special case.
    my $block;
    {
      local $/ = undef;	# slurp
      $block = <$handle>;
    }
    my $request = HTTP::Request->parse($block);
    return $request->protocol =~ $HTTP__Version ? $request : undef;
  }

  my $method; my $uri; my $http_version;
  {
    local $/ = "\012";
    my $line = <$handle>;
    $line =~ s/[[:space:]]+$//; # trim trailing CR if present
    return undef unless $line =~ $HTTP__Request_Line;
    # $1 -- HTTP Method		$2 -- Request-URI	$3 -- HTTP-Version
    $method = $1; $uri = $2; $http_version = $3;
  }

  my $ob = HTTP::Request->new($method, $uri);
  $ob->protocol($http_version);

  WARC::Record::Replay::HTTP::Message::_load_record($ob, $record, $handle);
}

1;
__END__