← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:45 2010

File /project/perl/lib/HTTP/Request.pm
Statements Executed 11072
Statement Execution Time 134ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
13833359.1ms210msHTTP::Request::::uriHTTP::Request::uri
4611137.9ms295msHTTP::Request::::newHTTP::Request::new
13833336.8ms81.3msHTTP::Request::::methodHTTP::Request::method
11220µs20µsHTTP::Request::::CORE:matchHTTP::Request::CORE:match (opcode)
0000s0sHTTP::Request::::BEGINHTTP::Request::BEGIN
0000s0sHTTP::Request::::as_stringHTTP::Request::as_string
0000s0sHTTP::Request::::cloneHTTP::Request::clone
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
3# $Id: Request.pm,v 1.40 2004/04/07 10:44:47 gisle Exp $
4
51231µsrequire HTTP::Message;
6111µs@ISA = qw(HTTP::Message);
71102µs120µs$VERSION = sprintf("%d.%02d", q$Revision: 1.40 $ =~ /(\d+)\.(\d+)/);
# spent 20µs making 1 call to HTTP::Request::CORE:match
8
931.16ms126µsuse strict;
# spent 26µs making 1 call to strict::import
10
11
12
13sub 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
{
15230537.3ms my($class, $method, $uri, $header, $content) = @_;
16 my $self = $class->SUPER::new($header, $content);
# spent 43.0ms making 461 calls to HTTP::Message::new, avg 93µs/call
17 $self->method($method);
# spent 28.4ms making 461 calls to HTTP::Request::method, avg 62µs/call
18 $self->uri($uri);
# spent 186ms making 461 calls to HTTP::Request::uri, avg 403µs/call
19 $self;
20}
21
22
23sub 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
44sub 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
54sub 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
{
56138333.6ms138344.5ms shift->_elem('_method', @_);
# spent 44.5ms making 1383 calls to HTTP::Message::_elem, avg 32µs/call
57}
58
59
60sub 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
{
62737661.9ms my $self = shift;
63 my $old = $self->{'_uri'};
64 if (@_) {
65 my $uri = shift;
66 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 $uri = $HTTP::URI_CLASS->new($uri);
# spent 151ms making 461 calls to URI::new, avg 327µs/call
83 }
84 $self->{'_uri'} = $uri;
85 }
86 $old;
87}
88
8917µs*url = \&uri; # legacy
90
91
92sub 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
109118µs1;
110
111__END__
112
113=head1 NAME
114
115HTTP::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
122and usually used like this:
123
124 $ua = LWP::UserAgent->new;
125 $response = $ua->request($request);
126
127=head1 DESCRIPTION
128
129C<HTTP::Request> is a class encapsulating HTTP style requests,
130consisting of a request line, some headers, and a content body. Note
131that the LWP library uses HTTP style requests even for non-HTTP
132protocols. Instances of this class are usually passed to the
133request() method of an C<LWP::UserAgent> object.
134
135C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
136inherits 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
146Constructs a new C<HTTP::Request> object describing a request on the
147object $uri using method $method. The $method argument must be a
148string. The $uri argument can be either a string, or a reference to a
149C<URI> object. The optional $header argument should be a reference to
150an C<HTTP::Headers> object or a plain array reference of key/value
151pairs. The optional $content argument should be a string of bytes.
152
153=item $r = HTTP::Request->parse( $str )
154
155This constructs a new request object by parsing the given string.
156
157=item $r->method
158
159=item $r->method( $val )
160
161This is used to get/set the method attribute. The method should be a
162short string like "GET", "HEAD", "PUT" or "POST".
163
164=item $r->uri
165
166=item $r->uri( $val )
167
168This is used to get/set the uri attribute. The $val can be a
169reference to a URI object or a plain string. If a string is given,
170then it should be parseable as an absolute URI.
171
172=item $r->header( $field )
173
174=item $r->header( $field => $value )
175
176This is used to get/set header values and it is inherited from
177C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for
178details and other similar methods that can be used to access the
179headers.
180
181=item $r->content
182
183=item $r->content( $content )
184
185This is used to get/set the content and it is inherited from the
186C<HTTP::Message> base class. See L<HTTP::Message> for details and
187other methods that can be used to access the content.
188
189Note that the content should be a string of bytes. Strings in perl
190can contain characters outside the range of a byte. The C<Encode>
191module 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
197Method returning a textual representation of the request.
198
199=back
200
201=head1 SEE ALSO
202
203L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
204L<HTTP::Response>
205
206=head1 COPYRIGHT
207
208Copyright 1995-2004 Gisle Aas.
209
210This library is free software; you can redistribute it and/or
211modify 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
sub HTTP::Request::CORE:match; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.