1package URI::_query; 2 3use strict; 4use URI (); 5use URI::Escape qw(uri_unescape); 6 7sub 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 25sub 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 62sub 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*equery = \&query; 80 811; 82