← 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:23:00 2010

File /usr/local/lib/perl5/site_perl/5.10.1/URI/_generic.pm
Statements Executed 1493
Statement Execution Time 5.11ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
287431.75ms2.80msURI::_generic::::authorityURI::_generic::authority
369321.27ms1.27msURI::_generic::::CORE:matchURI::_generic::CORE:match (opcode)
4111337µs464µsURI::_generic::::pathURI::_generic::path
4111276µs382µsURI::_generic::::path_queryURI::_generic::path_query
11124µs28µsURI::_generic::::BEGIN@6URI::_generic::BEGIN@6
11214µs14µsURI::_generic::::CORE:regcompURI::_generic::CORE:regcomp (opcode)
1118µs33µsURI::_generic::::BEGIN@7URI::_generic::BEGIN@7
2227µs7µsURI::_generic::::CORE:substURI::_generic::CORE:subst (opcode)
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;
21400nsrequire URI;
3185µsrequire URI::_query;
4120µs@ISA=qw(URI URI::_query);
5
6327µs231µs
# spent 28µs (24+3) within URI::_generic::BEGIN@6 which was called # once (24µs+3µs) by URI::implementor at line 6
use strict;
# spent 28µs making 1 call to URI::_generic::BEGIN@6 # spent 3µs making 1 call to strict::import
7320µs259µs
# spent 33µs (8+26) within URI::_generic::BEGIN@7 which was called # once (8µs+26µs) by URI::implementor at line 7
use URI::Escape qw(uri_unescape);
# spent 33µs making 1 call to URI::_generic::BEGIN@7 # spent 26µ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 2.80ms (1.75+1.05) within URI::_generic::authority which was called 287 times, avg 10µs/call: # 123 times (899µs+533µs) by URI::_server::host at line 67 of URI/_server.pm, avg 12µs/call # 82 times (388µs+227µs) by URI::_server::_port at line 107 of URI/_server.pm, avg 8µs/call # 41 times (234µs+180µs) by LWP::Protocol::http::_fixup_header at line 87 of LWP/Protocol/http.pm, avg 10µs/call # 41 times (225µs+113µs) by URI::http::canonical at line 15 of URI/http.pm, avg 8µs/call
{
1728779µs my $self = shift;
182871.81ms2881.05ms $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;
# spent 1.04ms making 287 calls to URI::_generic::CORE:match, avg 4µs/call # spent 14µs making 1 call to URI::_generic::CORE:regcomp
19
2028794µs 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 }
312871.01ms $2;
32}
33
34sub path
35
# spent 464µs (337+126) within URI::_generic::path which was called 41 times, avg 11µs/call: # 41 times (337µs+126µs) by URI::http::canonical at line 15 of URI/http.pm, avg 11µs/call
{
364124µs my $self = shift;
3741248µs41126µs $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
# spent 126µs making 41 calls to URI::_generic::CORE:match, avg 3µs/call
38
394128µs 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 }
4841166µs $2;
49}
50
51sub path_query
52
# spent 382µs (276+106) within URI::_generic::path_query which was called 41 times, avg 9µs/call: # 41 times (276µs+106µs) by LWP::Protocol::http::request at line 150 of LWP/Protocol/http.pm, avg 9µs/call
{
534123µs my $self = shift;
5441207µs41106µs $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
# spent 106µs making 41 calls to URI::_generic::CORE:match, avg 3µs/call
55
564125µs 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 }
6541137µs $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
249114µs1;
# spent 1.27ms within URI::_generic::CORE:match which was called 369 times, avg 3µs/call: # 287 times (1.04ms+0s) by URI::_generic::authority at line 18 of URI/_generic.pm, avg 4µs/call # 41 times (126µs+0s) by URI::_generic::path at line 37 of URI/_generic.pm, avg 3µs/call # 41 times (106µ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 14µs within URI::_generic::CORE:regcomp which was called # once (14µ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