File | /project/perl/lib/HTTP/Request.pm |
Statements Executed | 11072 |
Statement Execution Time | 134ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1383 | 3 | 3 | 59.1ms | 210ms | uri | HTTP::Request::
461 | 1 | 1 | 37.9ms | 295ms | new | HTTP::Request::
1383 | 3 | 3 | 36.8ms | 81.3ms | method | HTTP::Request::
1 | 1 | 2 | 20µs | 20µs | CORE:match (opcode) | HTTP::Request::
0 | 0 | 0 | 0s | 0s | BEGIN | HTTP::Request::
0 | 0 | 0 | 0s | 0s | as_string | HTTP::Request::
0 | 0 | 0 | 0s | 0s | clone | 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 | # $Id: Request.pm,v 1.40 2004/04/07 10:44:47 gisle Exp $ | ||||
4 | |||||
5 | 1 | 231µs | require HTTP::Message; | ||
6 | 1 | 11µs | @ISA = qw(HTTP::Message); | ||
7 | 1 | 102µs | 1 | 20µs | $VERSION = sprintf("%d.%02d", q$Revision: 1.40 $ =~ /(\d+)\.(\d+)/); # spent 20µs making 1 call to HTTP::Request::CORE:match |
8 | |||||
9 | 3 | 1.16ms | 1 | 26µs | use strict; # spent 26µs making 1 call to strict::import |
10 | |||||
11 | |||||
12 | |||||
13 | sub new | ||||
14 | # spent 295ms (37.9+257) within HTTP::Request::new which was called 461 times, avg 640µs/call:
# 461 times (37.9ms+257ms) by HTTP::Request::Common::_simple_req at line 104 of HTTP/Request/Common.pm, avg 640µs/call | ||||
15 | 461 | 2.77ms | my($class, $method, $uri, $header, $content) = @_; | ||
16 | 461 | 12.3ms | 461 | 43.0ms | my $self = $class->SUPER::new($header, $content); # spent 43.0ms making 461 calls to HTTP::Message::new, avg 93µs/call |
17 | 461 | 8.29ms | 461 | 28.4ms | $self->method($method); # spent 28.4ms making 461 calls to HTTP::Request::method, avg 62µs/call |
18 | 461 | 7.58ms | 461 | 186ms | $self->uri($uri); # spent 186ms making 461 calls to HTTP::Request::uri, avg 403µs/call |
19 | 461 | 6.39ms | $self; | ||
20 | } | ||||
21 | |||||
22 | |||||
23 | sub parse | ||||
24 | { | ||||
25 | my($class, $str) = @_; | ||||
26 | my $request_line; | ||||
27 | if ($str =~ s/^(.*)\n//) { | ||||
28 | $request_line = $1; | ||||
29 | } | ||||
30 | else { | ||||
31 | $request_line = $str; | ||||
32 | $str = ""; | ||||
33 | } | ||||
34 | |||||
35 | my $self = $class->SUPER::parse($str); | ||||
36 | my($method, $uri, $protocol) = split(' ', $request_line); | ||||
37 | $self->method($method) if defined($method); | ||||
38 | $self->uri($uri) if defined($uri); | ||||
39 | $self->protocol($protocol) if $protocol; | ||||
40 | $self; | ||||
41 | } | ||||
42 | |||||
43 | |||||
44 | sub clone | ||||
45 | { | ||||
46 | my $self = shift; | ||||
47 | my $clone = bless $self->SUPER::clone, ref($self); | ||||
48 | $clone->method($self->method); | ||||
49 | $clone->uri($self->uri); | ||||
50 | $clone; | ||||
51 | } | ||||
52 | |||||
53 | |||||
54 | sub method | ||||
55 | # spent 81.3ms (36.8+44.5) within HTTP::Request::method which was called 1383 times, avg 59µs/call:
# 461 times (12.7ms+15.7ms) by HTTP::Request::new at line 17, avg 62µs/call
# 461 times (12.2ms+14.5ms) by LWP::UserAgent::send_request at line 137 of LWP/UserAgent.pm, avg 58µs/call
# 461 times (11.9ms+14.4ms) by LWP::Protocol::http::request at line 127 of LWP/Protocol/http.pm, avg 57µs/call | ||||
56 | 1383 | 33.6ms | 1383 | 44.5ms | shift->_elem('_method', @_); # spent 44.5ms making 1383 calls to HTTP::Message::_elem, avg 32µs/call |
57 | } | ||||
58 | |||||
59 | |||||
60 | sub uri | ||||
61 | # spent 210ms (59.1+151) within HTTP::Request::uri which was called 1383 times, avg 152µs/call:
# 461 times (35.0ms+151ms) by HTTP::Request::new at line 18, avg 403µs/call
# 461 times (12.2ms+0s) by LWP::Protocol::http::request at line 134 of LWP/Protocol/http.pm, avg 26µs/call
# 461 times (11.9ms+0s) by LWP::UserAgent::send_request at line 137 of LWP/UserAgent.pm, avg 26µs/call | ||||
62 | 1383 | 6.74ms | my $self = shift; | ||
63 | 1383 | 7.58ms | my $old = $self->{'_uri'}; | ||
64 | 1383 | 8.31ms | if (@_) { | ||
65 | 461 | 2.71ms | my $uri = shift; | ||
66 | 461 | 4.43ms | if (!defined $uri) { | ||
67 | # that's ok | ||||
68 | } | ||||
69 | elsif (ref $uri) { | ||||
70 | Carp::croak("A URI can't be a " . ref($uri) . " reference") | ||||
71 | if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY'; | ||||
72 | Carp::croak("Can't use a " . ref($uri) . " object as a URI") | ||||
73 | unless $uri->can('scheme'); | ||||
74 | $uri = $uri->clone; | ||||
75 | unless ($HTTP::URI_CLASS eq "URI") { | ||||
76 | # Argh!! Hate this... old LWP legacy! | ||||
77 | eval { local $SIG{__DIE__}; $uri = $uri->abs; }; | ||||
78 | die $@ if $@ && $@ !~ /Missing base argument/; | ||||
79 | } | ||||
80 | } | ||||
81 | else { | ||||
82 | 461 | 10.8ms | 461 | 151ms | $uri = $HTTP::URI_CLASS->new($uri); # spent 151ms making 461 calls to URI::new, avg 327µs/call |
83 | } | ||||
84 | 461 | 2.94ms | $self->{'_uri'} = $uri; | ||
85 | } | ||||
86 | 1383 | 18.3ms | $old; | ||
87 | } | ||||
88 | |||||
89 | 1 | 7µs | *url = \&uri; # legacy | ||
90 | |||||
91 | |||||
92 | sub as_string | ||||
93 | { | ||||
94 | my $self = shift; | ||||
95 | my($eol) = @_; | ||||
96 | $eol = "\n" unless defined $eol; | ||||
97 | |||||
98 | my $req_line = $self->method || "-"; | ||||
99 | my $uri = $self->uri; | ||||
100 | $uri = (defined $uri) ? $uri->as_string : "-"; | ||||
101 | $req_line .= " $uri"; | ||||
102 | my $proto = $self->protocol; | ||||
103 | $req_line .= " $proto" if $proto; | ||||
104 | |||||
105 | return join($eol, $req_line, $self->SUPER::as_string(@_)); | ||||
106 | } | ||||
107 | |||||
108 | |||||
109 | 1 | 18µs | 1; | ||
110 | |||||
111 | __END__ | ||||
112 | |||||
113 | =head1 NAME | ||||
114 | |||||
115 | HTTP::Request - HTTP style request message | ||||
116 | |||||
117 | =head1 SYNOPSIS | ||||
118 | |||||
119 | require HTTP::Request; | ||||
120 | $request = HTTP::Request->new(GET => 'http://www.example.com/'); | ||||
121 | |||||
122 | and usually used like this: | ||||
123 | |||||
124 | $ua = LWP::UserAgent->new; | ||||
125 | $response = $ua->request($request); | ||||
126 | |||||
127 | =head1 DESCRIPTION | ||||
128 | |||||
129 | C<HTTP::Request> is a class encapsulating HTTP style requests, | ||||
130 | consisting of a request line, some headers, and a content body. Note | ||||
131 | that the LWP library uses HTTP style requests even for non-HTTP | ||||
132 | protocols. Instances of this class are usually passed to the | ||||
133 | request() method of an C<LWP::UserAgent> object. | ||||
134 | |||||
135 | C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore | ||||
136 | inherits its methods. The following additional methods are available: | ||||
137 | |||||
138 | =over 4 | ||||
139 | |||||
140 | =item $r = HTTP::Request->new( $method, $uri ) | ||||
141 | |||||
142 | =item $r = HTTP::Request->new( $method, $uri, $header ) | ||||
143 | |||||
144 | =item $r = HTTP::Request->new( $method, $uri, $header, $content ) | ||||
145 | |||||
146 | Constructs a new C<HTTP::Request> object describing a request on the | ||||
147 | object $uri using method $method. The $method argument must be a | ||||
148 | string. The $uri argument can be either a string, or a reference to a | ||||
149 | C<URI> object. The optional $header argument should be a reference to | ||||
150 | an C<HTTP::Headers> object or a plain array reference of key/value | ||||
151 | pairs. The optional $content argument should be a string of bytes. | ||||
152 | |||||
153 | =item $r = HTTP::Request->parse( $str ) | ||||
154 | |||||
155 | This constructs a new request object by parsing the given string. | ||||
156 | |||||
157 | =item $r->method | ||||
158 | |||||
159 | =item $r->method( $val ) | ||||
160 | |||||
161 | This is used to get/set the method attribute. The method should be a | ||||
162 | short string like "GET", "HEAD", "PUT" or "POST". | ||||
163 | |||||
164 | =item $r->uri | ||||
165 | |||||
166 | =item $r->uri( $val ) | ||||
167 | |||||
168 | This is used to get/set the uri attribute. The $val can be a | ||||
169 | reference to a URI object or a plain string. If a string is given, | ||||
170 | then it should be parseable as an absolute URI. | ||||
171 | |||||
172 | =item $r->header( $field ) | ||||
173 | |||||
174 | =item $r->header( $field => $value ) | ||||
175 | |||||
176 | This is used to get/set header values and it is inherited from | ||||
177 | C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for | ||||
178 | details and other similar methods that can be used to access the | ||||
179 | headers. | ||||
180 | |||||
181 | =item $r->content | ||||
182 | |||||
183 | =item $r->content( $content ) | ||||
184 | |||||
185 | This is used to get/set the content and it is inherited from the | ||||
186 | C<HTTP::Message> base class. See L<HTTP::Message> for details and | ||||
187 | other methods that can be used to access the content. | ||||
188 | |||||
189 | Note that the content should be a string of bytes. Strings in perl | ||||
190 | can contain characters outside the range of a byte. The C<Encode> | ||||
191 | module can be used to turn such strings into a string of bytes. | ||||
192 | |||||
193 | =item $r->as_string | ||||
194 | |||||
195 | =item $r->as_string( $eol ) | ||||
196 | |||||
197 | Method returning a textual representation of the request. | ||||
198 | |||||
199 | =back | ||||
200 | |||||
201 | =head1 SEE ALSO | ||||
202 | |||||
203 | L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>, | ||||
204 | L<HTTP::Response> | ||||
205 | |||||
206 | =head1 COPYRIGHT | ||||
207 | |||||
208 | Copyright 1995-2004 Gisle Aas. | ||||
209 | |||||
210 | This library is free software; you can redistribute it and/or | ||||
211 | modify it under the same terms as Perl itself. | ||||
212 | |||||
# spent 20µs within HTTP::Request::CORE:match which was called
# once (20µs+0s) by LWP::UserAgent::BEGIN at line 7 of HTTP/Request.pm |