← 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.pm
StatementsExecuted 121 statements in 7.09ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.52ms2.67msURI::::BEGIN@23URI::BEGIN@23
2111.95ms8.50msURI::::implementorURI::implementor
551177µs177µsURI::::CORE:regcompURI::CORE:regcomp (opcode)
421142µs199µsURI::::_schemeURI::_scheme
211112µs8.88msURI::::newURI::new
21159µs196µsURI::::_initURI::_init
21152µs203µsURI::::canonicalURI::canonical
21150µs103µsURI::::schemeURI::scheme
146149µs49µsURI::::CORE:matchURI::CORE:match (opcode)
11139µs79µsURI::::BEGIN@130URI::BEGIN@130
21137µs88µsURI::::_uric_escapeURI::_uric_escape
11134µs192µsURI::::BEGIN@25URI::BEGIN@25
11130µs34µsURI::::BEGIN@3URI::BEGIN@3
138124µs24µsURI::::CORE:substURI::CORE:subst (opcode)
11116µs27µsURI::::BEGIN@4URI::BEGIN@4
11110µs10µsURI::::BEGIN@22URI::BEGIN@22
1118µs8µsURI::::_init_implementorURI::_init_implementor
0000s0sURI::::STORABLE_freezeURI::STORABLE_freeze
0000s0sURI::::STORABLE_thawURI::STORABLE_thaw
0000s0sURI::::TO_JSONURI::TO_JSON
0000s0sURI::::__ANON__[:25]URI::__ANON__[:25]
0000s0sURI::::__ANON__[:26]URI::__ANON__[:26]
0000s0sURI::::__ANON__[:27]URI::__ANON__[:27]
0000s0sURI::::_no_scheme_okURI::_no_scheme_ok
0000s0sURI::::_obj_eqURI::_obj_eq
0000s0sURI::::absURI::abs
0000s0sURI::::as_iriURI::as_iri
0000s0sURI::::as_stringURI::as_string
0000s0sURI::::cloneURI::clone
0000s0sURI::::eqURI::eq
0000s0sURI::::fragmentURI::fragment
0000s0sURI::::has_recognized_schemeURI::has_recognized_scheme
0000s0sURI::::new_absURI::new_abs
0000s0sURI::::opaqueURI::opaque
0000s0sURI::::pathURI::path
0000s0sURI::::relURI::rel
0000s0sURI::::secureURI::secure
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package URI;
2
3242µs238µs
# spent 34µs (30+4) within URI::BEGIN@3 which was called: # once (30µs+4µs) by URI::WithBase::BEGIN@6 at line 3
use strict;
# spent 34µs making 1 call to URI::BEGIN@3 # spent 4µs making 1 call to strict::import
42171µs238µs
# spent 27µs (16+11) within URI::BEGIN@4 which was called: # once (16µs+11µs) by URI::WithBase::BEGIN@6 at line 4
use warnings;
# spent 27µs making 1 call to URI::BEGIN@4 # spent 11µs making 1 call to warnings::import
5
611µsour $VERSION = '1.72';
7125µs$VERSION = eval $VERSION;
# spent 5µs executing statements in string eval
8
9our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
10
1110smy %implements; # mapping from scheme to implementor class
12
13# Some "official" character classes
14
1511µsour $reserved = q(;/?:@&=+$,[]);
1610sour $mark = q(-_.!~*'()); #'; emacs
1712µsour $unreserved = "A-Za-z0-9\Q$mark\E";
1811µsour $uric = quotemeta($reserved) . $unreserved . "%";
19
2011µsour $scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
21
22236µs110µs
# spent 10µs within URI::BEGIN@22 which was called: # once (10µs+0s) by URI::WithBase::BEGIN@6 at line 22
use Carp ();
# spent 10µs making 1 call to URI::BEGIN@22
232737µs12.67ms
# spent 2.67ms (2.52+150µs) within URI::BEGIN@23 which was called: # once (2.52ms+150µs) by URI::WithBase::BEGIN@6 at line 23
use URI::Escape ();
# spent 2.67ms making 1 call to URI::BEGIN@23
24
25
# spent 192µs (34+158) within URI::BEGIN@25 which was called: # once (34µs+158µs) by URI::WithBase::BEGIN@6 at line 29
use overload ('""' => sub { ${$_[0]} },
26 '==' => sub { _obj_eq(@_) },
27 '!=' => sub { !_obj_eq(@_) },
2811µs fallback => 1,
2912.23ms2350µs );
# spent 192µs making 1 call to URI::BEGIN@25 # spent 158µs making 1 call to overload::import
30
31# Check if two objects are the same object
32sub _obj_eq {
33 return overload::StrVal($_[0]) eq overload::StrVal($_[1]);
34}
35
36sub new
37
# spent 8.88ms (112µs+8.76) within URI::new which was called 2 times, avg 4.44ms/call: # 2 times (112µs+8.76ms) by URI::WithBase::new at line 23 of URI/WithBase.pm, avg 4.44ms/call
{
3821µs my($class, $uri, $scheme) = @_;
39
4022µs $uri = defined ($uri) ? "$uri" : ""; # stringify
41 # Get rid of potential wrapping
42220µs24µs $uri =~ s/^<(?:URL:)?(.*)>$/$1/; #
# spent 4µs making 2 calls to URI::CORE:subst, avg 2µs/call
43211µs21µs $uri =~ s/^"(.*)"$/$1/;
# spent 1µs making 2 calls to URI::CORE:subst, avg 500ns/call
44212µs24µs $uri =~ s/^\s+//;
# spent 4µs making 2 calls to URI::CORE:subst, avg 2µs/call
4529µs24µs $uri =~ s/\s+$//;
# spent 4µs making 2 calls to URI::CORE:subst, avg 2µs/call
46
4720s my $impclass;
48291µs354µs if ($uri =~ m/^($scheme_re):/so) {
# spent 45µs making 1 call to URI::CORE:regcomp # spent 9µs making 2 calls to URI::CORE:match, avg 4µs/call
49 $scheme = $1;
50 }
51 else {
52 if (($impclass = ref($scheme))) {
53 $scheme = $scheme->scheme;
54 }
55 elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o) {
56 $scheme = $1;
57 }
58 }
59 $impclass ||= implementor($scheme) ||
6026µs28.50ms do {
# spent 8.50ms making 2 calls to URI::implementor, avg 4.25ms/call
61 require URI::_foreign;
62 $impclass = 'URI::_foreign';
63 };
64
65224µs2196µs return $impclass->_init($uri, $scheme);
# spent 196µs making 2 calls to URI::_init, avg 98µs/call
66}
67
68
69sub new_abs
70{
71 my($class, $uri, $base) = @_;
72 $uri = $class->new($uri, $base);
73 $uri->abs($base);
74}
75
76
77sub _init
78
# spent 196µs (59+137) within URI::_init which was called 2 times, avg 98µs/call: # 2 times (59µs+137µs) by URI::new at line 65, avg 98µs/call
{
7922µs my $class = shift;
8022µs my($str, $scheme) = @_;
81 # find all funny characters and encode the bytes.
82211µs288µs $str = $class->_uric_escape($str);
# spent 88µs making 2 calls to URI::_uric_escape, avg 44µs/call
83273µs349µs $str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
# spent 34µs making 1 call to URI::CORE:regcomp # spent 15µs making 2 calls to URI::CORE:match, avg 8µs/call
84 $class->_no_scheme_ok;
8523µs my $self = bless \$str, $class;
86210µs $self;
87}
88
89
90sub _uric_escape
91
# spent 88µs (37+51) within URI::_uric_escape which was called 2 times, avg 44µs/call: # 2 times (37µs+51µs) by URI::_init at line 82, avg 44µs/call
{
9221µs my($class, $str) = @_;
93263µs346µs $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
# spent 37µs making 1 call to URI::CORE:regcomp # spent 9µs making 2 calls to URI::CORE:subst, avg 4µs/call
94219µs25µs utf8::downgrade($str);
# spent 5µs making 2 calls to utf8::downgrade, avg 2µs/call
95215µs return $str;
96}
97
9810smy %require_attempted;
99
100sub implementor
101
# spent 8.50ms (1.95+6.55) within URI::implementor which was called 2 times, avg 4.25ms/call: # 2 times (1.95ms+6.55ms) by URI::new at line 60, avg 4.25ms/call
{
10222µs my($scheme, $impclass) = @_;
103234µs324µs if (!$scheme || $scheme !~ /\A$scheme_re\z/o) {
# spent 19µs making 1 call to URI::CORE:regcomp # spent 5µs making 2 calls to URI::CORE:match, avg 2µs/call
104 require URI::_generic;
105 return "URI::_generic";
106 }
107
10823µs $scheme = lc($scheme);
109
11021µs if ($impclass) {
111 # Set the implementor class for a given scheme
112 my $old = $implements{$scheme};
113 $impclass->_init_implementor($scheme);
114 $implements{$scheme} = $impclass;
115 return $old;
116 }
117
11822µs my $ic = $implements{$scheme};
11923µs return $ic if $ic;
120
121 # scheme not yet known, look for internal or
122 # preloaded (with 'use') implementation
12311µs $ic = "URI::$scheme"; # default location
124
125 # turn scheme into a valid perl identifier by a simple transformation...
12614µs11µs $ic =~ s/\+/_P/g;
# spent 1µs making 1 call to URI::CORE:subst
12716µs10s $ic =~ s/\./_O/g;
# spent 0s making 1 call to URI::CORE:subst
12814µs11µs $ic =~ s/\-/_/g;
# spent 1µs making 1 call to URI::CORE:subst
129
13022.97ms2119µs
# spent 79µs (39+40) within URI::BEGIN@130 which was called: # once (39µs+40µs) by URI::WithBase::BEGIN@6 at line 130
no strict 'refs';
# spent 79µs making 1 call to URI::BEGIN@130 # spent 40µs making 1 call to strict::unimport
131 # check we actually have one for the scheme:
13215µs unless (@{"${ic}::ISA"}) {
13311µs if (not exists $require_attempted{$ic}) {
134 # Try to load it
13511µs my $_old_error = $@;
136127µs eval "require $ic";
# spent 552µs executing statements in string eval
13710s die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
13812µs $@ = $_old_error;
139 }
14016µs return undef unless @{"${ic}::ISA"};
141 }
142
143114µs18µs $ic->_init_implementor($scheme);
# spent 8µs making 1 call to URI::_init_implementor
14413µs $implements{$scheme} = $ic;
14519µs $ic;
146}
147
148
149sub _init_implementor
150
# spent 8µs within URI::_init_implementor which was called: # once (8µs+0s) by URI::implementor at line 143
{
151122µs my($class, $scheme) = @_;
152 # Remember that one implementor class may actually
153 # serve to implement several URI schemes.
154}
155
156
157sub clone
158{
159 my $self = shift;
160 my $other = $$self;
161 bless \$other, ref $self;
162}
163
164sub TO_JSON { ${$_[0]} }
165
166sub _no_scheme_ok { 0 }
167
168sub _scheme
169
# spent 199µs (142+57) within URI::_scheme which was called 4 times, avg 50µs/call: # 2 times (96µs+50µs) by URI::canonical at line 307, avg 73µs/call # 2 times (46µs+7µs) by URI::scheme at line 202, avg 26µs/call
{
17042µs my $self = shift;
171
17244µs unless (@_) {
1734176µs557µs return undef unless $$self =~ /^($scheme_re):/o;
# spent 42µs making 1 call to URI::CORE:regcomp # spent 15µs making 4 calls to URI::CORE:match, avg 4µs/call
174457µs return $1;
175 }
176
177 my $old;
178 my $new = shift;
179 if (defined($new) && length($new)) {
180 Carp::croak("Bad scheme '$new'") unless $new =~ /^$scheme_re$/o;
181 $old = $1 if $$self =~ s/^($scheme_re)://o;
182 my $newself = URI->new("$new:$$self");
183 $$self = $$newself;
184 bless $self, ref($newself);
185 }
186 else {
187 if ($self->_no_scheme_ok) {
188 $old = $1 if $$self =~ s/^($scheme_re)://o;
189 Carp::carp("Oops, opaque part now look like scheme")
190 if $^W && $$self =~ m/^$scheme_re:/o
191 }
192 else {
193 $old = $1 if $$self =~ m/^($scheme_re):/o;
194 }
195 }
196
197 return $old;
198}
199
200sub scheme
201
# spent 103µs (50+53) within URI::scheme which was called 2 times, avg 52µs/call: # 2 times (50µs+53µs) by URI::file::canonical at line 70 of URI/file.pm, avg 52µs/call
{
20226µs253µs my $scheme = shift->_scheme(@_);
# spent 53µs making 2 calls to URI::_scheme, avg 26µs/call
20321µs return undef unless defined $scheme;
204223µs lc($scheme);
205}
206
207sub has_recognized_scheme {
208 my $self = shift;
209 return ref($self) !~ /^URI::_(?:foreign|generic)\z/;
210}
211
212sub opaque
213{
214 my $self = shift;
215
216 unless (@_) {
217 $$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;
218 return $1;
219 }
220
221 $$self =~ /^($scheme_re:)? # optional scheme
222 ([^\#]*) # opaque
223 (\#.*)? # optional fragment
224 $/sx or die;
225
226 my $old_scheme = $1;
227 my $old_opaque = $2;
228 my $old_frag = $3;
229
230 my $new_opaque = shift;
231 $new_opaque = "" unless defined $new_opaque;
232 $new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;
233 utf8::downgrade($new_opaque);
234
235 $$self = defined($old_scheme) ? $old_scheme : "";
236 $$self .= $new_opaque;
237 $$self .= $old_frag if defined $old_frag;
238
239 $old_opaque;
240}
241
242sub path { goto &opaque } # alias
243
244
245sub fragment
246{
247 my $self = shift;
248 unless (@_) {
249 return undef unless $$self =~ /\#(.*)/s;
250 return $1;
251 }
252
253 my $old;
254 $old = $1 if $$self =~ s/\#(.*)//s;
255
256 my $new_frag = shift;
257 if (defined $new_frag) {
258 $new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;
259 utf8::downgrade($new_frag);
260 $$self .= "#$new_frag";
261 }
262 $old;
263}
264
265
266sub as_string
267{
268 my $self = shift;
269 $$self;
270}
271
272
273sub as_iri
274{
275 my $self = shift;
276 my $str = $$self;
277 if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg) {
278 # All this crap because the more obvious:
279 #
280 # Encode::decode("UTF-8", $str, sub { sprintf "%%%02X", shift })
281 #
282 # doesn't work before Encode 2.39. Wait for a standard release
283 # to bundle that version.
284
285 require Encode;
286 my $enc = Encode::find_encoding("UTF-8");
287 my $u = "";
288 while (length $str) {
289 $u .= $enc->decode($str, Encode::FB_QUIET());
290 if (length $str) {
291 # escape next char
292 $u .= URI::Escape::escape_char(substr($str, 0, 1, ""));
293 }
294 }
295 $str = $u;
296 }
297 return $str;
298}
299
300
301sub canonical
302
# spent 203µs (52+151) within URI::canonical which was called 2 times, avg 102µs/call: # 2 times (52µs+151µs) by URI::file::canonical at line 68 of URI/file.pm, avg 102µs/call
{
303 # Make sure scheme is lowercased, that we don't escape unreserved chars,
304 # and that we use upcase escape sequences.
305
30622µs my $self = shift;
307210µs2146µs my $scheme = $self->_scheme || "";
# spent 146µs making 2 calls to URI::_scheme, avg 73µs/call
308220µs23µs my $uc_scheme = $scheme =~ /[A-Z]/;
# spent 3µs making 2 calls to URI::CORE:match, avg 2µs/call
309213µs22µs my $esc = $$self =~ /%[a-fA-F0-9]{2}/;
# spent 2µs making 2 calls to URI::CORE:match, avg 1µs/call
310215µs return $self unless $uc_scheme || $esc;
311
312 my $other = $self->clone;
313 if ($uc_scheme) {
314 $other->_scheme(lc $scheme);
315 }
316 if ($esc) {
317 $$other =~ s{%([0-9a-fA-F]{2})}
318 { my $a = chr(hex($1));
319 $a =~ /^[$unreserved]\z/o ? $a : "%\U$1"
320 }
321 return $other;
322}
323
324# Compare two URIs, subclasses will provide a more correct implementation
325sub eq {
326 my($self, $other) = @_;
327 $self = URI->new($self, $other) unless ref $self;
328 $other = URI->new($other, $self) unless ref $other;
329 ref($self) eq ref($other) && # same class
330 $self->canonical->as_string eq $other->canonical->as_string;
331}
332
333# generic-URI transformation methods
334sub abs { $_[0]; }
335sub rel { $_[0]; }
336
337sub secure { 0 }
338
339# help out Storable
340sub STORABLE_freeze {
341 my($self, $cloning) = @_;
342 return $$self;
343}
344
345sub STORABLE_thaw {
346 my($self, $cloning, $str) = @_;
347 $$self = $str;
348}
349
350114µs1;
351
352__END__
 
# spent 49µs within URI::CORE:match which was called 14 times, avg 4µs/call: # 4 times (15µs+0s) by URI::_scheme at line 173, avg 4µs/call # 2 times (15µs+0s) by URI::_init at line 83, avg 8µs/call # 2 times (9µs+0s) by URI::new at line 48, avg 4µs/call # 2 times (5µs+0s) by URI::implementor at line 103, avg 2µs/call # 2 times (3µs+0s) by URI::canonical at line 308, avg 2µs/call # 2 times (2µs+0s) by URI::canonical at line 309, avg 1µs/call
sub URI::CORE:match; # opcode
# spent 177µs within URI::CORE:regcomp which was called 5 times, avg 35µs/call: # once (45µs+0s) by URI::new at line 48 # once (42µs+0s) by URI::_scheme at line 173 # once (37µs+0s) by URI::_uric_escape at line 93 # once (34µs+0s) by URI::_init at line 83 # once (19µs+0s) by URI::implementor at line 103
sub URI::CORE:regcomp; # opcode
# spent 24µs within URI::CORE:subst which was called 13 times, avg 2µs/call: # 2 times (9µs+0s) by URI::_uric_escape at line 93, avg 4µs/call # 2 times (4µs+0s) by URI::new at line 45, avg 2µs/call # 2 times (4µs+0s) by URI::new at line 42, avg 2µs/call # 2 times (4µs+0s) by URI::new at line 44, avg 2µs/call # 2 times (1µs+0s) by URI::new at line 43, avg 500ns/call # once (1µs+0s) by URI::implementor at line 128 # once (1µs+0s) by URI::implementor at line 126 # once (0s+0s) by URI::implementor at line 127
sub URI::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.