← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:15 2017

Filename/usr/local/perls/perl-5.26.1/lib/site_perl/5.26.1/URI/_generic.pm
StatementsExecuted 71 statements in 3.32ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
211107µs240µsURI::_generic::::path_segmentsURI::_generic::path_segments
42281µs169µsURI::_generic::::authorityURI::_generic::authority
11164µs64µsURI::_generic::::CORE:regcompURI::_generic::CORE:regcomp (opcode)
263146µs46µsURI::_generic::::CORE:matchURI::_generic::CORE:match (opcode)
11142µs90µsURI::_generic::::BEGIN@8URI::_generic::BEGIN@8
11136µs2.63msURI::_generic::::BEGIN@6URI::_generic::BEGIN@6
11133µs38µsURI::_generic::::BEGIN@3URI::_generic::BEGIN@3
22128µs28µsURI::_generic::::CORE:substURI::_generic::CORE:subst (opcode)
21115µs24µsURI::_generic::::pathURI::_generic::path
11113µs24µsURI::_generic::::BEGIN@4URI::_generic::BEGIN@4
1118µs8µsURI::_generic::::BEGIN@9URI::_generic::BEGIN@9
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_queryURI::_generic::path_query
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;
2
3250µs243µs
# spent 38µs (33+5) within URI::_generic::BEGIN@3 which was called: # once (33µs+5µs) by parent::import at line 3
use strict;
# spent 38µs making 1 call to URI::_generic::BEGIN@3 # spent 5µs making 1 call to strict::import
4252µs235µs
# spent 24µs (13+11) within URI::_generic::BEGIN@4 which was called: # once (13µs+11µs) by parent::import at line 4
use warnings;
# spent 24µs making 1 call to URI::_generic::BEGIN@4 # spent 11µs making 1 call to warnings::import
5
6257µs22.63ms
# spent 2.63ms (36µs+2.60) within URI::_generic::BEGIN@6 which was called: # once (36µs+2.60ms) by parent::import at line 6
use parent qw(URI URI::_query);
# spent 2.63ms making 1 call to URI::_generic::BEGIN@6 # spent 2.60ms making 1 call to parent::import, recursion: max depth 1, sum of overlapping time 2.60ms
7
8261µs2138µs
# spent 90µs (42+48) within URI::_generic::BEGIN@8 which was called: # once (42µs+48µs) by parent::import at line 8
use URI::Escape qw(uri_unescape);
# spent 90µs making 1 call to URI::_generic::BEGIN@8 # spent 48µs making 1 call to Exporter::import
922.66ms18µs
# spent 8µs within URI::_generic::BEGIN@9 which was called: # once (8µs+0s) by parent::import at line 9
use Carp ();
# spent 8µs making 1 call to URI::_generic::BEGIN@9
10
1112µsour $VERSION = '1.72';
12135µs$VERSION = eval $VERSION;
# spent 7µs executing statements in string eval
13
14261µs124µsmy $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g;
# spent 24µs making 1 call to URI::_generic::CORE:subst
15211µs14µsmy $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
# spent 4µs making 1 call to URI::_generic::CORE:subst
16
17sub _no_scheme_ok { 1 }
18
19sub authority
20
# spent 169µs (81+88) within URI::_generic::authority which was called 4 times, avg 42µs/call: # 2 times (68µs+74µs) by URI::file::canonical at line 71 of URI/file.pm, avg 71µs/call # 2 times (13µs+14µs) by URI::file::Unix::file at line 36 of URI/file/Unix.pm, avg 14µs/call
{
2143µs my $self = shift;
224142µs588µs $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;
# spent 64µs making 1 call to URI::_generic::CORE:regcomp # spent 24µs making 4 calls to URI::_generic::CORE:match, avg 6µs/call
23
2442µs if (@_) {
25 my $auth = shift;
26 $$self = $1;
27 my $rest = $3;
28 if (defined $auth) {
29 $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;
30 utf8::downgrade($auth);
31 $$self .= "//$auth";
32 }
33 _check_path($rest, $$self);
34 $$self .= $rest;
35 }
36433µs $2;
37}
38
39sub path
40
# spent 24µs (15+9) within URI::_generic::path which was called 2 times, avg 12µs/call: # 2 times (15µs+9µs) by URI::_generic::path_segments at line 99, avg 12µs/call
{
4122µs my $self = shift;
42216µs29µs $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
# spent 9µs making 2 calls to URI::_generic::CORE:match, avg 4µs/call
43
4421µs if (@_) {
45 $$self = $1;
46 my $rest = $3;
47 my $new_path = shift;
48 $new_path = "" unless defined $new_path;
49 $new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;
50 utf8::downgrade($new_path);
51 _check_path($new_path, $$self);
52 $$self .= $new_path . $rest;
53 }
54214µs $2;
55}
56
57sub path_query
58{
59 my $self = shift;
60 $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
61
62 if (@_) {
63 $$self = $1;
64 my $rest = $3;
65 my $new_path = shift;
66 $new_path = "" unless defined $new_path;
67 $new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
68 utf8::downgrade($new_path);
69 _check_path($new_path, $$self);
70 $$self .= $new_path . $rest;
71 }
72 $2;
73}
74
75sub _check_path
76{
77 my($path, $pre) = @_;
78 my $prefix;
79 if ($pre =~ m,/,) { # authority present
80 $prefix = "/" if length($path) && $path !~ m,^[/?\#],;
81 }
82 else {
83 if ($path =~ m,^//,) {
84 Carp::carp("Path starting with double slash is confusing")
85 if $^W;
86 }
87 elsif (!length($pre) && $path =~ m,^[^:/?\#]+:,) {
88 Carp::carp("Path might look like scheme, './' prepended")
89 if $^W;
90 $prefix = "./";
91 }
92 }
93 substr($_[0], 0, 0) = $prefix if defined $prefix;
94}
95
96sub path_segments
97
# spent 240µs (107+133) within URI::_generic::path_segments which was called 2 times, avg 120µs/call: # 2 times (107µs+133µs) by URI::file::Unix::file at line 46 of URI/file/Unix.pm, avg 120µs/call
{
9821µs my $self = shift;
9926µs224µs my $path = $self->path;
# spent 24µs making 2 calls to URI::_generic::path, avg 12µs/call
10022µs if (@_) {
101 my @arg = @_; # make a copy
102 for (@arg) {
103 if (ref($_)) {
104 my @seg = @$_;
105 $seg[0] =~ s/%/%25/g;
106 for (@seg) { s/;/%3B/g; }
107 $_ = join(";", @seg);
108 }
109 else {
110 s/%/%25/g; s/;/%3B/g;
111 }
112 s,/,%2F,g;
113 }
114 $self->path(join("/", @arg));
115 }
11620s return $path unless wantarray;
1172293µs40109µs map {/;/ ? $self->_split_segment($_)
# spent 96µs making 20 calls to URI::Escape::uri_unescape, avg 5µs/call # spent 13µs making 20 calls to URI::_generic::CORE:match, avg 650ns/call
118 : uri_unescape($_) }
119 split('/', $path, -1);
120}
121
122
123sub _split_segment
124{
125 my $self = shift;
126 require URI::_segment;
127 URI::_segment->new(@_);
128}
129
130
131sub abs
132{
133 my $self = shift;
134 my $base = shift || Carp::croak("Missing base argument");
135
136 if (my $scheme = $self->scheme) {
137 return $self unless $URI::ABS_ALLOW_RELATIVE_SCHEME;
138 $base = URI->new($base) unless ref $base;
139 return $self unless $scheme eq $base->scheme;
140 }
141
142 $base = URI->new($base) unless ref $base;
143 my $abs = $self->clone;
144 $abs->scheme($base->scheme);
145 return $abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;
146 $abs->authority($base->authority);
147
148 my $path = $self->path;
149 return $abs if $path =~ m,^/,;
150
151 if (!length($path)) {
152 my $abs = $base->clone;
153 my $query = $self->query;
154 $abs->query($query) if defined $query;
155 my $fragment = $self->fragment;
156 $abs->fragment($fragment) if defined $fragment;
157 return $abs;
158 }
159
160 my $p = $base->path;
161 $p =~ s,[^/]+$,,;
162 $p .= $path;
163 my @p = split('/', $p, -1);
164 shift(@p) if @p && !length($p[0]);
165 my $i = 1;
166 while ($i < @p) {
167 #print "$i ", join("/", @p), " ($p[$i])\n";
168 if ($p[$i-1] eq ".") {
169 splice(@p, $i-1, 1);
170 $i-- if $i > 1;
171 }
172 elsif ($p[$i] eq ".." && $p[$i-1] ne "..") {
173 splice(@p, $i-1, 2);
174 if ($i > 1) {
175 $i--;
176 push(@p, "") if $i == @p;
177 }
178 }
179 else {
180 $i++;
181 }
182 }
183 $p[-1] = "" if @p && $p[-1] eq "."; # trailing "/."
184 if ($URI::ABS_REMOTE_LEADING_DOTS) {
185 shift @p while @p && $p[0] =~ /^\.\.?$/;
186 }
187 $abs->path("/" . join("/", @p));
188 $abs;
189}
190
191# The opposite of $url->abs. Return a URI which is as relative as possible
192sub rel {
193 my $self = shift;
194 my $base = shift || Carp::croak("Missing base argument");
195 my $rel = $self->clone;
196 $base = URI->new($base) unless ref $base;
197
198 #my($scheme, $auth, $path) = @{$rel}{qw(scheme authority path)};
199 my $scheme = $rel->scheme;
200 my $auth = $rel->canonical->authority;
201 my $path = $rel->path;
202
203 if (!defined($scheme) && !defined($auth)) {
204 # it is already relative
205 return $rel;
206 }
207
208 #my($bscheme, $bauth, $bpath) = @{$base}{qw(scheme authority path)};
209 my $bscheme = $base->scheme;
210 my $bauth = $base->canonical->authority;
211 my $bpath = $base->path;
212
213 for ($bscheme, $bauth, $auth) {
214 $_ = '' unless defined
215 }
216
217 unless ($scheme eq $bscheme && $auth eq $bauth) {
218 # different location, can't make it relative
219 return $rel;
220 }
221
222 for ($path, $bpath) { $_ = "/$_" unless m,^/,; }
223
224 # Make it relative by eliminating scheme and authority
225 $rel->scheme(undef);
226 $rel->authority(undef);
227
228 # This loop is based on code from Nicolai Langfeldt <[email protected]>.
229 # First we calculate common initial path components length ($li).
230 my $li = 1;
231 while (1) {
232 my $i = index($path, '/', $li);
233 last if $i < 0 ||
234 $i != index($bpath, '/', $li) ||
235 substr($path,$li,$i-$li) ne substr($bpath,$li,$i-$li);
236 $li=$i+1;
237 }
238 # then we nuke it from both paths
239 substr($path, 0,$li) = '';
240 substr($bpath,0,$li) = '';
241
242 if ($path eq $bpath &&
243 defined($rel->fragment) &&
244 !defined($rel->query)) {
245 $rel->path("");
246 }
247 else {
248 # Add one "../" for each path component left in the base path
249 $path = ('../' x $bpath =~ tr|/|/|) . $path;
250 $path = "./" if $path eq "";
251 $rel->path($path);
252 }
253
254 $rel;
255}
256
257117µs1;
 
# spent 46µs within URI::_generic::CORE:match which was called 26 times, avg 2µs/call: # 20 times (13µs+0s) by URI::_generic::path_segments at line 117, avg 650ns/call # 4 times (24µs+0s) by URI::_generic::authority at line 22, avg 6µs/call # 2 times (9µs+0s) by URI::_generic::path at line 42, avg 4µs/call
sub URI::_generic::CORE:match; # opcode
# spent 64µs within URI::_generic::CORE:regcomp which was called: # once (64µs+0s) by URI::_generic::authority at line 22
sub URI::_generic::CORE:regcomp; # opcode
# spent 28µs within URI::_generic::CORE:subst which was called 2 times, avg 14µs/call: # once (24µs+0s) by parent::import at line 14 # once (4µs+0s) by parent::import at line 15
sub URI::_generic::CORE:subst; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.