File Coverage

blib/lib/Furl/Request.pm

Criterion	Covered	Total	%
statement	40	60	66.6
branch	6	14	42.8
condition	0	4	0.0
subroutine	8	15	53.3
pod	6	9	66.6
total	60	102	58.8

package Furl::Request;

use strict;
use warnings;
use utf8;
use Class::Accessor::Lite;
use Furl::Headers;
use Furl::HTTP;

Class::Accessor::Lite->mk_accessors(qw/ method uri protocol headers content /);

sub new {
    my $class = shift;
    my ($method, $uri, $headers, $content) = @_;

    unless (defined $headers) {
        $headers = +{};
    }

    unless (defined $content) {
        $content = '';
    }

    bless +{
        method  => $method,
        uri     => $uri,
        headers => Furl::Headers->new($headers),
        content => $content,
    }, $class;
}

sub parse {
    my $class = shift;
    my $raw_request = shift;

    # I didn't use HTTP::Parser::XS for following reasons:
    # 1. parse_http_request() function omits request content, but need to deal it.
    # 2. this function parses header to PSGI env, but env/header mapping is troublesome.

    return unless $raw_request =~ s!^(.+) (.+) (HTTP/1.\d+)\s*!!;
    my ($method, $uri, $protocol) = ($1, $2, $3);

    my ($header_str, $content) = split /\015?\012\015?\012/, $raw_request, 2;

    my $headers = +{};
    for (split /\015?\012/, $header_str) {
        tr/\015\012//d;
        my ($k, $v) = split /\s*:\s*/, $_, 2;
        $headers->{lc $k} = $v;

        # complete host_port
        if (lc $k eq 'host') {
            $uri = $v . $uri;
        }
    }

    unless ($uri =~ /^http/) {
        $uri = "http://$uri";
    }

    my $req = $class->new($method, $uri, $headers, $content);
    $req->protocol($protocol);
    return $req;
}

# alias
*body = \&content;

# shorthand
sub content_length { shift->headers->content_length }
sub content_type   { shift->headers->content_type }
sub header         { shift->headers->header(@_) }

sub request_line {
    my $self = shift;

    my $path_query = $self->uri . ''; # for URI.pm
    $path_query =~ s!^https?://[^/]+!!;

    my $method   = $self->method   || '';
    my $protocol = $self->protocol || '';

    return "$method $path_query $protocol";
}

sub as_http_request {
    my $self = shift;

    require HTTP::Request;
    my $req = HTTP::Request->new(
        $self->method,
        $self->uri,
        [ $self->headers->flatten ],
        $self->content,
    );

    $req->protocol($self->protocol);
    return $req;
}

sub as_hashref {
    my $self = shift;

    return +{
        method   => $self->method,
        uri      => $self->uri,
        protocol => $self->protocol,
        headers  => [ $self->headers->flatten ],
        content  => $self->content,
    };
}

sub as_string {
    my $self = shift;

    join("\015\012",
        $self->method . ' ' . $self->uri . (defined($self->protocol) ? ' ' . $self->protocol : ''),
        $self->headers->as_string,
        ref($self->content) =~ qr{\A(?:ARRAY|HASH)\z} ? Furl::HTTP->make_x_www_form_urlencoded($self->content) : $self->content,
    );
}

1;
__END__