File Coverage

blib/lib/HTTP/Engine/Test/Request.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package HTTP::Engine::Test::Request;
use strict;
use warnings;

use IO::Scalar;
use URI;
use URI::WithBase;
use Scalar::Util 'blessed';

use HTTP::Engine::Request;
use HTTP::Engine::RequestBuilder::NoEnv;

sub new {
    my $class = shift;

    if ($_[0] && ref($_[0]) && $_[0]->isa('HTTP::Request')) {
        # create H::E::Req from HTTP::Request
        my $req  = shift;
        my %args = @_;

        return $class->build_request(
            $req->uri,
            $req->content, {
                headers  => $req->headers,
                method   => $req->method,
                protocol => $req->protocol,
                %args,
            }
        );
    } else {
        # create H::E::Req from hash
        my %args = @_;

        my $body   = delete $args{body} || '';
        my $uri    = delete $args{uri}    or Carp::croak('missing uri');
        my $method = delete $args{method} or Carp::croak('missing method');

        return $class->build_request(
            $uri,
            $body, {
                headers  => +{},
                protocol => undef,
                method   => $method,
                %args
            }
        );
    }
}

sub build_request {
    my ($class, $uri, $body, $args) = @_;

    my %req_args = $class->build_request_args(
        $uri,
        $body,
        $args,
    );

    return HTTP::Engine::Request->new(
        request_builder => HTTP::Engine::RequestBuilder::NoEnv->new,
        %req_args,
    );
}

# This method is used by Interface::Test.
sub build_request_args {
    my($class, $uri, $body, $args) = @_;

    unless (blessed($uri) && $uri->isa('URI')) {
        $uri = URI->new( $uri );
    }

    return (
        uri         => URI::WithBase->new( $uri ),
        base        => do {
            my $base = $uri->clone;
            $base->path_query('/');
            $base;
        },
        address     => '127.0.0.1',
        port        => '80',
        user        => undef,
        _https_info => undef,
        _connection => {
            input_handle  => IO::Scalar->new( \( $body ) ),
            env           => ($args->{env} || {}),
        },
        %$args,
    );
}

1;

__END__