Commit | Line | Data |
3fea05b9 |
1 | package URI::_query; |
2 | |
3 | use strict; |
4 | use URI (); |
5 | use URI::Escape qw(uri_unescape); |
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 | *equery = \&query; |
91 | |
92 | 1; |