← 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:10 2010

File /usr/local/lib/perl5/site_perl/5.10.1/URI/_generic.pm
Statements Executed 125
Statement Execution Time 1.62ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
2143171µs291µsURI::_generic::::authorityURI::_generic::authority
2732114µs114µsURI::_generic::::CORE:matchURI::_generic::CORE:match (opcode)
31127µs36µsURI::_generic::::pathURI::_generic::path
11224µs24µsURI::_generic::::CORE:regcompURI::_generic::CORE:regcomp (opcode)
31121µs30µsURI::_generic::::path_queryURI::_generic::path_query
11115µs18µsURI::_generic::::BEGIN@6URI::_generic::BEGIN@6
2227µs7µsURI::_generic::::CORE:substURI::_generic::CORE:subst (opcode)
1117µs31µsURI::_generic::::BEGIN@7URI::_generic::BEGIN@7
1114µs4µsURI::_generic::::BEGIN@8URI::_generic::BEGIN@8
0000s0sURI::_generic::::_check_pathURI::_generic::_check_path
0000s0sURI::_generic::::_no_scheme_okURI::_generic::_no_scheme_ok
0000s0sURI::_generic::::_split_segmentURI::_generic::_split_segment
0000s0sURI::_generic::::absURI::_generic::abs
0000s0sURI::_generic::::path_segmentsURI::_generic::path_segments
0000s0sURI::_generic::::relURI::_generic::rel
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package URI::_generic;
21800nsrequire URI;
3179µsrequire URI::_query;
4111µs@ISA=qw(URI URI::_query);
5
6323µs221µs
# spent 18µs (15+3) within URI::_generic::BEGIN@6 which was called # once (15µs+3µs) by URI::implementor at line 6
use strict;
# spent 18µs making 1 call to URI::_generic::BEGIN@6 # spent 3µs making 1 call to strict::import
7321µs255µs
# spent 31µs (7+24) within URI::_generic::BEGIN@7 which was called # once (7µs+24µs) by URI::implementor at line 7
use URI::Escape qw(uri_unescape);
# spent 31µs making 1 call to URI::_generic::BEGIN@7 # spent 24µs making 1 call to Exporter::import
831.08ms14µs
# spent 4µs within URI::_generic::BEGIN@8 which was called # once (4µs+0s) by URI::implementor at line 8
use Carp ();
# spent 4µs making 1 call to URI::_generic::BEGIN@8
9
10213µs16µsmy $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g;
# spent 6µs making 1 call to URI::_generic::CORE:subst
1124µs11µsmy $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
# spent 1µs making 1 call to URI::_generic::CORE:subst
12
13sub _no_scheme_ok { 1 }
14
15sub authority
16
# spent 291µs (171+120) within URI::_generic::authority which was called 21 times, avg 14µs/call: # 9 times (94µs+68µs) by URI::_server::host at line 67 of URI/_server.pm, avg 18µs/call # 6 times (29µs+16µs) by URI::_server::_port at line 107 of URI/_server.pm, avg 8µs/call # 3 times (31µs+26µs) by LWP::Protocol::http::_fixup_header at line 87 of LWP/Protocol/http.pm, avg 19µs/call # 3 times (18µs+9µs) by URI::http::canonical at line 15 of URI/http.pm, avg 9µs/call
{
1784308µs my $self = shift;
18 $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;
# spent 96µs making 21 calls to URI::_generic::CORE:match, avg 5µs/call # spent 24µs making 1 call to URI::_generic::CORE:regcomp
19
20 if (@_) {
21 my $auth = shift;
22 $$self = $1;
23 my $rest = $3;
24 if (defined $auth) {
25 $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;
26 $$self .= "//$auth";
27 }
28 _check_path($rest, $$self);
29 $$self .= $rest;
30 }
31 $2;
32}
33
34sub path
35
# spent 36µs (27+9) within URI::_generic::path which was called 3 times, avg 12µs/call: # 3 times (27µs+9µs) by URI::http::canonical at line 15 of URI/http.pm, avg 12µs/call
{
361238µs my $self = shift;
37 $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
# spent 9µs making 3 calls to URI::_generic::CORE:match, avg 3µs/call
38
39 if (@_) {
40 $$self = $1;
41 my $rest = $3;
42 my $new_path = shift;
43 $new_path = "" unless defined $new_path;
44 $new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;
45 _check_path($new_path, $$self);
46 $$self .= $new_path . $rest;
47 }
48 $2;
49}
50
51sub path_query
52
# spent 30µs (21+9) within URI::_generic::path_query which was called 3 times, avg 10µs/call: # 3 times (21µs+9µs) by LWP::Protocol::http::request at line 150 of LWP/Protocol/http.pm, avg 10µs/call
{
531233µs my $self = shift;
54 $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
# spent 8µs making 3 calls to URI::_generic::CORE:match, avg 3µs/call
55
56 if (@_) {
57 $$self = $1;
58 my $rest = $3;
59 my $new_path = shift;
60 $new_path = "" unless defined $new_path;
61 $new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
62 _check_path($new_path, $$self);
63 $$self .= $new_path . $rest;
64 }
65 $2;
66}
67
68sub _check_path
69{
70 my($path, $pre) = @_;
71 my $prefix;
72 if ($pre =~ m,/,) { # authority present
73 $prefix = "/" if length($path) && $path !~ m,^[/?\#],;
74 }
75 else {
76 if ($path =~ m,^//,) {
77 Carp::carp("Path starting with double slash is confusing")
78 if $^W;
79 }
80 elsif (!length($pre) && $path =~ m,^[^:/?\#]+:,) {
81 Carp::carp("Path might look like scheme, './' prepended")
82 if $^W;
83 $prefix = "./";
84 }
85 }
86 substr($_[0], 0, 0) = $prefix if defined $prefix;
87}
88
89sub path_segments
90{
91 my $self = shift;
92 my $path = $self->path;
93 if (@_) {
94 my @arg = @_; # make a copy
95 for (@arg) {
96 if (ref($_)) {
97 my @seg = @$_;
98 $seg[0] =~ s/%/%25/g;
99 for (@seg) { s/;/%3B/g; }
100 $_ = join(";", @seg);
101 }
102 else {
103 s/%/%25/g; s/;/%3B/g;
104 }
105 s,/,%2F,g;
106 }
107 $self->path(join("/", @arg));
108 }
109 return $path unless wantarray;
110 map {/;/ ? $self->_split_segment($_)
111 : uri_unescape($_) }
112 split('/', $path, -1);
113}
114
115
116sub _split_segment
117{
118 my $self = shift;
119 require URI::_segment;
120 URI::_segment->new(@_);
121}
122
123
124sub abs
125{
126 my $self = shift;
127 my $base = shift || Carp::croak("Missing base argument");
128
129 if (my $scheme = $self->scheme) {
130 return $self unless $URI::ABS_ALLOW_RELATIVE_SCHEME;
131 $base = URI->new($base) unless ref $base;
132 return $self unless $scheme eq $base->scheme;
133 }
134
135 $base = URI->new($base) unless ref $base;
136 my $abs = $self->clone;
137 $abs->scheme($base->scheme);
138 return $abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;
139 $abs->authority($base->authority);
140
141 my $path = $self->path;
142 return $abs if $path =~ m,^/,;
143
144 if (!length($path)) {
145 my $abs = $base->clone;
146 my $query = $self->query;
147 $abs->query($query) if defined $query;
148 $abs->fragment($self->fragment);
149 return $abs;
150 }
151
152 my $p = $base->path;
153 $p =~ s,[^/]+$,,;
154 $p .= $path;
155 my @p = split('/', $p, -1);
156 shift(@p) if @p && !length($p[0]);
157 my $i = 1;
158 while ($i < @p) {
159 #print "$i ", join("/", @p), " ($p[$i])\n";
160 if ($p[$i-1] eq ".") {
161 splice(@p, $i-1, 1);
162 $i-- if $i > 1;
163 }
164 elsif ($p[$i] eq ".." && $p[$i-1] ne "..") {
165 splice(@p, $i-1, 2);
166 if ($i > 1) {
167 $i--;
168 push(@p, "") if $i == @p;
169 }
170 }
171 else {
172 $i++;
173 }
174 }
175 $p[-1] = "" if @p && $p[-1] eq "."; # trailing "/."
176 if ($URI::ABS_REMOTE_LEADING_DOTS) {
177 shift @p while @p && $p[0] =~ /^\.\.?$/;
178 }
179 $abs->path("/" . join("/", @p));
180 $abs;
181}
182
183# The oposite of $url->abs. Return a URI which is as relative as possible
184sub rel {
185 my $self = shift;
186 my $base = shift || Carp::croak("Missing base argument");
187 my $rel = $self->clone;
188 $base = URI->new($base) unless ref $base;
189
190 #my($scheme, $auth, $path) = @{$rel}{qw(scheme authority path)};
191 my $scheme = $rel->scheme;
192 my $auth = $rel->canonical->authority;
193 my $path = $rel->path;
194
195 if (!defined($scheme) && !defined($auth)) {
196 # it is already relative
197 return $rel;
198 }
199
200 #my($bscheme, $bauth, $bpath) = @{$base}{qw(scheme authority path)};
201 my $bscheme = $base->scheme;
202 my $bauth = $base->canonical->authority;
203 my $bpath = $base->path;
204
205 for ($bscheme, $bauth, $auth) {
206 $_ = '' unless defined
207 }
208
209 unless ($scheme eq $bscheme && $auth eq $bauth) {
210 # different location, can't make it relative
211 return $rel;
212 }
213
214 for ($path, $bpath) { $_ = "/$_" unless m,^/,; }
215
216 # Make it relative by eliminating scheme and authority
217 $rel->scheme(undef);
218 $rel->authority(undef);
219
220 # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
221 # First we calculate common initial path components length ($li).
222 my $li = 1;
223 while (1) {
224 my $i = index($path, '/', $li);
225 last if $i < 0 ||
226 $i != index($bpath, '/', $li) ||
227 substr($path,$li,$i-$li) ne substr($bpath,$li,$i-$li);
228 $li=$i+1;
229 }
230 # then we nuke it from both paths
231 substr($path, 0,$li) = '';
232 substr($bpath,0,$li) = '';
233
234 if ($path eq $bpath &&
235 defined($rel->fragment) &&
236 !defined($rel->query)) {
237 $rel->path("");
238 }
239 else {
240 # Add one "../" for each path component left in the base path
241 $path = ('../' x $bpath =~ tr|/|/|) . $path;
242 $path = "./" if $path eq "";
243 $rel->path($path);
244 }
245
246 $rel;
247}
248
249110µs1;
# spent 114µs within URI::_generic::CORE:match which was called 27 times, avg 4µs/call: # 21 times (96µs+0s) by URI::_generic::authority at line 18 of URI/_generic.pm, avg 5µs/call # 3 times (9µs+0s) by URI::_generic::path at line 37 of URI/_generic.pm, avg 3µs/call # 3 times (8µs+0s) by URI::_generic::path_query at line 54 of URI/_generic.pm, avg 3µs/call
sub URI::_generic::CORE:match; # xsub
# spent 24µs within URI::_generic::CORE:regcomp which was called # once (24µs+0s) by URI::_generic::authority at line 18 of URI/_generic.pm
sub URI::_generic::CORE:regcomp; # xsub
# spent 7µs within URI::_generic::CORE:subst which was called 2 times, avg 4µs/call: # once (6µs+0s) by URI::implementor at line 10 of URI/_generic.pm # once (1µs+0s) by URI::implementor at line 11 of URI/_generic.pm
sub URI::_generic::CORE:subst; # xsub