home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / URI / _query.pm < prev    next >
Text File  |  2006-11-29  |  2KB  |  82 lines
  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::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. *equery = \&query;
  80.  
  81. 1;
  82.