File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Request.pm |
Statements Executed | 1320 |
Statement Execution Time | 3.11ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
164 | 4 | 3 | 818µs | 7.81ms | uri | HTTP::Request::
41 | 1 | 1 | 773µs | 9.36ms | new | HTTP::Request::
164 | 4 | 3 | 618µs | 1.09ms | method | HTTP::Request::
41 | 1 | 1 | 402µs | 7.41ms | uri_canonical | HTTP::Request::
1 | 1 | 1 | 14µs | 17µ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 | 85µs | require HTTP::Message; | ||
4 | 1 | 10µs | @ISA = qw(HTTP::Message); | ||
5 | 1 | 500ns | $VERSION = "5.827"; | ||
6 | |||||
7 | 3 | 499µs | 2 | 20µs | # spent 17µs (14+3) within HTTP::Request::BEGIN@7 which was called
# once (14µs+3µs) by LWP::UserAgent::BEGIN@10 at line 7 # spent 17µs making 1 call to HTTP::Request::BEGIN@7
# spent 3µs making 1 call to strict::import |
8 | |||||
9 | |||||
10 | |||||
11 | sub new | ||||
12 | # spent 9.36ms (773µs+8.59) within HTTP::Request::new which was called 41 times, avg 228µs/call:
# 41 times (773µs+8.59ms) by SimpleDB::Client::construct_request at line 181 of SimpleDB/Client.pm, avg 228µs/call | ||||
13 | 205 | 666µs | my($class, $method, $uri, $header, $content) = @_; | ||
14 | my $self = $class->SUPER::new($header, $content); # spent 631µs making 41 calls to HTTP::Message::new, avg 15µs/call | ||||
15 | $self->method($method); # spent 407µs making 41 calls to HTTP::Request::method, avg 10µs/call | ||||
16 | $self->uri($uri); # spent 7.55ms making 41 calls to HTTP::Request::uri, avg 184µs/call | ||||
17 | $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 1.09ms (618µs+468µs) within HTTP::Request::method which was called 164 times, avg 7µs/call:
# 41 times (239µs+169µs) by HTTP::Request::new at line 15, avg 10µs/call
# 41 times (127µs+104µs) by LWP::UserAgent::prepare_request at line 208 of LWP/UserAgent.pm, avg 6µs/call
# 41 times (129µs+101µs) by LWP::Protocol::http::request at line 128 of LWP/Protocol/http.pm, avg 6µs/call
# 41 times (124µs+94µs) by LWP::UserAgent::send_request at line 119 of LWP/UserAgent.pm, avg 5µs/call | ||||
54 | 164 | 594µs | 164 | 467µs | shift->_elem('_method', @_); # spent 467µs making 164 calls to HTTP::Message::_elem, avg 3µs/call |
55 | } | ||||
56 | |||||
57 | |||||
58 | sub uri | ||||
59 | # spent 7.81ms (818µs+6.99) within HTTP::Request::uri which was called 164 times, avg 48µs/call:
# 41 times (564µs+6.99ms) by HTTP::Request::new at line 16, avg 184µs/call
# 41 times (96µs+0s) by LWP::Protocol::http::request at line 135 of LWP/Protocol/http.pm, avg 2µs/call
# 41 times (79µs+0s) by LWP::UserAgent::send_request at line 119 of LWP/UserAgent.pm, avg 2µs/call
# 41 times (79µs+0s) by LWP::UserAgent::prepare_request at line 209 of LWP/UserAgent.pm, avg 2µs/call | ||||
60 | 656 | 550µs | my $self = shift; | ||
61 | my $old = $self->{'_uri'}; | ||||
62 | 164 | 174µs | if (@_) { | ||
63 | my $uri = shift; | ||||
64 | 41 | 150µ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 | $uri = $HTTP::URI_CLASS->new($uri); # spent 6.99ms making 41 calls to URI::new, avg 170µs/call | ||||
81 | } | ||||
82 | $self->{'_uri'} = $uri; | ||||
83 | delete $self->{'_uri_canonical'}; | ||||
84 | } | ||||
85 | $old; | ||||
86 | } | ||||
87 | |||||
88 | 1 | 1µs | *url = \&uri; # legacy | ||
89 | |||||
90 | sub uri_canonical | ||||
91 | # spent 7.41ms (402µs+7.01) within HTTP::Request::uri_canonical which was called 41 times, avg 181µs/call:
# 41 times (402µs+7.01ms) by HTTP::Config::matching at line 177 of HTTP/Config.pm, avg 181µs/call | ||||
92 | 82 | 366µs | my $self = shift; | ||
93 | return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical; # spent 7.01ms making 41 calls to URI::http::canonical, avg 171µ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 | 16µ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 |