← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:59 2010

File /project/perl/lib/URI/_server.pm
Statements Executed 7385
Statement Execution Time 94.3ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4611138.1ms88.7msURI::_server::::hostURI::_server::host
4611125.4ms79.2msURI::_server::::portURI::_server::port
4611123.9ms48.3msURI::_server::::_portURI::_server::_port
922224.91ms4.91msURI::_server::::CORE:substURI::_server::CORE:subst (opcode)
461122.46ms2.46msURI::_server::::CORE:matchURI::_server::CORE:match (opcode)
0000s0sURI::_server::::BEGINURI::_server::BEGIN
0000s0sURI::_server::::canonicalURI::_server::canonical
0000s0sURI::_server::::default_portURI::_server::default_port
0000s0sURI::_server::::host_portURI::_server::host_port
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;
21241µsrequire URI::_generic;
317µs@ISA=qw(URI::_generic);
4
53101µs124µsuse strict;
# spent 24µs making 1 call to strict::import
631.40ms1313µsuse URI::Escape qw(uri_unescape);
# spent 313µs making 1 call to Exporter::import
7
8sub userinfo
9{
10 my $self = shift;
11 my $old = $self->authority;
12
13 if (@_) {
14 my $new = $old;
15 $new = "" unless defined $new;
16 $new =~ s/.*@//; # remove old stuff
17 my $ui = shift;
18 if (defined $ui) {
19 $ui =~ s/@/%40/g; # protect @
20 $new = "$ui\@$new";
21 }
22 $self->authority($new);
23 }
24 return undef if !defined($old) || $old !~ /(.*)@/;
25 return $1;
26}
27
28sub host
29
# spent 88.7ms (38.1+50.6) within URI::_server::host which was called 461 times, avg 192µs/call: # 461 times (38.1ms+50.6ms) by LWP::Protocol::http::request at line 147 of LWP/Protocol/http.pm, avg 192µs/call
{
304612.23ms my $self = shift;
314618.18ms46126.4ms my $old = $self->authority;
# spent 26.4ms making 461 calls to URI::_generic::authority, avg 57µs/call
324612.03ms if (@_) {
33 my $tmp = $old;
34 $tmp = "" unless defined $tmp;
35 my $ui = ($tmp =~ /(.*@)/) ? $1 : "";
36 my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
37 my $new = shift;
38 $new = "" unless defined $new;
39 if (length $new) {
40 $new =~ s/[@]/%40/g; # protect @
41 $port = $1 if $new =~ s/(:\d+)$//;
42 }
43 $self->authority("$ui$new$port");
44 }
454612.00ms return undef unless defined $old;
464619.09ms4612.80ms $old =~ s/.*@//;
# spent 2.80ms making 461 calls to URI::_server::CORE:subst, avg 6µs/call
474617.07ms4612.11ms $old =~ s/:\d+$//;
# spent 2.11ms making 461 calls to URI::_server::CORE:subst, avg 5µs/call
4846111.8ms46119.3ms return uri_unescape($old);
# spent 19.3ms making 461 calls to URI::Escape::uri_unescape, avg 42µs/call
49}
50
51sub _port
52
# spent 48.3ms (23.9+24.5) within URI::_server::_port which was called 461 times, avg 105µs/call: # 461 times (23.9ms+24.5ms) by URI::_server::port at line 69, avg 105µs/call
{
534612.12ms my $self = shift;
544617.25ms46122.0ms my $old = $self->authority;
# spent 22.0ms making 461 calls to URI::_generic::authority, avg 48µs/call
554612.15ms if (@_) {
56 my $new = $old;
57 $new =~ s/:\d*$//;
58 my $port = shift;
59 $new .= ":$port" if defined $port;
60 $self->authority($new);
61 }
624618.48ms4612.46ms return $1 if defined($old) && $old =~ /:(\d*)$/;
# spent 2.46ms making 461 calls to URI::_server::CORE:match, avg 5µs/call
634615.71ms return;
64}
65
66sub port
67
# spent 79.2ms (25.4+53.8) within URI::_server::port which was called 461 times, avg 172µs/call: # 461 times (25.4ms+53.8ms) by LWP::Protocol::http::request at line 148 of LWP/Protocol/http.pm, avg 172µs/call
{
684612.29ms my $self = shift;
694617.28ms46148.3ms my $port = $self->_port(@_);
# spent 48.3ms making 461 calls to URI::_server::_port, avg 105µs/call
704618.92ms4615.46ms $port = $self->default_port if !defined($port) || $port eq "";
# spent 5.46ms making 461 calls to URI::http::default_port, avg 12µs/call
714615.92ms $port;
72}
73
74sub host_port
75{
76 my $self = shift;
77 my $old = $self->authority;
78 $self->host(shift) if @_;
79 return undef unless defined $old;
80 $old =~ s/.*@//; # zap userinfo
81 $old =~ s/:$//; # empty port does not could
82 $old .= ":" . $self->port unless $old =~ /:/;
83 $old;
84}
85
86
87sub default_port { undef }
88
89sub canonical
90{
91 my $self = shift;
92 my $other = $self->SUPER::canonical;
93 my $host = $other->host || "";
94 my $port = $other->_port;
95 my $uc_host = $host =~ /[A-Z]/;
96 my $def_port = defined($port) && ($port eq "" ||
97 $port == $self->default_port);
98 if ($uc_host || $def_port) {
99 $other = $other->clone if $other == $self;
100 $other->host(lc $host) if $uc_host;
101 $other->port(undef) if $def_port;
102 }
103 $other;
104}
105
106111µs1;
# spent 2.46ms within URI::_server::CORE:match which was called 461 times, avg 5µs/call: # 461 times (2.46ms+0s) by URI::_server::_port at line 62 of URI/_server.pm, avg 5µs/call
sub URI::_server::CORE:match; # xsub
# spent 4.91ms within URI::_server::CORE:subst which was called 922 times, avg 5µs/call: # 461 times (2.80ms+0s) by URI::_server::host at line 46 of URI/_server.pm, avg 6µs/call # 461 times (2.11ms+0s) by URI::_server::host at line 47 of URI/_server.pm, avg 5µs/call
sub URI::_server::CORE:subst; # xsub