source: main/trunk/greenstone2/perllib/cpan/URI/_query.pm@ 27174

Last change on this file since 27174 was 27174, checked in by davidb, 11 years ago

Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.

File size: 2.4 KB
Line 
1package URI::_query;
2
3use strict;
4use URI ();
5use URI::Escape qw(uri_unescape);
6
7sub 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::escape_char($1)/ego;
17 utf8::downgrade($q);
18 $$self .= "?$q";
19 }
20 $$self .= $3;
21 }
22 $2;
23}
24
25# Handle ...?foo=bar&bar=foo type of query
26sub query_form {
27 my $self = shift;
28 my $old = $self->query;
29 if (@_) {
30 # Try to set query string
31 my $delim;
32 my $r = $_[0];
33 if (ref($r) eq "ARRAY") {
34 $delim = $_[1];
35 @_ = @$r;
36 }
37 elsif (ref($r) eq "HASH") {
38 $delim = $_[1];
39 @_ = %$r;
40 }
41 $delim = pop if @_ % 2;
42
43 my @query;
44 while (my($key,$vals) = splice(@_, 0, 2)) {
45 $key = '' unless defined $key;
46 $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
47 $key =~ s/ /+/g;
48 $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
49 for my $val (@$vals) {
50 $val = '' unless defined $val;
51 $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
52 $val =~ s/ /+/g;
53 push(@query, "$key=$val");
54 }
55 }
56 if (@query) {
57 unless ($delim) {
58 $delim = $1 if $old && $old =~ /([&;])/;
59 $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
60 }
61 $self->query(join($delim, @query));
62 }
63 else {
64 $self->query(undef);
65 }
66 }
67 return if !defined($old) || !length($old) || !defined(wantarray);
68 return unless $old =~ /=/; # not a form
69 map { s/\+/ /g; uri_unescape($_) }
70 map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
71}
72
73# Handle ...?dog+bones type of query
74sub query_keywords
75{
76 my $self = shift;
77 my $old = $self->query;
78 if (@_) {
79 # Try to set query string
80 my @copy = @_;
81 @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
82 for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
83 $self->query(@copy ? join('+', @copy) : undef);
84 }
85 return if !defined($old) || !defined(wantarray);
86 return if $old =~ /=/; # not keywords, but a form
87 map { uri_unescape($_) } split(/\+/, $old, -1);
88}
89
90# Some URI::URL compatibility stuff
91*equery = \&query;
92
931;
Note: See TracBrowser for help on using the repository browser.