File Coverage

blib/lib/Net/HTTP/Spore/Role/Request.pm
Criterion Covered Total %
statement 32 57 56.1
branch 9 20 45.0
condition 8 12 66.6
subroutine 8 12 66.6
pod 1 1 100.0
total 58 102 56.8


line stmt bran cond sub pod time code
1             package Net::HTTP::Spore::Role::Request;
2             $Net::HTTP::Spore::Role::Request::VERSION = '0.09';
3             # ABSTRACT: make HTTP request
4              
5 22     22   9897 use Try::Tiny;
  22         61  
  22         1225  
6 22     22   132 use Moose::Role;
  22         46  
  22         172  
7              
8 22     22   119969 use Net::HTTP::Spore::Request;
  22         107  
  22         13757  
9              
10             sub http_request {
11 24     24 1 87 my ( $self, $env ) = @_;
12              
13 24         51 my ($request, $response);
14 24         287 $request = Net::HTTP::Spore::Request->new($env);
15              
16 24         17043 my @middlewares;
17 24         859 foreach my $mw ( $self->middlewares ) {
18 43         82 my $res;
19             try {
20 43     43   2121 $res = $mw->($request);
21             }
22             catch {
23 1     1   36 $res = $request->new_response( 599, [], { error => $_, } );
24 43         373 };
25              
26 43 100 100     1830 if ( ref $res && ref $res eq 'CODE' ) {
    100 66        
27 11         40 push @middlewares, $res;
28             }
29             elsif ( ref $res && ref $res eq 'Net::HTTP::Spore::Response' ) {
30 24 100       95 return $res if ($res->status == 599);
31 23         55 $response = $res;
32 23         66 last;
33             }
34             }
35              
36             return
37 23 50       223 $self->_execute_middlewares_on_response( $response, @middlewares )
38             if defined $response;
39              
40 0         0 $response = $self->_request($request);
41              
42 0         0 return $self->_execute_middlewares_on_response( $response, @middlewares );
43             }
44              
45             sub _execute_middlewares_on_response {
46 23     23   86 my ($self, $response, @middlewares) = @_;
47              
48 23         70 foreach my $mw ( reverse @middlewares ) {
49 11         25 my ($res, $error);
50             try {
51 11     11   505 $res = $mw->($response);
52             }catch{
53 0     0   0 $error = 1;
54 0         0 $response->code(599);
55 0         0 $response->body({error => $_, body=>$response->body});
56 11         118 };
57 11 50 66     860 $response = $res
      33        
58             if ( defined $res
59             && Scalar::Util::blessed($res)
60             && $res->isa('Net::HTTP::Spore::Response') );
61 11 50       42 last if $error;
62             }
63              
64 23         133 $response;
65             }
66              
67             sub _request {
68 0     0     my ($self, $request) = @_;
69              
70 0           my $finalized_request = $request->finalize();
71              
72 0           $self->_debug_request($request, $finalized_request);
73              
74 0           my $result = $self->request($finalized_request);
75              
76 0           my $response = $request->new_response(
77             $result->code,
78             $result->headers,
79             $result->content,
80             );
81              
82 0           $self->_debug_response($response);
83              
84 0           return $response;
85             }
86              
87             sub _debug_request {
88 0     0     my ( $self, $request, $finalized_request ) = @_;
89 0 0         return unless $self->trace;
90              
91 0           $self->_trace_msg( '> %s %s%s', $request->method, $request->script_name, $request->path );
92 0           $self->_trace_msg( '> Host: %s', $request->host );
93             $self->_trace_msg( '> Query String: %s', $request->env->{QUERY_STRING} )
94 0 0         if defined $request->env->{QUERY_STRING};
95 0 0         $self->_trace_msg( '> Content: %s', $request->content )
96             if defined $request->content;
97              
98 0           foreach my $key ( $request->headers->header_field_names ) {
99 0           $self->_trace_msg( '> %s: %s', $key, $request->header($key) );
100             }
101             }
102              
103             sub _debug_response {
104 0     0     my ($self, $response) = @_;
105 0 0         return unless $self->trace;
106              
107 0           foreach my $key ( $response->headers->header_field_names ) {
108 0           $self->_trace_msg( '< %s: %s', $key, $response->header($key) );
109             }
110 0           $self->_trace_verbose($response->body);
111             }
112              
113             1;
114              
115             __END__
116              
117             =pod
118              
119             =encoding UTF-8
120              
121             =head1 NAME
122              
123             Net::HTTP::Spore::Role::Request - make HTTP request
124              
125             =head1 VERSION
126              
127             version 0.09
128              
129             =head1 SYNOPSIS
130              
131             =head1 DESCRIPTION
132              
133             =head2 METHODS
134              
135             =over 4
136              
137             =item B<http_request>
138              
139             =back
140              
141             =head2 ATTRIBUTES
142              
143             =over 4
144              
145             =item B<api_base_url>
146              
147             =back
148              
149             =head1 AUTHORS
150              
151             =over 4
152              
153             =item *
154              
155             Franck Cuny <franck.cuny@gmail.com>
156              
157             =item *
158              
159             Ash Berlin <ash@cpan.org>
160              
161             =item *
162              
163             Ahmad Fatoum <athreef@cpan.org>
164              
165             =back
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             This software is copyright (c) 2012 by Linkfluence.
170              
171             This is free software; you can redistribute it and/or modify it under
172             the same terms as the Perl 5 programming language system itself.
173              
174             =cut