| File | /usr/local/lib/perl5/site_perl/5.10.1/URI/_generic.pm |
| Statements Executed | 125 |
| Statement Execution Time | 1.62ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 21 | 4 | 3 | 171µs | 291µs | URI::_generic::authority |
| 27 | 3 | 2 | 114µs | 114µs | URI::_generic::CORE:match (opcode) |
| 3 | 1 | 1 | 27µs | 36µs | URI::_generic::path |
| 1 | 1 | 2 | 24µs | 24µs | URI::_generic::CORE:regcomp (opcode) |
| 3 | 1 | 1 | 21µs | 30µs | URI::_generic::path_query |
| 1 | 1 | 1 | 15µs | 18µs | URI::_generic::BEGIN@6 |
| 2 | 2 | 2 | 7µs | 7µs | URI::_generic::CORE:subst (opcode) |
| 1 | 1 | 1 | 7µs | 31µs | URI::_generic::BEGIN@7 |
| 1 | 1 | 1 | 4µs | 4µs | URI::_generic::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::_check_path |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::_no_scheme_ok |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::_split_segment |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::abs |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::path_segments |
| 0 | 0 | 0 | 0s | 0s | URI::_generic::rel |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package URI::_generic; | ||||
| 2 | 1 | 800ns | require URI; | ||
| 3 | 1 | 79µs | require URI::_query; | ||
| 4 | 1 | 11µs | @ISA=qw(URI URI::_query); | ||
| 5 | |||||
| 6 | 3 | 23µs | 2 | 21µs | # spent 18µs (15+3) within URI::_generic::BEGIN@6 which was called
# once (15µs+3µs) by URI::implementor at line 6 # spent 18µs making 1 call to URI::_generic::BEGIN@6
# spent 3µs making 1 call to strict::import |
| 7 | 3 | 21µs | 2 | 55µs | # spent 31µs (7+24) within URI::_generic::BEGIN@7 which was called
# once (7µs+24µs) by URI::implementor at line 7 # spent 31µs making 1 call to URI::_generic::BEGIN@7
# spent 24µs making 1 call to Exporter::import |
| 8 | 3 | 1.08ms | 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 | 13µ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 291µs (171+120) within URI::_generic::authority which was called 21 times, avg 14µs/call:
# 9 times (94µs+68µs) by URI::_server::host at line 67 of URI/_server.pm, avg 18µs/call
# 6 times (29µs+16µs) by URI::_server::_port at line 107 of URI/_server.pm, avg 8µs/call
# 3 times (31µs+26µs) by LWP::Protocol::http::_fixup_header at line 87 of LWP/Protocol/http.pm, avg 19µs/call
# 3 times (18µs+9µs) by URI::http::canonical at line 15 of URI/http.pm, avg 9µs/call | ||||
| 17 | 84 | 308µs | my $self = shift; | ||
| 18 | $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die; # spent 96µs making 21 calls to URI::_generic::CORE:match, avg 5µs/call
# spent 24µs making 1 call to URI::_generic::CORE:regcomp | ||||
| 19 | |||||
| 20 | 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 | } | ||||
| 31 | $2; | ||||
| 32 | } | ||||
| 33 | |||||
| 34 | sub path | ||||
| 35 | # spent 36µs (27+9) within URI::_generic::path which was called 3 times, avg 12µs/call:
# 3 times (27µs+9µs) by URI::http::canonical at line 15 of URI/http.pm, avg 12µs/call | ||||
| 36 | 12 | 38µs | my $self = shift; | ||
| 37 | $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die; # spent 9µs making 3 calls to URI::_generic::CORE:match, avg 3µs/call | ||||
| 38 | |||||
| 39 | 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 | } | ||||
| 48 | $2; | ||||
| 49 | } | ||||
| 50 | |||||
| 51 | sub path_query | ||||
| 52 | # spent 30µs (21+9) within URI::_generic::path_query which was called 3 times, avg 10µs/call:
# 3 times (21µs+9µs) by LWP::Protocol::http::request at line 150 of LWP/Protocol/http.pm, avg 10µs/call | ||||
| 53 | 12 | 33µs | my $self = shift; | ||
| 54 | $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die; # spent 8µs making 3 calls to URI::_generic::CORE:match, avg 3µs/call | ||||
| 55 | |||||
| 56 | 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 | } | ||||
| 65 | $2; | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | sub _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 | |||||
| 89 | sub 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 | |||||
| 116 | sub _split_segment | ||||
| 117 | { | ||||
| 118 | my $self = shift; | ||||
| 119 | require URI::_segment; | ||||
| 120 | URI::_segment->new(@_); | ||||
| 121 | } | ||||
| 122 | |||||
| 123 | |||||
| 124 | sub 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 | ||||
| 184 | sub 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 | |||||
| 249 | 1 | 10µs | 1; | ||
# spent 114µs within URI::_generic::CORE:match which was called 27 times, avg 4µs/call:
# 21 times (96µs+0s) by URI::_generic::authority at line 18 of URI/_generic.pm, avg 5µs/call
# 3 times (9µs+0s) by URI::_generic::path at line 37 of URI/_generic.pm, avg 3µs/call
# 3 times (8µs+0s) by URI::_generic::path_query at line 54 of URI/_generic.pm, avg 3µs/call | |||||
# spent 24µs within URI::_generic::CORE:regcomp which was called
# once (24µs+0s) by URI::_generic::authority at line 18 of URI/_generic.pm | |||||
# 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 |