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

   1 package URI::QueryParam;
   2
   3 use strict;
   4
   5 sub URI::_query::query_param {
   6     my $self = shift;
   7     my @old = $self->query_form;
   8
   9     if (@_ == 0) {
  10         # get keys
  11         my %seen;
  12         my @keys;
  13         for (my $i = 0; $i < @old; $i += 2) {
  14             push(@keys, $old[$i]) unless $seen{$old[$i]}++;
  15         }
  16         return @keys;
  17     }
  18
  19     my $key = shift;
  20     my @i;
  21
  22     for (my $i = 0; $i < @old; $i += 2) {
  23         push(@i, $i) if $old[$i] eq $key;
  24     }
  25
  26     if (@_) {
  27         my @new = @old;
  28         my @new_i = @i;
  29         my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
  30         #print "VALS:@vals [@i]\n";
  31         while (@new_i > @vals) {
  32             #print "REMOVE $new_i[-1]\n";
  33             splice(@new, pop(@new_i), 2);
  34         }
  35         while (@vals > @new_i) {
  36             my $i = @new_i ? $new_i[-1] + 2 : @new;
  37             #print "SPLICE $i\n";
  38             splice(@new, $i, 0, $key => pop(@vals));
  39         }
  40         for (@vals) {
  41             #print "SET $new_i[0]\n";
  42             $new[shift(@new_i)+1] = $_;
  43         }
  44
  45         $self->query_form(\@new);
  46     }
  47
  48     return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
  49 }
  50
  51 sub URI::_query::query_param_append {
  52     my $self = shift;
  53     my $key = shift;
  54     $self->query_form($self->query_form, $key => \@_);  # XXX
  55     return;
  56 }
  57
  58 sub URI::_query::query_param_delete {
  59     my $self = shift;
  60     my $key = shift;
  61     my @old = $self->query_form;
  62     my @vals;
  63
  64     for (my $i = @old - 2; $i >= 0; $i -= 2) {
  65         next if $old[$i] ne $key;
  66         push(@vals, (splice(@old, $i, 2))[1]);
  67     }
  68     $self->query_form(\@old) if @vals;
  69     return wantarray ? reverse @vals : $vals[-1];
  70 }
  71
  72 sub URI::_query::query_form_hash {
  73     my $self = shift;
  74     my @old = $self->query_form;
  75     if (@_) {
  76         $self->query_form(@_ == 1 ? %{shift(@_)} : @_);
  77     }
  78     my %hash;
  79     while (my($k, $v) = splice(@old, 0, 2)) {
  80         if (exists $hash{$k}) {
  81             for ($hash{$k}) {
  82                 $_ = [$_] unless ref($_) eq "ARRAY";
  83                 push(@$_, $v);
  84             }
  85         }
  86         else {
  87             $hash{$k} = $v;
  88         }
  89     }
  90     return \%hash;
  91 }
  92
  93 1;
  94
  95 __END__
  96
  97 =head1 NAME
  98
  99 URI::QueryParam - Additional query methods for URIs
 100
 101 =head1 SYNOPSIS
 102
 103   use URI;
 104   use URI::QueryParam;
 105
 106   $u = URI->new("", "http");
 107   $u->query_param(foo => 1, 2, 3);
 108   print $u->query;    # prints foo=1&foo=2&foo=3
 109
 110   for my $key ($u->query_param) {
 111       print "$key: ", join(", ", $u->query_param($key)), "\n";
 112   }
 113
 114 =head1 DESCRIPTION
 115
 116 Loading the C<URI::QueryParam> module adds some extra methods to
 117 URIs that support query methods.  These methods provide an alternative
 118 interface to the $u->query_form data.
 119
 120 The query_param_* methods have deliberately been made identical to the
 121 interface of the corresponding C<CGI.pm> methods.
 122
 123 The following additional methods are made available:
 124
 125 =over
 126
 127 =item @keys = $u->query_param
 128
 129 =item @values = $u->query_param( $key )
 130
 131 =item $first_value = $u->query_param( $key )
 132
 133 =item $u->query_param( $key, $value,... )
 134
 135 If $u->query_param is called with no arguments, it returns all the
 136 distinct parameter keys of the URI.  In a scalar context it returns the
 137 number of distinct keys.
 138
 139 When a $key argument is given, the method returns the parameter values with the
 140 given key.  In a scalar context, only the first parameter value is
 141 returned.
 142
 143 If additional arguments are given, they are used to update successive
 144 parameters with the given key.  If any of the values provided are
 145 array references, then the array is dereferenced to get the actual
 146 values.
 147
 148 =item $u->query_param_append($key, $value,...)
 149
 150 Adds new parameters with the given
 151 key without touching any old parameters with the same key.  It
 152 can be explained as a more efficient version of:
 153
 154    $u->query_param($key,
 155                    $u->query_param($key),
 156                    $value,...);
 157
 158 One difference is that this expression would return the old values
 159 of $key, whereas the query_param_append() method does not.
 160
 161 =item @values = $u->query_param_delete($key)
 162
 163 =item $first_value = $u->query_param_delete($key)
 164
 165 Deletes all key/value pairs with the given key.
 166 The old values are returned.  In a scalar context, only the first value
 167 is returned.
 168
 169 Using the query_param_delete() method is slightly more efficient than
 170 the equivalent:
 171
 172    $u->query_param($key, []);
 173
 174 =item $hashref = $u->query_form_hash
 175
 176 =item $u->query_form_hash( \%new_form )
 177
 178 Returns a reference to a hash that represents the
 179 query form's key/value pairs.  If a key occurs multiple times, then the hash
 180 value becomes an array reference.
 181
 182 Note that sequence information is lost.  This means that:
 183
 184    $u->query_form_hash($u->query_form_hash)
 185
 186 is not necessarily a no-op, as it may reorder the key/value pairs.
 187 The values returned by the query_param() method should stay the same
 188 though.
 189
 190 =back
 191
 192 =head1 SEE ALSO
 193
 194 L<URI>, L<CGI>
 195
 196 =head1 COPYRIGHT
 197
 198 Copyright 2002 Gisle Aas.
 199
 200 =cut