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