← 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 11:58:52 2013
Reported on Tue Oct 15 12:02:05 2013

Filename/usr/share/perl5/HTTP/Config.pm
StatementsExecuted 18 statements in 1.69ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11126µs32µsHTTP::Config::::BEGIN@3HTTP::Config::BEGIN@3
11116µs60µsHTTP::Config::::BEGIN@5HTTP::Config::BEGIN@5
11111µs11µsHTTP::Config::::newHTTP::Config::new
11110µs10µsHTTP::Config::::BEGIN@4HTTP::Config::BEGIN@4
1116µs6µsHTTP::Config::::addHTTP::Config::add
0000s0sHTTP::Config::::__ANON__[:100]HTTP::Config::__ANON__[:100]
0000s0sHTTP::Config::::__ANON__[:105]HTTP::Config::__ANON__[:105]
0000s0sHTTP::Config::::__ANON__[:116]HTTP::Config::__ANON__[:116]
0000s0sHTTP::Config::::__ANON__[:121]HTTP::Config::__ANON__[:121]
0000s0sHTTP::Config::::__ANON__[:127]HTTP::Config::__ANON__[:127]
0000s0sHTTP::Config::::__ANON__[:131]HTTP::Config::__ANON__[:131]
0000s0sHTTP::Config::::__ANON__[:135]HTTP::Config::__ANON__[:135]
0000s0sHTTP::Config::::__ANON__[:141]HTTP::Config::__ANON__[:141]
0000s0sHTTP::Config::::__ANON__[:152]HTTP::Config::__ANON__[:152]
0000s0sHTTP::Config::::__ANON__[:159]HTTP::Config::__ANON__[:159]
0000s0sHTTP::Config::::__ANON__[:167]HTTP::Config::__ANON__[:167]
0000s0sHTTP::Config::::__ANON__[:71]HTTP::Config::__ANON__[:71]
0000s0sHTTP::Config::::__ANON__[:76]HTTP::Config::__ANON__[:76]
0000s0sHTTP::Config::::__ANON__[:81]HTTP::Config::__ANON__[:81]
0000s0sHTTP::Config::::__ANON__[:86]HTTP::Config::__ANON__[:86]
0000s0sHTTP::Config::::__ANON__[:91]HTTP::Config::__ANON__[:91]
0000s0sHTTP::Config::::add_itemHTTP::Config::add_item
0000s0sHTTP::Config::::emptyHTTP::Config::empty
0000s0sHTTP::Config::::entriesHTTP::Config::entries
0000s0sHTTP::Config::::findHTTP::Config::find
0000s0sHTTP::Config::::find2HTTP::Config::find2
0000s0sHTTP::Config::::matchingHTTP::Config::matching
0000s0sHTTP::Config::::matching_itemsHTTP::Config::matching_items
0000s0sHTTP::Config::::removeHTTP::Config::remove
0000s0sHTTP::Config::::remove_itemsHTTP::Config::remove_items
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package HTTP::Config;
2
3338µs239µs
# spent 32µs (26+7) within HTTP::Config::BEGIN@3 which was called: # once (26µs+7µs) by LWP::UserAgent::add_handler at line 3
use strict;
# spent 32µs making 1 call to HTTP::Config::BEGIN@3 # spent 7µs making 1 call to strict::import
4332µs110µs
# spent 10µs within HTTP::Config::BEGIN@4 which was called: # once (10µs+0s) by LWP::UserAgent::add_handler at line 4
use URI;
# spent 10µs making 1 call to HTTP::Config::BEGIN@4
531.53ms2104µs
# spent 60µs (16+44) within HTTP::Config::BEGIN@5 which was called: # once (16µs+44µs) by LWP::UserAgent::add_handler at line 5
use vars qw($VERSION);
# spent 60µs making 1 call to HTTP::Config::BEGIN@5 # spent 44µs making 1 call to vars::import
6
71900ns$VERSION = "5.835";
8
9
# spent 11µs within HTTP::Config::new which was called: # once (11µs+0s) by LWP::UserAgent::add_handler at line 700 of LWP/UserAgent.pm
sub new {
1011µs my $class = shift;
11115µs return bless [], $class;
12}
13
14sub entries {
15 my $self = shift;
16 @$self;
17}
18
19sub empty {
20 my $self = shift;
21 not @$self;
22}
23
24
# spent 6µs within HTTP::Config::add which was called: # once (6µs+0s) by LWP::UserAgent::add_handler at line 702 of LWP/UserAgent.pm
sub add {
2511µs if (@_ == 2) {
26 my $self = shift;
27 push(@$self, shift);
28 return;
29 }
3012µs my($self, %spec) = @_;
3111µs push(@$self, \%spec);
3214µs return;
33}
34
35sub find2 {
36 my($self, %spec) = @_;
37 my @found;
38 my @rest;
39 ITEM:
40 for my $item (@$self) {
41 for my $k (keys %spec) {
42 if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) {
43 push(@rest, $item);
44 next ITEM;
45 }
46 }
47 push(@found, $item);
48 }
49 return \@found unless wantarray;
50 return \@found, \@rest;
51}
52
53sub find {
54 my $self = shift;
55 my $f = $self->find2(@_);
56 return @$f if wantarray;
57 return $f->[0];
58}
59
60sub remove {
61 my($self, %spec) = @_;
62 my($removed, $rest) = $self->find2(%spec);
63 @$self = @$rest if @$removed;
64 return @$removed;
65}
66
67my %MATCH = (
68 m_scheme => sub {
69 my($v, $uri) = @_;
70 return $uri->_scheme eq $v; # URI known to be canonical
71 },
72 m_secure => sub {
73 my($v, $uri) = @_;
74 my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
75 return $secure == !!$v;
76 },
77 m_host_port => sub {
78 my($v, $uri) = @_;
79 return unless $uri->can("host_port");
80 return $uri->host_port eq $v, 7;
81 },
82 m_host => sub {
83 my($v, $uri) = @_;
84 return unless $uri->can("host");
85 return $uri->host eq $v, 6;
86 },
87 m_port => sub {
88 my($v, $uri) = @_;
89 return unless $uri->can("port");
90 return $uri->port eq $v;
91 },
92 m_domain => sub {
93 my($v, $uri) = @_;
94 return unless $uri->can("host");
95 my $h = $uri->host;
96 $h = "$h.local" unless $h =~ /\./;
97 $v = ".$v" unless $v =~ /^\./;
98 return length($v), 5 if substr($h, -length($v)) eq $v;
99 return 0;
100 },
101 m_path => sub {
102 my($v, $uri) = @_;
103 return unless $uri->can("path");
104 return $uri->path eq $v, 4;
105 },
106 m_path_prefix => sub {
107 my($v, $uri) = @_;
108 return unless $uri->can("path");
109 my $path = $uri->path;
110 my $len = length($v);
111 return $len, 3 if $path eq $v;
112 return 0 if length($path) <= $len;
113 $v .= "/" unless $v =~ m,/\z,,;
114 return $len, 3 if substr($path, 0, length($v)) eq $v;
115 return 0;
116 },
117 m_path_match => sub {
118 my($v, $uri) = @_;
119 return unless $uri->can("path");
120 return $uri->path =~ $v;
121 },
122 m_uri__ => sub {
123 my($v, $k, $uri) = @_;
124 return unless $uri->can($k);
125 return 1 unless defined $v;
126 return $uri->$k eq $v;
127 },
128 m_method => sub {
129 my($v, $uri, $request) = @_;
130 return $request && $request->method eq $v;
131 },
132 m_proxy => sub {
133 my($v, $uri, $request) = @_;
134 return $request && ($request->{proxy} || "") eq $v;
135 },
136 m_code => sub {
137 my($v, $uri, $request, $response) = @_;
138 $v =~ s/xx\z//;
139 return unless $response;
140 return length($v), 2 if substr($response->code, 0, length($v)) eq $v;
141 },
142 m_media_type => sub { # for request too??
143 my($v, $uri, $request, $response) = @_;
144 return unless $response;
145 return 1, 1 if $v eq "*/*";
146 my $ct = $response->content_type;
147 return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
148 return 3, 1 if $v eq "html" && $response->content_is_html;
149 return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
150 return 10, 1 if $v eq $ct;
151 return 0;
152 },
153 m_header__ => sub {
154 my($v, $k, $uri, $request, $response) = @_;
155 return unless $request;
156 return 1 if $request->header($k) eq $v;
157 return 1 if $response && $response->header($k) eq $v;
158 return 0;
159 },
160 m_response_attr__ => sub {
161 my($v, $k, $uri, $request, $response) = @_;
162 return unless $response;
163 return 1 if !defined($v) && exists $response->{$k};
164 return 0 unless exists $response->{$k};
165 return 1 if $response->{$k} eq $v;
166 return 0;
167 },
168154µs);
169
170sub matching {
171 my $self = shift;
172 if (@_ == 1) {
173 if ($_[0]->can("request")) {
174 unshift(@_, $_[0]->request);
175 unshift(@_, undef) unless defined $_[0];
176 }
177 unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical");
178 }
179 my($uri, $request, $response) = @_;
180 $uri = URI->new($uri) unless ref($uri);
181
182 my @m;
183 ITEM:
184 for my $item (@$self) {
185 my $order;
186 for my $ikey (keys %$item) {
187 my $mkey = $ikey;
188 my $k;
189 $k = $1 if $mkey =~ s/__(.*)/__/;
190 if (my $m = $MATCH{$mkey}) {
191 #print "$ikey $mkey\n";
192 my($c, $o);
193 my @arg = (
194 defined($k) ? $k : (),
195 $uri, $request, $response
196 );
197 my $v = $item->{$ikey};
198 $v = [$v] unless ref($v) eq "ARRAY";
199 for (@$v) {
200 ($c, $o) = $m->($_, @arg);
201 #print " - $_ ==> $c $o\n";
202 last if $c;
203 }
204 next ITEM unless $c;
205 $order->[$o || 0] += $c;
206 }
207 }
208 $order->[7] ||= 0;
209 $item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order);
210 push(@m, $item);
211 }
212 @m = sort { $b->{_order} cmp $a->{_order} } @m;
213 delete $_->{_order} for @m;
214 return @m if wantarray;
215 return $m[0];
216}
217
218sub add_item {
219 my $self = shift;
220 my $item = shift;
221 return $self->add(item => $item, @_);
222}
223
224sub remove_items {
225 my $self = shift;
226 return map $_->{item}, $self->remove(@_);
227}
228
229sub matching_items {
230 my $self = shift;
231 return map $_->{item}, $self->matching(@_);
232}
233
23419µs1;
235
236__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.