File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Request.pm |
Statements Executed | 104 |
Statement Execution Time | 15.6ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
12 | 4 | 3 | 83µs | 594µs | uri | HTTP::Request::
3 | 1 | 1 | 80µs | 724µs | new | HTTP::Request::
12 | 4 | 3 | 71µs | 111µs | method | HTTP::Request::
3 | 1 | 1 | 33µs | 616µs | uri_canonical | HTTP::Request::
1 | 1 | 1 | 18µs | 21µs | BEGIN@7 | HTTP::Request::
0 | 0 | 0 | 0s | 0s | accept_decodable | HTTP::Request::
0 | 0 | 0 | 0s | 0s | as_string | HTTP::Request::
0 | 0 | 0 | 0s | 0s | clone | HTTP::Request::
0 | 0 | 0 | 0s | 0s | dump | HTTP::Request::
0 | 0 | 0 | 0s | 0s | parse | HTTP::Request::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Request; | ||||
2 | |||||
3 | 1 | 173µs | require HTTP::Message; | ||
4 | 1 | 15µs | @ISA = qw(HTTP::Message); | ||
5 | 1 | 1µs | $VERSION = "5.827"; | ||
6 | |||||
7 | 3 | 15.1ms | 2 | 25µs | # spent 21µs (18+3) within HTTP::Request::BEGIN@7 which was called
# once (18µs+3µs) by LWP::UserAgent::BEGIN@10 at line 7 # spent 21µs making 1 call to HTTP::Request::BEGIN@7
# spent 4µs making 1 call to strict::import |
8 | |||||
9 | |||||
10 | |||||
11 | sub new | ||||
12 | # spent 724µs (80+644) within HTTP::Request::new which was called 3 times, avg 241µs/call:
# 3 times (80µs+644µs) by SimpleDB::Client::construct_request at line 176 of ../lib/SimpleDB/Client.pm, avg 241µs/call | ||||
13 | 3 | 5µs | my($class, $method, $uri, $header, $content) = @_; | ||
14 | 3 | 36µs | 3 | 48µs | my $self = $class->SUPER::new($header, $content); # spent 48µs making 3 calls to HTTP::Message::new, avg 16µs/call |
15 | 3 | 8µs | 3 | 44µs | $self->method($method); # spent 44µs making 3 calls to HTTP::Request::method, avg 15µs/call |
16 | 3 | 8µs | 3 | 552µs | $self->uri($uri); # spent 552µs making 3 calls to HTTP::Request::uri, avg 184µs/call |
17 | 3 | 11µs | $self; | ||
18 | } | ||||
19 | |||||
20 | |||||
21 | sub parse | ||||
22 | { | ||||
23 | my($class, $str) = @_; | ||||
24 | my $request_line; | ||||
25 | if ($str =~ s/^(.*)\n//) { | ||||
26 | $request_line = $1; | ||||
27 | } | ||||
28 | else { | ||||
29 | $request_line = $str; | ||||
30 | $str = ""; | ||||
31 | } | ||||
32 | |||||
33 | my $self = $class->SUPER::parse($str); | ||||
34 | my($method, $uri, $protocol) = split(' ', $request_line); | ||||
35 | $self->method($method) if defined($method); | ||||
36 | $self->uri($uri) if defined($uri); | ||||
37 | $self->protocol($protocol) if $protocol; | ||||
38 | $self; | ||||
39 | } | ||||
40 | |||||
41 | |||||
42 | sub clone | ||||
43 | { | ||||
44 | my $self = shift; | ||||
45 | my $clone = bless $self->SUPER::clone, ref($self); | ||||
46 | $clone->method($self->method); | ||||
47 | $clone->uri($self->uri); | ||||
48 | $clone; | ||||
49 | } | ||||
50 | |||||
51 | |||||
52 | sub method | ||||
53 | # spent 111µs (71+40) within HTTP::Request::method which was called 12 times, avg 9µs/call:
# 3 times (30µs+13µs) by HTTP::Request::new at line 15, avg 15µs/call
# 3 times (17µs+9µs) by LWP::Protocol::http::request at line 128 of LWP/Protocol/http.pm, avg 9µs/call
# 3 times (12µs+9µs) by LWP::UserAgent::prepare_request at line 208 of LWP/UserAgent.pm, avg 7µs/call
# 3 times (12µs+8µs) by LWP::UserAgent::send_request at line 119 of LWP/UserAgent.pm, avg 7µs/call | ||||
54 | 12 | 63µs | 12 | 40µs | shift->_elem('_method', @_); # spent 40µs making 12 calls to HTTP::Message::_elem, avg 3µs/call |
55 | } | ||||
56 | |||||
57 | |||||
58 | sub uri | ||||
59 | # spent 594µs (83+510) within HTTP::Request::uri which was called 12 times, avg 49µs/call:
# 3 times (42µs+510µs) by HTTP::Request::new at line 16, avg 184µs/call
# 3 times (16µs+0s) by LWP::UserAgent::send_request at line 119 of LWP/UserAgent.pm, avg 5µs/call
# 3 times (16µs+0s) by LWP::UserAgent::prepare_request at line 209 of LWP/UserAgent.pm, avg 5µs/call
# 3 times (9µs+0s) by LWP::Protocol::http::request at line 135 of LWP/Protocol/http.pm, avg 3µs/call | ||||
60 | 12 | 5µs | my $self = shift; | ||
61 | 12 | 6µs | my $old = $self->{'_uri'}; | ||
62 | 12 | 4µs | if (@_) { | ||
63 | 3 | 2µs | my $uri = shift; | ||
64 | 3 | 4µs | if (!defined $uri) { | ||
65 | # that's ok | ||||
66 | } | ||||
67 | elsif (ref $uri) { | ||||
68 | Carp::croak("A URI can't be a " . ref($uri) . " reference") | ||||
69 | if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY'; | ||||
70 | Carp::croak("Can't use a " . ref($uri) . " object as a URI") | ||||
71 | unless $uri->can('scheme'); | ||||
72 | $uri = $uri->clone; | ||||
73 | unless ($HTTP::URI_CLASS eq "URI") { | ||||
74 | # Argh!! Hate this... old LWP legacy! | ||||
75 | eval { local $SIG{__DIE__}; $uri = $uri->abs; }; | ||||
76 | die $@ if $@ && $@ !~ /Missing base argument/; | ||||
77 | } | ||||
78 | } | ||||
79 | else { | ||||
80 | 3 | 11µs | 3 | 510µs | $uri = $HTTP::URI_CLASS->new($uri); # spent 510µs making 3 calls to URI::new, avg 170µs/call |
81 | } | ||||
82 | 3 | 4µs | $self->{'_uri'} = $uri; | ||
83 | 3 | 2µs | delete $self->{'_uri_canonical'}; | ||
84 | } | ||||
85 | 12 | 57µs | $old; | ||
86 | } | ||||
87 | |||||
88 | 1 | 2µs | *url = \&uri; # legacy | ||
89 | |||||
90 | sub uri_canonical | ||||
91 | # spent 616µs (33+583) within HTTP::Request::uri_canonical which was called 3 times, avg 205µs/call:
# 3 times (33µs+583µs) by HTTP::Config::matching at line 177 of HTTP/Config.pm, avg 205µs/call | ||||
92 | 3 | 2µs | my $self = shift; | ||
93 | 3 | 28µs | 3 | 583µs | return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical; # spent 583µs making 3 calls to URI::http::canonical, avg 194µs/call |
94 | } | ||||
95 | |||||
96 | |||||
97 | sub accept_decodable | ||||
98 | { | ||||
99 | my $self = shift; | ||||
100 | $self->header("Accept-Encoding", scalar($self->decodable)); | ||||
101 | } | ||||
102 | |||||
103 | sub as_string | ||||
104 | { | ||||
105 | my $self = shift; | ||||
106 | my($eol) = @_; | ||||
107 | $eol = "\n" unless defined $eol; | ||||
108 | |||||
109 | my $req_line = $self->method || "-"; | ||||
110 | my $uri = $self->uri; | ||||
111 | $uri = (defined $uri) ? $uri->as_string : "-"; | ||||
112 | $req_line .= " $uri"; | ||||
113 | my $proto = $self->protocol; | ||||
114 | $req_line .= " $proto" if $proto; | ||||
115 | |||||
116 | return join($eol, $req_line, $self->SUPER::as_string(@_)); | ||||
117 | } | ||||
118 | |||||
119 | sub dump | ||||
120 | { | ||||
121 | my $self = shift; | ||||
122 | my @pre = ($self->method || "-", $self->uri || "-"); | ||||
123 | if (my $prot = $self->protocol) { | ||||
124 | push(@pre, $prot); | ||||
125 | } | ||||
126 | |||||
127 | return $self->SUPER::dump( | ||||
128 | preheader => join(" ", @pre), | ||||
129 | @_, | ||||
130 | ); | ||||
131 | } | ||||
132 | |||||
133 | |||||
134 | 1 | 20µs | 1; | ||
135 | |||||
136 | __END__ | ||||
137 | |||||
138 | =head1 NAME | ||||
139 | |||||
140 | HTTP::Request - HTTP style request message | ||||
141 | |||||
142 | =head1 SYNOPSIS | ||||
143 | |||||
144 | require HTTP::Request; | ||||
145 | $request = HTTP::Request->new(GET => 'http://www.example.com/'); | ||||
146 | |||||
147 | and usually used like this: | ||||
148 | |||||
149 | $ua = LWP::UserAgent->new; | ||||
150 | $response = $ua->request($request); | ||||
151 | |||||
152 | =head1 DESCRIPTION | ||||
153 | |||||
154 | C<HTTP::Request> is a class encapsulating HTTP style requests, | ||||
155 | consisting of a request line, some headers, and a content body. Note | ||||
156 | that the LWP library uses HTTP style requests even for non-HTTP | ||||
157 | protocols. Instances of this class are usually passed to the | ||||
158 | request() method of an C<LWP::UserAgent> object. | ||||
159 | |||||
160 | C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore | ||||
161 | inherits its methods. The following additional methods are available: | ||||
162 | |||||
163 | =over 4 | ||||
164 | |||||
165 | =item $r = HTTP::Request->new( $method, $uri ) | ||||
166 | |||||
167 | =item $r = HTTP::Request->new( $method, $uri, $header ) | ||||
168 | |||||
169 | =item $r = HTTP::Request->new( $method, $uri, $header, $content ) | ||||
170 | |||||
171 | Constructs a new C<HTTP::Request> object describing a request on the | ||||
172 | object $uri using method $method. The $method argument must be a | ||||
173 | string. The $uri argument can be either a string, or a reference to a | ||||
174 | C<URI> object. The optional $header argument should be a reference to | ||||
175 | an C<HTTP::Headers> object or a plain array reference of key/value | ||||
176 | pairs. The optional $content argument should be a string of bytes. | ||||
177 | |||||
178 | =item $r = HTTP::Request->parse( $str ) | ||||
179 | |||||
180 | This constructs a new request object by parsing the given string. | ||||
181 | |||||
182 | =item $r->method | ||||
183 | |||||
184 | =item $r->method( $val ) | ||||
185 | |||||
186 | This is used to get/set the method attribute. The method should be a | ||||
187 | short string like "GET", "HEAD", "PUT" or "POST". | ||||
188 | |||||
189 | =item $r->uri | ||||
190 | |||||
191 | =item $r->uri( $val ) | ||||
192 | |||||
193 | This is used to get/set the uri attribute. The $val can be a | ||||
194 | reference to a URI object or a plain string. If a string is given, | ||||
195 | then it should be parseable as an absolute URI. | ||||
196 | |||||
197 | =item $r->header( $field ) | ||||
198 | |||||
199 | =item $r->header( $field => $value ) | ||||
200 | |||||
201 | This is used to get/set header values and it is inherited from | ||||
202 | C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for | ||||
203 | details and other similar methods that can be used to access the | ||||
204 | headers. | ||||
205 | |||||
206 | =item $r->accept_decodable | ||||
207 | |||||
208 | This will set the C<Accept-Encoding> header to the list of encodings | ||||
209 | that decoded_content() can decode. | ||||
210 | |||||
211 | =item $r->content | ||||
212 | |||||
213 | =item $r->content( $bytes ) | ||||
214 | |||||
215 | This is used to get/set the content and it is inherited from the | ||||
216 | C<HTTP::Message> base class. See L<HTTP::Message> for details and | ||||
217 | other methods that can be used to access the content. | ||||
218 | |||||
219 | Note that the content should be a string of bytes. Strings in perl | ||||
220 | can contain characters outside the range of a byte. The C<Encode> | ||||
221 | module can be used to turn such strings into a string of bytes. | ||||
222 | |||||
223 | =item $r->as_string | ||||
224 | |||||
225 | =item $r->as_string( $eol ) | ||||
226 | |||||
227 | Method returning a textual representation of the request. | ||||
228 | |||||
229 | =back | ||||
230 | |||||
231 | =head1 SEE ALSO | ||||
232 | |||||
233 | L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>, | ||||
234 | L<HTTP::Response> | ||||
235 | |||||
236 | =head1 COPYRIGHT | ||||
237 | |||||
238 | Copyright 1995-2004 Gisle Aas. | ||||
239 | |||||
240 | This library is free software; you can redistribute it and/or | ||||
241 | modify it under the same terms as Perl itself. | ||||
242 |