| package URI::_query; |
| |
| use strict; |
| use URI (); |
| use URI::Escape qw(uri_unescape); |
| |
| sub query |
| { |
| my $self = shift; |
| $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die; |
| |
| if (@_) { |
| my $q = shift; |
| $$self = $1; |
| if (defined $q) { |
| $q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego; |
| $$self .= "?$q"; |
| } |
| $$self .= $3; |
| } |
| $2; |
| } |
| |
| # Handle ...?foo=bar&bar=foo type of query |
| sub query_form { |
| my $self = shift; |
| my $old = $self->query; |
| if (@_) { |
| # Try to set query string |
| my @new = @_; |
| if (@new == 1) { |
| my $n = $new[0]; |
| if (ref($n) eq "ARRAY") { |
| @new = @$n; |
| } |
| elsif (ref($n) eq "HASH") { |
| @new = %$n; |
| } |
| } |
| my @query; |
| while (my($key,$vals) = splice(@new, 0, 2)) { |
| $key = '' unless defined $key; |
| $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; |
| $key =~ s/ /+/g; |
| $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals]; |
| for my $val (@$vals) { |
| $val = '' unless defined $val; |
| $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; |
| $val =~ s/ /+/g; |
| push(@query, "$key=$val"); |
| } |
| } |
| $self->query(@query ? join('&', @query) : undef); |
| } |
| return if !defined($old) || !length($old) || !defined(wantarray); |
| return unless $old =~ /=/; # not a form |
| map { s/\+/ /g; uri_unescape($_) } |
| map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/&/, $old); |
| } |
| |
| # Handle ...?dog+bones type of query |
| sub query_keywords |
| { |
| my $self = shift; |
| my $old = $self->query; |
| if (@_) { |
| # Try to set query string |
| my @copy = @_; |
| @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY"; |
| for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; } |
| $self->query(@copy ? join('+', @copy) : undef); |
| } |
| return if !defined($old) || !defined(wantarray); |
| return if $old =~ /=/; # not keywords, but a form |
| map { uri_unescape($_) } split(/\+/, $old, -1); |
| } |
| |
| # Some URI::URL compatibility stuff |
| *equery = \&query; |
| |
| 1; |