← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:13 2010

File /usr/local/lib/perl5/site_perl/5.10.1/URI/_server.pm
Statements Executed 191
Statement Execution Time 1.67ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
411461µs2.03msURI::_server::::_host_escapeURI::_server::_host_escape
933156µs403µsURI::_server::::hostURI::_server::host
411115µs2.22msURI::_server::::_uric_escapeURI::_server::_uric_escape
31187µs411µsURI::_server::::canonicalURI::_server::canonical
62163µs112µsURI::_server::::_portURI::_server::_port
31136µs86µsURI::_server::::portURI::_server::port
174225µs25µsURI::_server::::CORE:matchURI::_server::CORE:match (opcode)
355219µs19µsURI::_server::::CORE:substURI::_server::CORE:subst (opcode)
11115µs18µsURI::_server::::BEGIN@5URI::_server::BEGIN@5
11214µs14µsURI::_server::::CORE:regcompURI::_server::CORE:regcomp (opcode)
1118µs49µ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;
2192µsrequire URI::_generic;
316µs@ISA=qw(URI::_generic);
4
5333µs220µs
# spent 18µ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 18µs making 1 call to URI::_server::BEGIN@5 # spent 3µs making 1 call to strict::import
63940µs290µs
# spent 49µs (8+41) within URI::_server::BEGIN@6 which was called # once (8µs+41µs) by URI::implementor at line 6
use URI::Escape qw(uri_unescape);
# spent 49µs making 1 call to URI::_server::BEGIN@6 # spent 41µs making 1 call to Exporter::import
7
8
# spent 2.22ms (115µs+2.10) within URI::_server::_uric_escape which was called 4 times, avg 554µs/call: # 4 times (115µs+2.10ms) by URI::_init at line 81 of URI.pm, avg 554µs/call
sub _uric_escape {
91291µs my($class, $str) = @_;
101649µs529µs if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
# spent 15µs making 4 calls to URI::_server::CORE:match, avg 4µ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 2µs making 4 calls to URI::_server::CORE:subst, avg 575ns/call
13 my $port = $host =~ s/(:\d+)\z// ? $1 : "";
# spent 1µs making 4 calls to URI::_server::CORE:subst, avg 350ns/call
14 if (_host_escape($host)) {
# spent 2.03ms making 4 calls to URI::_server::_host_escape, avg 508µs/call
15 $str = "$scheme//$ui$host$port$rest";
16 }
17 }
18 return $class->SUPER::_uric_escape($str);
# spent 39µs making 4 calls to URI::_uric_escape, avg 10µs/call
19}
20
21
# spent 2.03ms (461µs+1.57) within URI::_server::_host_escape which was called 4 times, avg 508µs/call: # 4 times (461µs+1.57ms) by URI::_server::_uric_escape at line 14, avg 508µs/call
sub _host_escape {
2216113µs44µs return unless $_[0] =~ /[^URI::uric]/;
# spent 4µs making 4 calls to URI::_server::CORE:match, avg 900ns/call
23 require URI::_idna;
24 $_[0] = URI::_idna::encode($_[0]);
# spent 237µs making 4 calls to URI::_idna::encode, avg 59µ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 403µs (156+247) within URI::_server::host which was called 9 times, avg 45µs/call: # 3 times (48µs+99µs) by SimpleDB::Client::construct_request at line 172 of ../lib/SimpleDB/Client.pm, avg 49µs/call # 3 times (63µs+83µs) by URI::_server::canonical at line 146, avg 49µs/call # 3 times (44µs+64µs) by LWP::Protocol::http::request at line 148 of LWP/Protocol/http.pm, avg 36µs/call
{
6672167µs my $self = shift;
67 my $old = $self->authority;
# spent 162µs making 9 calls to URI::_generic::authority, avg 18µ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 8µs making 9 calls to URI::_server::CORE:subst, avg 900ns/call
88 $old =~ s/:\d+$//; # remove the port
# spent 3µs making 9 calls to URI::_server::CORE:subst, avg 367ns/call
89 $old =~ s{^\[(.*)\]$}{$1}; # remove brackets around IPv6 (RFC 3986 3.2.2)
# spent 4µs making 9 calls to URI::_server::CORE:subst, avg 456ns/call
90 return uri_unescape($old);
# spent 69µs making 9 calls to URI::Escape::uri_unescape, avg 8µ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 112µs (63+49) within URI::_server::_port which was called 6 times, avg 19µs/call: # 3 times (40µs+28µs) by URI::_server::canonical at line 147, avg 23µs/call # 3 times (23µs+20µs) by URI::_server::port at line 122, avg 15µs/call
{
1063060µs my $self = shift;
107 my $old = $self->authority;
# spent 45µs making 6 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 4µs making 6 calls to URI::_server::CORE:match, avg 633ns/call
116 return;
117}
118
119sub port
120
# spent 86µs (36+50) within URI::_server::port which was called 3 times, avg 29µs/call: # 3 times (36µs+50µs) by LWP::Protocol::http::request at line 149 of LWP/Protocol/http.pm, avg 29µs/call
{
1211230µs my $self = shift;
122 my $port = $self->_port(@_);
# spent 44µs making 3 calls to URI::_server::_port, avg 15µs/call
123 $port = $self->default_port if !defined($port) || $port eq "";
# spent 6µs making 3 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 411µs (87+324) within URI::_server::canonical which was called 3 times, avg 137µs/call: # 3 times (87µs+324µs) by URI::http::canonical at line 13 of URI/http.pm, avg 137µs/call
{
1442482µs my $self = shift;
145 my $other = $self->SUPER::canonical;
# spent 107µs making 3 calls to URI::canonical, avg 36µs/call
146 my $host = $other->host || "";
# spent 147µs making 3 calls to URI::_server::host, avg 49µs/call
147 my $port = $other->_port;
# spent 68µs making 3 calls to URI::_server::_port, avg 23µs/call
148 my $uc_host = $host =~ /[A-Z]/;
# spent 2µs making 3 calls to URI::_server::CORE:match, avg 767ns/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 25µs within URI::_server::CORE:match which was called 17 times, avg 1µs/call: # 6 times (4µs+0s) by URI::_server::_port at line 115 of URI/_server.pm, avg 633ns/call # 4 times (15µs+0s) by URI::_server::_uric_escape at line 10 of URI/_server.pm, avg 4µs/call # 4 times (4µs+0s) by URI::_server::_host_escape at line 22 of URI/_server.pm, avg 900ns/call # 3 times (2µs+0s) by URI::_server::canonical at line 148 of URI/_server.pm, avg 767ns/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 19µs within URI::_server::CORE:subst which was called 35 times, avg 549ns/call: # 9 times (8µs+0s) by URI::_server::host at line 87 of URI/_server.pm, avg 900ns/call # 9 times (4µs+0s) by URI::_server::host at line 89 of URI/_server.pm, avg 456ns/call # 9 times (3µs+0s) by URI::_server::host at line 88 of URI/_server.pm, avg 367ns/call # 4 times (2µs+0s) by URI::_server::_uric_escape at line 12 of URI/_server.pm, avg 575ns/call # 4 times (1µs+0s) by URI::_server::_uric_escape at line 13 of URI/_server.pm, avg 350ns/call
sub URI::_server::CORE:subst; # xsub