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 | utf8::downgrade($q);
|
---|
18 | $$self .= "?$q";
|
---|
19 | }
|
---|
20 | $$self .= $3;
|
---|
21 | }
|
---|
22 | $2;
|
---|
23 | }
|
---|
24 |
|
---|
25 | # Handle ...?foo=bar&bar=foo type of query
|
---|
26 | sub query_form {
|
---|
27 | my $self = shift;
|
---|
28 | my $old = $self->query;
|
---|
29 | if (@_) {
|
---|
30 | # Try to set query string
|
---|
31 | my $delim;
|
---|
32 | my $r = $_[0];
|
---|
33 | if (ref($r) eq "ARRAY") {
|
---|
34 | $delim = $_[1];
|
---|
35 | @_ = @$r;
|
---|
36 | }
|
---|
37 | elsif (ref($r) eq "HASH") {
|
---|
38 | $delim = $_[1];
|
---|
39 | @_ = %$r;
|
---|
40 | }
|
---|
41 | $delim = pop if @_ % 2;
|
---|
42 |
|
---|
43 | my @query;
|
---|
44 | while (my($key,$vals) = splice(@_, 0, 2)) {
|
---|
45 | $key = '' unless defined $key;
|
---|
46 | $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
|
---|
47 | $key =~ s/ /+/g;
|
---|
48 | $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
|
---|
49 | for my $val (@$vals) {
|
---|
50 | $val = '' unless defined $val;
|
---|
51 | $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
|
---|
52 | $val =~ s/ /+/g;
|
---|
53 | push(@query, "$key=$val");
|
---|
54 | }
|
---|
55 | }
|
---|
56 | if (@query) {
|
---|
57 | unless ($delim) {
|
---|
58 | $delim = $1 if $old && $old =~ /([&;])/;
|
---|
59 | $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
|
---|
60 | }
|
---|
61 | $self->query(join($delim, @query));
|
---|
62 | }
|
---|
63 | else {
|
---|
64 | $self->query(undef);
|
---|
65 | }
|
---|
66 | }
|
---|
67 | return if !defined($old) || !length($old) || !defined(wantarray);
|
---|
68 | return unless $old =~ /=/; # not a form
|
---|
69 | map { s/\+/ /g; uri_unescape($_) }
|
---|
70 | map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
|
---|
71 | }
|
---|
72 |
|
---|
73 | # Handle ...?dog+bones type of query
|
---|
74 | sub query_keywords
|
---|
75 | {
|
---|
76 | my $self = shift;
|
---|
77 | my $old = $self->query;
|
---|
78 | if (@_) {
|
---|
79 | # Try to set query string
|
---|
80 | my @copy = @_;
|
---|
81 | @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
|
---|
82 | for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
|
---|
83 | $self->query(@copy ? join('+', @copy) : undef);
|
---|
84 | }
|
---|
85 | return if !defined($old) || !defined(wantarray);
|
---|
86 | return if $old =~ /=/; # not keywords, but a form
|
---|
87 | map { uri_unescape($_) } split(/\+/, $old, -1);
|
---|
88 | }
|
---|
89 |
|
---|
90 | # Some URI::URL compatibility stuff
|
---|
91 | *equery = \&query;
|
---|
92 |
|
---|
93 | 1;
|
---|