← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:29 2013

Filename/usr/share/perl5/HTTP/Request.pm
StatementsExecuted 8 statements in 875µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11118µs22µ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::::methodHTTP::Request::method
0000s0sHTTP::Request::::newHTTP::Request::new
0000s0sHTTP::Request::::parseHTTP::Request::parse
0000s0sHTTP::Request::::uriHTTP::Request::uri
0000s0sHTTP::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
1package HTTP::Request;
2
3183µsrequire HTTP::Message;
4119µs@ISA = qw(HTTP::Message);
511µs$VERSION = "5.827";
6
73762µs226µs
# spent 22µs (18+4) within HTTP::Request::BEGIN@7 which was called: # once (18µs+4µs) by LWP::UserAgent::BEGIN@10 at line 7
use strict;
# spent 22µs making 1 call to HTTP::Request::BEGIN@7 # spent 4µs making 1 call to strict::import
8
- -
11sub 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
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{
54 shift->_elem('_method', @_);
55}
56
57
58sub 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
8812µs*url = \&uri; # legacy
89
90sub uri_canonical
91{
92 my $self = shift;
93 return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
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
13417µs1;
135
136__END__