← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:06 2010

File /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Request.pm
Statements Executed 104
Statement Execution Time 15.6ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
124383µs594µsHTTP::Request::::uriHTTP::Request::uri
31180µs724µsHTTP::Request::::newHTTP::Request::new
124371µs111µsHTTP::Request::::methodHTTP::Request::method
31133µs616µsHTTP::Request::::uri_canonicalHTTP::Request::uri_canonical
11118µs21µsHTTP::Request::::BEGIN@7HTTP::Request::BEGIN@7
0000s0sHTTP::Request::::accept_decodableHTTP::Request::accept_decodable
0000s0sHTTP::Request::::as_stringHTTP::Request::as_string
0000s0sHTTP::Request::::cloneHTTP::Request::clone
0000s0sHTTP::Request::::dumpHTTP::Request::dump
0000s0sHTTP::Request::::parseHTTP::Request::parse
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package HTTP::Request;
2
31173µsrequire HTTP::Message;
4115µs@ISA = qw(HTTP::Message);
511µs$VERSION = "5.827";
6
7315.1ms225µ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
use strict;
# spent 21µs making 1 call to HTTP::Request::BEGIN@7 # spent 4µs making 1 call to strict::import
8
9
10
11sub 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
{
131568µs my($class, $method, $uri, $header, $content) = @_;
14 my $self = $class->SUPER::new($header, $content);
# spent 48µs making 3 calls to HTTP::Message::new, avg 16µs/call
15 $self->method($method);
# spent 44µs making 3 calls to HTTP::Request::method, avg 15µs/call
16 $self->uri($uri);
# spent 552µs making 3 calls to HTTP::Request::uri, avg 184µs/call
17 $self;
18}
19
20
21sub 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
42sub 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
52sub 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
{
541263µs1240µs shift->_elem('_method', @_);
# spent 40µs making 12 calls to HTTP::Message::_elem, avg 3µs/call
55}
56
57
58sub 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
{
606394µs my $self = shift;
61 my $old = $self->{'_uri'};
62 if (@_) {
63 my $uri = shift;
64 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 510µs making 3 calls to URI::new, avg 170µs/call
81 }
82 $self->{'_uri'} = $uri;
83 delete $self->{'_uri_canonical'};
84 }
85 $old;
86}
87
8812µs*url = \&uri; # legacy
89
90sub 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
{
92630µs my $self = shift;
93 return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
# spent 583µs making 3 calls to URI::http::canonical, avg 194µs/call
94}
95
96
97sub accept_decodable
98{
99 my $self = shift;
100 $self->header("Accept-Encoding", scalar($self->decodable));
101}
102
103sub 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
119sub 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
134120µs1;
135
136__END__
137
138=head1 NAME
139
140HTTP::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
147and usually used like this:
148
149 $ua = LWP::UserAgent->new;
150 $response = $ua->request($request);
151
152=head1 DESCRIPTION
153
154C<HTTP::Request> is a class encapsulating HTTP style requests,
155consisting of a request line, some headers, and a content body. Note
156that the LWP library uses HTTP style requests even for non-HTTP
157protocols. Instances of this class are usually passed to the
158request() method of an C<LWP::UserAgent> object.
159
160C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
161inherits 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
171Constructs a new C<HTTP::Request> object describing a request on the
172object $uri using method $method. The $method argument must be a
173string. The $uri argument can be either a string, or a reference to a
174C<URI> object. The optional $header argument should be a reference to
175an C<HTTP::Headers> object or a plain array reference of key/value
176pairs. The optional $content argument should be a string of bytes.
177
178=item $r = HTTP::Request->parse( $str )
179
180This constructs a new request object by parsing the given string.
181
182=item $r->method
183
184=item $r->method( $val )
185
186This is used to get/set the method attribute. The method should be a
187short string like "GET", "HEAD", "PUT" or "POST".
188
189=item $r->uri
190
191=item $r->uri( $val )
192
193This is used to get/set the uri attribute. The $val can be a
194reference to a URI object or a plain string. If a string is given,
195then it should be parseable as an absolute URI.
196
197=item $r->header( $field )
198
199=item $r->header( $field => $value )
200
201This is used to get/set header values and it is inherited from
202C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for
203details and other similar methods that can be used to access the
204headers.
205
206=item $r->accept_decodable
207
208This will set the C<Accept-Encoding> header to the list of encodings
209that decoded_content() can decode.
210
211=item $r->content
212
213=item $r->content( $bytes )
214
215This is used to get/set the content and it is inherited from the
216C<HTTP::Message> base class. See L<HTTP::Message> for details and
217other methods that can be used to access the content.
218
219Note that the content should be a string of bytes. Strings in perl
220can contain characters outside the range of a byte. The C<Encode>
221module 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
227Method returning a textual representation of the request.
228
229=back
230
231=head1 SEE ALSO
232
233L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
234L<HTTP::Response>
235
236=head1 COPYRIGHT
237
238Copyright 1995-2004 Gisle Aas.
239
240This library is free software; you can redistribute it and/or
241modify it under the same terms as Perl itself.
242