| 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 | HTTP::Request::uri |
| 3 | 1 | 1 | 80µs | 724µs | HTTP::Request::new |
| 12 | 4 | 3 | 71µs | 111µs | HTTP::Request::method |
| 3 | 1 | 1 | 33µs | 616µs | HTTP::Request::uri_canonical |
| 1 | 1 | 1 | 18µs | 21µs | HTTP::Request::BEGIN@7 |
| 0 | 0 | 0 | 0s | 0s | HTTP::Request::accept_decodable |
| 0 | 0 | 0 | 0s | 0s | HTTP::Request::as_string |
| 0 | 0 | 0 | 0s | 0s | HTTP::Request::clone |
| 0 | 0 | 0 | 0s | 0s | HTTP::Request::dump |
| 0 | 0 | 0 | 0s | 0s | HTTP::Request::parse |
| 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 | 15 | 68µ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 | |||||
| 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 | 63 | 94µ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 | |||||
| 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 | 6 | 30µ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 | |||||
| 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 |