File | /project/perl/lib/URI/_query.pm |
Statements Executed | 11 |
Statement Execution Time | 1.49ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | URI::_query::
0 | 0 | 0 | 0s | 0s | query | URI::_query::
0 | 0 | 0 | 0s | 0s | query_form | URI::_query::
0 | 0 | 0 | 0s | 0s | query_keywords | URI::_query::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package URI::_query; | ||||
2 | |||||
3 | 3 | 92µs | 1 | 26µs | use strict; # spent 26µs making 1 call to strict::import |
4 | 3 | 63µs | use URI (); | ||
5 | 3 | 1.31ms | 1 | 218µs | use URI::Escape qw(uri_unescape); # spent 218µ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::escapes{$1}/go; | ||||
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 @new = @_; | ||||
31 | if (@new == 1) { | ||||
32 | my $n = $new[0]; | ||||
33 | if (ref($n) eq "ARRAY") { | ||||
34 | @new = @$n; | ||||
35 | } | ||||
36 | elsif (ref($n) eq "HASH") { | ||||
37 | @new = %$n; | ||||
38 | } | ||||
39 | } | ||||
40 | my @query; | ||||
41 | while (my($key,$vals) = splice(@new, 0, 2)) { | ||||
42 | $key = '' unless defined $key; | ||||
43 | $key =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g; | ||||
44 | $key =~ s/ /+/g; | ||||
45 | $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals]; | ||||
46 | for my $val (@$vals) { | ||||
47 | $val = '' unless defined $val; | ||||
48 | $val =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g; | ||||
49 | $val =~ s/ /+/g; | ||||
50 | push(@query, "$key=$val"); | ||||
51 | } | ||||
52 | } | ||||
53 | $self->query(@query ? join('&', @query) : undef); | ||||
54 | } | ||||
55 | return if !defined($old) || !length($old) || !defined(wantarray); | ||||
56 | return unless $old =~ /=/; # not a form | ||||
57 | map { s/\+/ /g; uri_unescape($_) } | ||||
58 | map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/&/, $old); | ||||
59 | } | ||||
60 | |||||
61 | # Handle ...?dog+bones type of query | ||||
62 | sub query_keywords | ||||
63 | { | ||||
64 | my $self = shift; | ||||
65 | my $old = $self->query; | ||||
66 | if (@_) { | ||||
67 | # Try to set query string | ||||
68 | my @copy = @_; | ||||
69 | @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY"; | ||||
70 | for (@copy) { s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g; } | ||||
71 | $self->query(@copy ? join('+', @copy) : undef); | ||||
72 | } | ||||
73 | return if !defined($old) || !defined(wantarray); | ||||
74 | return if $old =~ /=/; # not keywords, but a form | ||||
75 | map { uri_unescape($_) } split(/\+/, $old, -1); | ||||
76 | } | ||||
77 | |||||
78 | # Some URI::URL compatibility stuff | ||||
79 | 1 | 9µs | *equery = \&query; | ||
80 | |||||
81 | 1 | 14µs | 1; |