← 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/URL.pm
StatementsExecuted 23 statements in 3.16ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.05ms12.5msURI::URL::::BEGIN@6 URI::URL::BEGIN@6
211104µs9.53msURI::URL::::new URI::URL::new
11150µs57µsURI::URL::::BEGIN@3 URI::URL::BEGIN@3
11136µs78µsURI::URL::::BEGIN@4 URI::URL::BEGIN@4
11122µs46µsURI::URL::::BEGIN@13 URI::URL::BEGIN@13
11116µs76µsURI::URL::::BEGIN@19 URI::URL::BEGIN@19
0000s0sURI::URL::::_try URI::URL::_try
0000s0sURI::URL::::abs URI::URL::abs
0000s0sURI::URL::::address URI::URL::address
0000s0sURI::URL::::article URI::URL::article
0000s0sURI::URL::::crack URI::URL::crack
0000s0sURI::URL::::dos_path URI::URL::dos_path
0000s0sURI::URL::::encoded822addr URI::URL::encoded822addr
0000s0sURI::URL::::eparams URI::URL::eparams
0000s0sURI::URL::::epath URI::URL::epath
0000s0sURI::URL::::frag URI::URL::frag
0000s0sURI::URL::::full_path URI::URL::full_path
0000s0sURI::URL::::groupart URI::URL::groupart
0000s0sURI::URL::::keywords URI::URL::keywords
0000s0sURI::URL::::local_path URI::URL::local_path
0000s0sURI::URL::::mac_path URI::URL::mac_path
0000s0sURI::URL::::netloc URI::URL::netloc
0000s0sURI::URL::::newlocal URI::URL::newlocal
0000s0sURI::URL::::params URI::URL::params
0000s0sURI::URL::::path URI::URL::path
0000s0sURI::URL::::path_components URI::URL::path_components
0000s0sURI::URL::::print_on URI::URL::print_on
0000s0sURI::URL::::query URI::URL::query
0000s0sURI::URL::::strict URI::URL::strict
0000s0sURI::URL::::unix_path URI::URL::unix_path
0000s0sURI::URL::::url URI::URL::url
0000s0sURI::URL::::vms_path URI::URL::vms_path
0000s0sURI::_foreign::::_initURI::_foreign::_init
0000s0sURI::mailto::::authority URI::mailto::authority
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package URI::URL;
2
3276µs264µs
# spent 57µs (50+7) within URI::URL::BEGIN@3 which was called: # once (50µs+7µs) by CPAN::has_inst at line 3
use strict;
# spent 57µs making 1 call to URI::URL::BEGIN@3 # spent 7µs making 1 call to strict::import
42923µs2120µs
# spent 78µs (36+42) within URI::URL::BEGIN@4 which was called: # once (36µs+42µs) by CPAN::has_inst at line 4
use warnings;
# spent 78µs making 1 call to URI::URL::BEGIN@4 # spent 42µs making 1 call to warnings::import
5
62626µs223.3ms
# spent 12.5ms (1.05+11.5) within URI::URL::BEGIN@6 which was called: # once (1.05ms+11.5ms) by CPAN::has_inst at line 6
use parent 'URI::WithBase';
# spent 12.5ms making 1 call to URI::URL::BEGIN@6 # spent 10.8ms making 1 call to parent::import
7
811µsour $VERSION = "5.04";
9
10# Provide as much as possible of the old URI::URL interface for backwards
11# compatibility...
12
133115µs370µs
# spent 46µs (22+24) within URI::URL::BEGIN@13 which was called: # once (22µs+24µs) by CPAN::has_inst at line 13
use Exporter 5.57 'import';
# spent 46µs making 1 call to URI::URL::BEGIN@13 # spent 15µs making 1 call to version::_VERSION # spent 9µs making 1 call to Exporter::import
1411µsour @EXPORT = qw(url);
15
16# Easy to use constructor
17sub url ($;$) { URI::URL->new(@_); }
18
1921.32ms2136µs
# spent 76µs (16+60) within URI::URL::BEGIN@19 which was called: # once (16µs+60µs) by CPAN::has_inst at line 19
use URI::Escape qw(uri_unescape);
# spent 76µs making 1 call to URI::URL::BEGIN@19 # spent 60µs making 1 call to Exporter::import
20
21sub new
22
# spent 9.53ms (104µs+9.42) within URI::URL::new which was called 2 times, avg 4.76ms/call: # 2 times (104µs+9.42ms) by CPAN::FTP::hostdleasy at line 563 of CPAN/FTP.pm, avg 4.76ms/call
{
2321µs my $class = shift;
24211µs28.90ms my $self = $class->SUPER::new(@_);
# spent 8.90ms making 2 calls to URI::WithBase::new, avg 4.45ms/call
25271µs2527µs $self->[0] = $self->[0]->canonical;
# spent 527µs making 2 calls to URI::file::canonical, avg 264µs/call
26210µs $self;
27}
28
29sub newlocal
30{
31 my $class = shift;
32 require URI::file;
33 bless [URI::file->new_abs(shift)], $class;
34}
35
36{package URI::_foreign;
37 sub _init # hope it is not defined
38 {
39 my $class = shift;
40 die "Unknown URI::URL scheme $_[1]:" if $URI::URL::STRICT;
41 $class->SUPER::_init(@_);
42 }
43}
44
45sub strict
4611µs{
47 my $old = $URI::URL::STRICT;
48 $URI::URL::STRICT = shift if @_;
49 $old;
50}
51
52sub print_on
53{
54 my $self = shift;
55 require Data::Dumper;
56 print STDERR Data::Dumper::Dumper($self);
57}
58
59sub _try
60{
61 my $self = shift;
62 my $method = shift;
63 scalar(eval { $self->$method(@_) });
64}
65
66sub crack
67{
68 # should be overridden by subclasses
69 my $self = shift;
70 (scalar($self->scheme),
71 $self->_try("user"),
72 $self->_try("password"),
73 $self->_try("host"),
74 $self->_try("port"),
75 $self->_try("path"),
76 $self->_try("params"),
77 $self->_try("query"),
78 scalar($self->fragment),
79 )
80}
81
82sub full_path
83{
84 my $self = shift;
85 my $path = $self->path_query;
86 $path = "/" unless length $path;
87 $path;
88}
89
90sub netloc
91{
92 shift->authority(@_);
93}
94
95sub epath
96{
97 my $path = shift->SUPER::path(@_);
98 $path =~ s/;.*//;
99 $path;
100}
101
102sub eparams
103{
104 my $self = shift;
105 my @p = $self->path_segments;
106 return undef unless ref($p[-1]);
107 @p = @{$p[-1]};
108 shift @p;
109 join(";", @p);
110}
111
112sub params { shift->eparams(@_); }
113
114sub path {
115 my $self = shift;
116 my $old = $self->epath(@_);
117 return unless defined wantarray;
118 return '/' if !defined($old) || !length($old);
119 Carp::croak("Path components contain '/' (you must call epath)")
120 if $old =~ /%2[fF]/ and !@_;
121 $old = "/$old" if $old !~ m|^/| && defined $self->netloc;
122 return uri_unescape($old);
123}
124
125sub path_components {
126 shift->path_segments(@_);
127}
128
129sub query {
130 my $self = shift;
131 my $old = $self->equery(@_);
132 if (defined(wantarray) && defined($old)) {
133 if ($old =~ /%(?:26|2[bB]|3[dD])/) { # contains escaped '=' '&' or '+'
134 my $mess;
135 for ($old) {
136 $mess = "Query contains both '+' and '%2B'"
137 if /\+/ && /%2[bB]/;
138 $mess = "Form query contains escaped '=' or '&'"
139 if /=/ && /%(?:3[dD]|26)/;
140 }
141 if ($mess) {
142 Carp::croak("$mess (you must call equery)");
143 }
144 }
145 # Now it should be safe to unescape the string without losing
146 # information
147 return uri_unescape($old);
148 }
149 undef;
150
151}
152
153sub abs
154{
155 my $self = shift;
156 my $base = shift;
157 my $allow_scheme = shift;
158 $allow_scheme = $URI::URL::ABS_ALLOW_RELATIVE_SCHEME
159 unless defined $allow_scheme;
160 local $URI::ABS_ALLOW_RELATIVE_SCHEME = $allow_scheme;
161 local $URI::ABS_REMOTE_LEADING_DOTS = $URI::URL::ABS_REMOTE_LEADING_DOTS;
162 $self->SUPER::abs($base);
163}
164
165sub frag { shift->fragment(@_); }
166sub keywords { shift->query_keywords(@_); }
167
168# file:
169sub local_path { shift->file; }
170sub unix_path { shift->file("unix"); }
171sub dos_path { shift->file("dos"); }
172sub mac_path { shift->file("mac"); }
173sub vms_path { shift->file("vms"); }
174
175# mailto:
176sub address { shift->to(@_); }
177sub encoded822addr { shift->to(@_); }
178sub URI::mailto::authority { shift->to(@_); } # make 'netloc' method work
179
180# news:
181sub groupart { shift->_group(@_); }
182sub article { shift->message(@_); }
183
18416µs1;
185
186__END__
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.