Filename	/usr/share/perl5/HTTP/Request.pm
Statements	Executed 7 statements in 723µs

Subroutines

Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	14µs	21µs	HTTP::Request::::BEGIN@7HTTP::Request::BEGIN@7
0	0	0	0s	0s	HTTP::Request::::accept_decodableHTTP::Request::accept_decodable
0	0	0	0s	0s	HTTP::Request::::as_stringHTTP::Request::as_string
0	0	0	0s	0s	HTTP::Request::::cloneHTTP::Request::clone
0	0	0	0s	0s	HTTP::Request::::dumpHTTP::Request::dump
0	0	0	0s	0s	HTTP::Request::::methodHTTP::Request::method
0	0	0	0s	0s	HTTP::Request::::newHTTP::Request::new
0	0	0	0s	0s	HTTP::Request::::parseHTTP::Request::parse
0	0	0	0s	0s	HTTP::Request::::uriHTTP::Request::uri
0	0	0	0s	0s	HTTP::Request::::uri_canonicalHTTP::Request::uri_canonical

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package HTTP::Request;
2
3	1	900ns			require HTTP::Message;
4	1	8µs			@ISA = qw(HTTP::Message);
5	1	300ns			$VERSION = "6.00";
6
7	2	708µs	2	27µs	# spent 21µs (14+7) within HTTP::Request::BEGIN@7 which was called: # once (14µs+7µs) by LWP::UserAgent::BEGIN@10 at line 7 use strict; # spent 21µs making 1 call to HTTP::Request::BEGIN@7 # spent 7µs making 1 call to strict::import
8
- -
11					sub new
12					{
13					my($class, $method, $uri, $header, $content) = @_;
14					my $self = $class->SUPER::new($header, $content);
15					$self->method($method);
16					$self->uri($uri);
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					{
54					shift->_elem('_method', @_);
55					}
56
57
58					sub uri
59					{
60					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);
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					{
92					my $self = shift;
93					return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
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	4µs			1;
135
136					__END__