File | /usr/local/lib/perl5/site_perl/5.10.1/URI/_server.pm |
Statements Executed | 191 |
Statement Execution Time | 1.67ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4 | 1 | 1 | 461µs | 2.03ms | _host_escape | URI::_server::
9 | 3 | 3 | 156µs | 403µs | host | URI::_server::
4 | 1 | 1 | 115µs | 2.22ms | _uric_escape | URI::_server::
3 | 1 | 1 | 87µs | 411µs | canonical | URI::_server::
6 | 2 | 1 | 63µs | 112µs | _port | URI::_server::
3 | 1 | 1 | 36µs | 86µs | port | URI::_server::
17 | 4 | 2 | 25µs | 25µs | CORE:match (opcode) | URI::_server::
35 | 5 | 2 | 19µs | 19µs | CORE:subst (opcode) | URI::_server::
1 | 1 | 1 | 15µs | 18µs | BEGIN@5 | URI::_server::
1 | 1 | 2 | 14µs | 14µs | CORE:regcomp (opcode) | URI::_server::
1 | 1 | 1 | 8µs | 49µs | BEGIN@6 | URI::_server::
0 | 0 | 0 | 0s | 0s | as_iri | URI::_server::
0 | 0 | 0 | 0s | 0s | default_port | URI::_server::
0 | 0 | 0 | 0s | 0s | host_port | URI::_server::
0 | 0 | 0 | 0s | 0s | ihost | URI::_server::
0 | 0 | 0 | 0s | 0s | userinfo | URI::_server::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package URI::_server; | ||||
2 | 1 | 92µs | require URI::_generic; | ||
3 | 1 | 6µs | @ISA=qw(URI::_generic); | ||
4 | |||||
5 | 3 | 33µs | 2 | 20µ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 # spent 18µs making 1 call to URI::_server::BEGIN@5
# spent 3µs making 1 call to strict::import |
6 | 3 | 940µs | 2 | 90µ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 # 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 | ||||
9 | 28 | 140µs | my($class, $str) = @_; | ||
10 | 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 | ||||
22 | 16 | 113µs | 4 | 4µ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 | |||||
28 | sub 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 | |||||
44 | sub 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 | |||||
64 | sub 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 | ||||
66 | 72 | 167µ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 | |||||
93 | sub 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 | |||||
104 | sub _port | ||||
105 | { | ||||
106 | 30 | 60µ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 | |||||
119 | sub 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 | ||||
121 | 12 | 30µ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 | |||||
127 | sub 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 | |||||
140 | sub default_port { undef } | ||||
141 | |||||
142 | sub 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 | ||||
144 | 24 | 82µ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 | |||||
159 | 1 | 3µs | 1; | ||
# 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 | |||||
# 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 | |||||
# 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 |