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