Commit | Line | Data |
3fea05b9 |
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 |