← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File /usr/local/lib/perl5/site_perl/5.10.1/URI/_server.pm
Statements Executed 2357
Statement Execution Time 6.74ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
123331.85ms4.26msURI::_server::::hostURI::_server::host
42111.12ms6.38msURI::_server::::_uric_escapeURI::_server::_uric_escape
41111.02ms5.24msURI::_server::::canonicalURI::_server::canonical
4211860µs4.76msURI::_server::::_host_escapeURI::_server::_host_escape
8221819µs1.49msURI::_server::::_portURI::_server::_port
4111404µs1.07msURI::_server::::portURI::_server::port
20742248µs248µsURI::_server::::CORE:matchURI::_server::CORE:match (opcode)
45352221µs221µsURI::_server::::CORE:substURI::_server::CORE:subst (opcode)
11115µs17µsURI::_server::::BEGIN@5URI::_server::BEGIN@5
11214µs14µsURI::_server::::CORE:regcompURI::_server::CORE:regcomp (opcode)
11113µs53µsURI::_server::::BEGIN@6URI::_server::BEGIN@6
0000s0sURI::_server::::as_iriURI::_server::as_iri
0000s0sURI::_server::::default_portURI::_server::default_port
0000s0sURI::_server::::host_portURI::_server::host_port
0000s0sURI::_server::::ihostURI::_server::ihost
0000s0sURI::_server::::userinfoURI::_server::userinfo
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package URI::_server;
21115µsrequire URI::_generic;
316µs@ISA=qw(URI::_generic);
4
5322µs220µs
# spent 17µs (15+3) within URI::_server::BEGIN@5 which was called # once (15µs+3µs) by URI::implementor at line 5
use strict;
# spent 17µs making 1 call to URI::_server::BEGIN@5 # spent 3µs making 1 call to strict::import
63866µs293µs
# spent 53µs (13+40) within URI::_server::BEGIN@6 which was called # once (13µs+40µs) by URI::implementor at line 6
use URI::Escape qw(uri_unescape);
# spent 53µs making 1 call to URI::_server::BEGIN@6 # spent 40µs making 1 call to Exporter::import
7
8
# spent 6.38ms (1.12+5.26) within URI::_server::_uric_escape which was called 42 times, avg 152µs/call: # 42 times (1.12ms+5.26ms) by URI::_init at line 81 of URI.pm, avg 152µs/call
sub _uric_escape {
92941.23ms my($class, $str) = @_;
10 if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
# spent 127µs making 42 calls to URI::_server::CORE:match, avg 3µs/call # spent 14µs making 1 call to URI::_server::CORE:regcomp
11 my($scheme, $host, $rest) = ($1, $2, $3);
12 my $ui = $host =~ s/(.*@)// ? $1 : "";
# spent 23µs making 42 calls to URI::_server::CORE:subst, avg 552ns/call
13 my $port = $host =~ s/(:\d+)\z// ? $1 : "";
# spent 18µs making 42 calls to URI::_server::CORE:subst, avg 424ns/call
14 if (_host_escape($host)) {
# spent 4.76ms making 42 calls to URI::_server::_host_escape, avg 113µs/call
15 $str = "$scheme//$ui$host$port$rest";
16 }
17 }
18 return $class->SUPER::_uric_escape($str);
# spent 314µs making 42 calls to URI::_uric_escape, avg 7µs/call
19}
20
21
# spent 4.76ms (860µs+3.90) within URI::_server::_host_escape which was called 42 times, avg 113µs/call: # 42 times (860µs+3.90ms) by URI::_server::_uric_escape at line 14, avg 113µs/call
sub _host_escape {
22168512µs4237µs return unless $_[0] =~ /[^URI::uric]/;
# spent 37µs making 42 calls to URI::_server::CORE:match, avg 874ns/call
23 require URI::_idna;
24 $_[0] = URI::_idna::encode($_[0]);
# spent 2.52ms making 42 calls to URI::_idna::encode, avg 60µs/call
25 return 1;
26}
27
28sub as_iri {
29 my $self = shift;
30 my $str = $self->SUPER::as_iri;
31 if ($str =~ /\bxn--/) {
32 if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
33 my($scheme, $host, $rest) = ($1, $2, $3);
34 my $ui = $host =~ s/(.*@)// ? $1 : "";
35 my $port = $host =~ s/(:\d+)\z// ? $1 : "";
36 require URI::_idna;
37 $host = URI::_idna::encode($host);
38 $str = "$scheme//$ui$host$port$rest";
39 }
40 }
41 return $str;
42}
43
44sub userinfo
45{
46 my $self = shift;
47 my $old = $self->authority;
48
49 if (@_) {
50 my $new = $old;
51 $new = "" unless defined $new;
52 $new =~ s/.*@//; # remove old stuff
53 my $ui = shift;
54 if (defined $ui) {
55 $ui =~ s/@/%40/g; # protect @
56 $new = "$ui\@$new";
57 }
58 $self->authority($new);
59 }
60 return undef if !defined($old) || $old !~ /(.*)@/;
61 return $1;
62}
63
64sub host
65
# spent 4.26ms (1.85+2.41) within URI::_server::host which was called 123 times, avg 35µs/call: # 41 times (865µs+1.10ms) by URI::_server::canonical at line 146, avg 48µs/call # 41 times (553µs+755µs) by SimpleDB::Client::construct_request at line 177 of SimpleDB/Client.pm, avg 32µs/call # 41 times (430µs+551µs) by LWP::Protocol::http::request at line 148 of LWP/Protocol/http.pm, avg 24µs/call
{
669841.90ms my $self = shift;
67 my $old = $self->authority;
# spent 1.43ms making 123 calls to URI::_generic::authority, avg 12µs/call
68 if (@_) {
69 my $tmp = $old;
70 $tmp = "" unless defined $tmp;
71 my $ui = ($tmp =~ /(.*@)/) ? $1 : "";
72 my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
73 my $new = shift;
74 $new = "" unless defined $new;
75 if (length $new) {
76 $new =~ s/[@]/%40/g; # protect @
77 if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/) {
78 $new =~ s/(:\d*)\z// || die "Assert";
79 $port = $1;
80 }
81 $new = "[$new]" if $new =~ /:/ && $new !~ /^\[/; # IPv6 address
82 _host_escape($new);
83 }
84 $self->authority("$ui$new$port");
85 }
86 return undef unless defined $old;
87 $old =~ s/.*@//;
# spent 86µs making 123 calls to URI::_server::CORE:subst, avg 702ns/call
88 $old =~ s/:\d+$//; # remove the port
# spent 48µs making 123 calls to URI::_server::CORE:subst, avg 393ns/call
89 $old =~ s{^\[(.*)\]$}{$1}; # remove brackets around IPv6 (RFC 3986 3.2.2)
# spent 46µs making 123 calls to URI::_server::CORE:subst, avg 370ns/call
90 return uri_unescape($old);
# spent 796µs making 123 calls to URI::Escape::uri_unescape, avg 6µs/call
91}
92
93sub ihost
94{
95 my $self = shift;
96 my $old = $self->host(@_);
97 if ($old =~ /(^|\.)xn--/) {
98 require URI::_idna;
99 $old = URI::_idna::decode($old);
100 }
101 return $old;
102}
103
104sub _port
105
# spent 1.49ms (819µs+667µs) within URI::_server::_port which was called 82 times, avg 18µs/call: # 41 times (512µs+379µs) by URI::_server::canonical at line 147, avg 22µs/call # 41 times (308µs+288µs) by URI::_server::port at line 122, avg 15µs/call
{
106410750µs my $self = shift;
107 my $old = $self->authority;
# spent 615µs making 82 calls to URI::_generic::authority, avg 8µs/call
108 if (@_) {
109 my $new = $old;
110 $new =~ s/:\d*$//;
111 my $port = shift;
112 $new .= ":$port" if defined $port;
113 $self->authority($new);
114 }
115 return $1 if defined($old) && $old =~ /:(\d*)$/;
# spent 51µs making 82 calls to URI::_server::CORE:match, avg 627ns/call
116 return;
117}
118
119sub port
120
# spent 1.07ms (404µs+666µs) within URI::_server::port which was called 41 times, avg 26µs/call: # 41 times (404µs+666µs) by LWP::Protocol::http::request at line 149 of LWP/Protocol/http.pm, avg 26µs/call
{
121164323µs my $self = shift;
122 my $port = $self->_port(@_);
# spent 595µs making 41 calls to URI::_server::_port, avg 15µs/call
123 $port = $self->default_port if !defined($port) || $port eq "";
# spent 70µs making 41 calls to URI::http::default_port, avg 2µs/call
124 $port;
125}
126
127sub host_port
128{
129 my $self = shift;
130 my $old = $self->authority;
131 $self->host(shift) if @_;
132 return undef unless defined $old;
133 $old =~ s/.*@//; # zap userinfo
134 $old =~ s/:$//; # empty port should be treated the same a no port
135 $old .= ":" . $self->port unless $old =~ /:\d+$/;
136 $old;
137}
138
139
140sub default_port { undef }
141
142sub canonical
143
# spent 5.24ms (1.02+4.21) within URI::_server::canonical which was called 41 times, avg 128µs/call: # 41 times (1.02ms+4.21ms) by URI::http::canonical at line 13 of URI/http.pm, avg 128µs/call
{
1443281.01ms my $self = shift;
145 my $other = $self->SUPER::canonical;
# spent 1.32ms making 41 calls to URI::canonical, avg 32µs/call
146 my $host = $other->host || "";
# spent 1.97ms making 41 calls to URI::_server::host, avg 48µs/call
147 my $port = $other->_port;
# spent 890µs making 41 calls to URI::_server::_port, avg 22µs/call
148 my $uc_host = $host =~ /[A-Z]/;
# spent 33µs making 41 calls to URI::_server::CORE:match, avg 815ns/call
149 my $def_port = defined($port) && ($port eq "" ||
150 $port == $self->default_port);
151 if ($uc_host || $def_port) {
152 $other = $other->clone if $other == $self;
153 $other->host(lc $host) if $uc_host;
154 $other->port(undef) if $def_port;
155 }
156 $other;
157}
158
15913µs1;
# spent 248µs within URI::_server::CORE:match which was called 207 times, avg 1µs/call: # 82 times (51µs+0s) by URI::_server::_port at line 115 of URI/_server.pm, avg 627ns/call # 42 times (127µs+0s) by URI::_server::_uric_escape at line 10 of URI/_server.pm, avg 3µs/call # 42 times (37µs+0s) by URI::_server::_host_escape at line 22 of URI/_server.pm, avg 874ns/call # 41 times (33µs+0s) by URI::_server::canonical at line 148 of URI/_server.pm, avg 815ns/call
sub URI::_server::CORE:match; # xsub
# spent 14µs within URI::_server::CORE:regcomp which was called # once (14µs+0s) by URI::_server::_uric_escape at line 10 of URI/_server.pm
sub URI::_server::CORE:regcomp; # xsub
# spent 221µs within URI::_server::CORE:subst which was called 453 times, avg 488ns/call: # 123 times (86µs+0s) by URI::_server::host at line 87 of URI/_server.pm, avg 702ns/call # 123 times (48µs+0s) by URI::_server::host at line 88 of URI/_server.pm, avg 393ns/call # 123 times (46µs+0s) by URI::_server::host at line 89 of URI/_server.pm, avg 370ns/call # 42 times (23µs+0s) by URI::_server::_uric_escape at line 12 of URI/_server.pm, avg 552ns/call # 42 times (18µs+0s) by URI::_server::_uric_escape at line 13 of URI/_server.pm, avg 424ns/call
sub URI::_server::CORE:subst; # xsub