Profile of /usr/local/lib/perl5/site_perl/5.10.1/URI/_query.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:19 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/URI/_query.pm
Statements Executed | 11
Statement Execution Time | 556µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 14µs | 17µs | URI::_query::::BEGIN@3URI::_query::BEGIN@3
1 | 1 | 1 | 7µs | 36µs | URI::_query::::BEGIN@5URI::_query::BEGIN@5
1 | 1 | 1 | 3µs | 3µs | URI::_query::::BEGIN@4URI::_query::BEGIN@4
0 | 0 | 0 | 0s | 0s | URI::_query::::queryURI::_query::query
0 | 0 | 0 | 0s | 0s | URI::_query::::query_formURI::_query::query_form
0 | 0 | 0 | 0s | 0s | URI::_query::::query_keywordsURI::_query::query_keywords

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package URI::_query;
2 |  |  |  |  |
3 | 3 | 20µs | 2 | 20µs | # spent 17µs (14+3) within URI::_query::BEGIN@3 which was called # once (14µs+3µs) by URI::implementor at line 3 use strict; # spent 17µs making 1 call to URI::_query::BEGIN@3 # spent 3µs making 1 call to strict::import
4 | 3 | 19µs | 1 | 3µs | # spent 3µs within URI::_query::BEGIN@4 which was called # once (3µs+0s) by URI::implementor at line 4 use URI (); # spent 3µs making 1 call to URI::_query::BEGIN@4
5 | 3 | 512µs | 2 | 66µs | # spent 36µs (7+30) within URI::_query::BEGIN@5 which was called # once (7µs+30µs) by URI::implementor at line 5 use URI::Escape qw(uri_unescape); # spent 36µs making 1 call to URI::_query::BEGIN@5 # spent 30µs making 1 call to Exporter::import
6 |  |  |  |  |
7 |  |  |  |  | sub query
8 |  |  |  |  | {
9 |  |  |  |  | my $self = shift;
10 |  |  |  |  | $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;
11 |  |  |  |  |
12 |  |  |  |  | if (@_) {
13 |  |  |  |  | my $q = shift;
14 |  |  |  |  | $$self = $1;
15 |  |  |  |  | if (defined $q) {
16 |  |  |  |  | $q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
17 |  |  |  |  | $$self .= "?$q";
18 |  |  |  |  | }
19 |  |  |  |  | $$self .= $3;
20 |  |  |  |  | }
21 |  |  |  |  | $2;
22 |  |  |  |  | }
23 |  |  |  |  |
24 |  |  |  |  | # Handle ...?foo=bar&bar=foo type of query
25 |  |  |  |  | sub query_form {
26 |  |  |  |  | my $self = shift;
27 |  |  |  |  | my $old = $self->query;
28 |  |  |  |  | if (@_) {
29 |  |  |  |  | # Try to set query string
30 |  |  |  |  | my $delim;
31 |  |  |  |  | my $r = $_[0];
32 |  |  |  |  | if (ref($r) eq "ARRAY") {
33 |  |  |  |  | $delim = $_[1];
34 |  |  |  |  | @_ = @$r;
35 |  |  |  |  | }
36 |  |  |  |  | elsif (ref($r) eq "HASH") {
37 |  |  |  |  | $delim = $_[1];
38 |  |  |  |  | @_ = %$r;
39 |  |  |  |  | }
40 |  |  |  |  | $delim = pop if @_ % 2;
41 |  |  |  |  |
42 |  |  |  |  | my @query;
43 |  |  |  |  | while (my($key,$vals) = splice(@_, 0, 2)) {
44 |  |  |  |  | $key = '' unless defined $key;
45 |  |  |  |  | $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
46 |  |  |  |  | $key =~ s/ /+/g;
47 |  |  |  |  | $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
48 |  |  |  |  | for my $val (@$vals) {
49 |  |  |  |  | $val = '' unless defined $val;
50 |  |  |  |  | $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
51 |  |  |  |  | $val =~ s/ /+/g;
52 |  |  |  |  | push(@query, "$key=$val");
53 |  |  |  |  | }
54 |  |  |  |  | }
55 |  |  |  |  | if (@query) {
56 |  |  |  |  | unless ($delim) {
57 |  |  |  |  | $delim = $1 if $old && $old =~ /([&;])/;
58 |  |  |  |  | $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
59 |  |  |  |  | }
60 |  |  |  |  | $self->query(join($delim, @query));
61 |  |  |  |  | }
62 |  |  |  |  | else {
63 |  |  |  |  | $self->query(undef);
64 |  |  |  |  | }
65 |  |  |  |  | }
66 |  |  |  |  | return if !defined($old) || !length($old) || !defined(wantarray);
67 |  |  |  |  | return unless $old =~ /=/; # not a form
68 |  |  |  |  | map { s/\+/ /g; uri_unescape($_) }
69 |  |  |  |  | map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
70 |  |  |  |  | }
71 |  |  |  |  |
72 |  |  |  |  | # Handle ...?dog+bones type of query
73 |  |  |  |  | sub query_keywords
74 |  |  |  |  | {
75 |  |  |  |  | my $self = shift;
76 |  |  |  |  | my $old = $self->query;
77 |  |  |  |  | if (@_) {
78 |  |  |  |  | # Try to set query string
79 |  |  |  |  | my @copy = @_;
80 |  |  |  |  | @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
81 |  |  |  |  | for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
82 |  |  |  |  | $self->query(@copy ? join('+', @copy) : undef);
83 |  |  |  |  | }
84 |  |  |  |  | return if !defined($old) || !defined(wantarray);
85 |  |  |  |  | return if $old =~ /=/; # not keywords, but a form
86 |  |  |  |  | map { uri_unescape($_) } split(/\+/, $old, -1);
87 |  |  |  |  | }
88 |  |  |  |  |
89 |  |  |  |  | # Some URI::URL compatibility stuff
90 | 1 | 1µs |  |  | *equery = \&query;
91 |  |  |  |  |
92 | 1 | 4µs |  |  | 1;