git.maemo.org Git - pkg-perl/blob - deb-src/liburi-perl/liburi-perl-1.35.dfsg.1/URI/_query.pm

   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;