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


line stmt bran cond sub pod time code
1             package Furl::Request;
2              
3 11     11   557 use strict;
  11         38  
  11         346  
4 11     11   55 use warnings;
  11         17  
  11         282  
5 11     11   51 use utf8;
  11         18  
  11         60  
6 11     11   5453 use Class::Accessor::Lite;
  11         12910  
  11         66  
7 11     11   5052 use Furl::Headers;
  11         28  
  11         325  
8 11     11   66 use Furl::HTTP;
  11         20  
  11         9760  
9              
10             Class::Accessor::Lite->mk_accessors(qw/ method uri protocol headers content /);
11              
12             sub new {
13 1     1 0 2 my $class = shift;
14 1         3 my ($method, $uri, $headers, $content) = @_;
15              
16 1 50       3 unless (defined $headers) {
17 0         0 $headers = +{};
18             }
19              
20 1 50       8 unless (defined $content) {
21 0         0 $content = '';
22             }
23              
24             bless +{
25 1         25 method => $method,
26             uri => $uri,
27             headers => Furl::Headers->new($headers),
28             content => $content,
29             }, $class;
30             }
31              
32             sub parse {
33 1     1 0 31 my $class = shift;
34 1         2 my $raw_request = shift;
35              
36             # I didn't use HTTP::Parser::XS for following reasons:
37             # 1. parse_http_request() function omits request content, but need to deal it.
38             # 2. this function parses header to PSGI env, but env/header mapping is troublesome.
39              
40 1 50       21 return unless $raw_request =~ s!^(.+) (.+) (HTTP/1.\d+)\s*!!;
41 1         10 my ($method, $uri, $protocol) = ($1, $2, $3);
42              
43 1         20 my ($header_str, $content) = split /\015?\012\015?\012/, $raw_request, 2;
44              
45 1         2 my $headers = +{};
46 1         5 for (split /\015?\012/, $header_str) {
47 3         6 tr/\015\012//d;
48 3         10 my ($k, $v) = split /\s*:\s*/, $_, 2;
49 3         7 $headers->{lc $k} = $v;
50              
51             # complete host_port
52 3 100       15 if (lc $k eq 'host') {
53 1         3 $uri = $v . $uri;
54             }
55             }
56              
57 1 50       11 unless ($uri =~ /^http/) {
58 1         3 $uri = "http://$uri";
59             }
60              
61 1         4 my $req = $class->new($method, $uri, $headers, $content);
62 1         13 $req->protocol($protocol);
63 1         16 return $req;
64             }
65              
66             # alias
67             *body = \&content;
68              
69             # shorthand
70 0     0 1   sub content_length { shift->headers->content_length }
71 0     0 1   sub content_type { shift->headers->content_type }
72 0     0 1   sub header { shift->headers->header(@_) }
73              
74             sub request_line {
75 0     0 1   my $self = shift;
76              
77 0           my $path_query = $self->uri . ''; # for URI.pm
78 0           $path_query =~ s!^https?://[^/]+!!;
79              
80 0   0       my $method = $self->method || '';
81 0   0       my $protocol = $self->protocol || '';
82              
83 0           return "$method $path_query $protocol";
84             }
85              
86             sub as_http_request {
87 0     0 1   my $self = shift;
88              
89 0           require HTTP::Request;
90 0           my $req = HTTP::Request->new(
91             $self->method,
92             $self->uri,
93             [ $self->headers->flatten ],
94             $self->content,
95             );
96              
97 0           $req->protocol($self->protocol);
98 0           return $req;
99             }
100              
101             sub as_hashref {
102 0     0 1   my $self = shift;
103              
104             return +{
105 0           method => $self->method,
106             uri => $self->uri,
107             protocol => $self->protocol,
108             headers => [ $self->headers->flatten ],
109             content => $self->content,
110             };
111             }
112              
113             sub as_string {
114 0     0 0   my $self = shift;
115              
116 0 0         join("\015\012",
    0          
117             $self->method . ' ' . $self->uri . (defined($self->protocol) ? ' ' . $self->protocol : ''),
118             $self->headers->as_string,
119             ref($self->content) =~ qr{\A(?:ARRAY|HASH)\z} ? Furl::HTTP->make_x_www_form_urlencoded($self->content) : $self->content,
120             );
121             }
122              
123             1;
124             __END__