HTTP::Engine::Test::Request - HTTP::Engine request object builder for test

    use HTTP::Engine::Test::Request;

    # simple query
    my $req = HTTP::Engine::Test::Request->new(
        uri => 'http://example.com/?foo=bar&bar=baz'
    );
    is $req->method, 'GET', 'GET method';
    is $req->address, '127.0.0.1', 'remote address';
    is $req->uri, 'http://example.com/?foo=bar&bar=baz', 'uri';
    is_deeply $req->parameters, { foo => 'bar', bar => 'baz' }, 'query params';

    # use headers
    my $req = HTTP::Engine::Test::Request->new(
        uri     => 'http://example.com/',
        headers => {
            'Content-Type' => 'text/plain',
        },
    );
    is $req->header('content-type'), 'text/plain', 'content-type';

    # by HTTP::Request object
    my $req = HTTP::Engine::Test::Request->new(
        HTTP::Request->new(
            GET => 'http://example.com/?foo=bar&bar=baz',
            HTTP::Headers::Fast->new(
                'Content-Type' => 'text/plain',
            ),
        )
    );

    is $req->method, 'GET', 'GET method';
    is $req->address, '127.0.0.1', 'remote address';
    is $req->uri, 'http://example.com/?foo=bar&bar=baz', 'uri';
    is_deeply $req->parameters, { foo => 'bar', bar => 'baz' }, 'query params';
    is $req->header('content-type'), 'text/plain', 'content-type';

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__