r67874 - in /trunk/liburi-query-perl: MANIFEST MANIFEST.SKIP Makefile.PL Query.pm TODO debian/changelog t/01_constructor.t t/02_methods.t t/03_hash.t t/04_revert.t t/05_sep.t t/06_eq.t t/07_unesc.t
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Tue Jan 25 22:48:19 UTC 2011
Author: periapt-guest
Date: Tue Jan 25 22:48:11 2011
New Revision: 67874
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67874
Log:
New upstream release
Added:
trunk/liburi-query-perl/MANIFEST.SKIP
- copied unchanged from r67873, branches/upstream/liburi-query-perl/current/MANIFEST.SKIP
trunk/liburi-query-perl/t/07_unesc.t
- copied unchanged from r67873, branches/upstream/liburi-query-perl/current/t/07_unesc.t
Removed:
trunk/liburi-query-perl/TODO
Modified:
trunk/liburi-query-perl/MANIFEST
trunk/liburi-query-perl/Makefile.PL
trunk/liburi-query-perl/Query.pm
trunk/liburi-query-perl/debian/changelog
trunk/liburi-query-perl/t/01_constructor.t
trunk/liburi-query-perl/t/02_methods.t
trunk/liburi-query-perl/t/03_hash.t
trunk/liburi-query-perl/t/04_revert.t
trunk/liburi-query-perl/t/05_sep.t
trunk/liburi-query-perl/t/06_eq.t
Modified: trunk/liburi-query-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/MANIFEST?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/MANIFEST (original)
+++ trunk/liburi-query-perl/MANIFEST Tue Jan 25 22:48:11 2011
@@ -1,5 +1,6 @@
Makefile.PL
MANIFEST
+MANIFEST.SKIP
Query.pm
README
t/01_constructor.t
@@ -8,6 +9,7 @@
t/04_revert.t
t/05_sep.t
t/06_eq.t
+t/07_unesc.t
t/t03/hash
t/t03/hash_arrayref
t/t03/hidden
Modified: trunk/liburi-query-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/Makefile.PL?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/Makefile.PL (original)
+++ trunk/liburi-query-perl/Makefile.PL Tue Jan 25 22:48:11 2011
@@ -7,7 +7,7 @@
'VERSION_FROM' => 'Query.pm', # finds $VERSION
'PREREQ_PM' => {
URI => 1.31,
- Test::More => 0,
+ Test::More => 0.88,
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(AUTHOR => 'Gavin Carr <gavin at openfusion.com.au>') : ()),
Modified: trunk/liburi-query-perl/Query.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/Query.pm?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/Query.pm (original)
+++ trunk/liburi-query-perl/Query.pm Tue Jan 25 22:48:11 2011
@@ -7,15 +7,15 @@
use 5.00503;
use strict;
-use URI::Escape qw(uri_escape_utf8);
-
-use overload
+use URI::Escape qw(uri_escape_utf8 uri_unescape);
+
+use overload
'""' => \&stringify,
'eq' => sub { $_[0]->stringify eq $_[1]->stringify },
'ne' => sub { $_[0]->stringify ne $_[1]->stringify };
use vars q($VERSION);
-$VERSION = '0.07';
+$VERSION = '0.08';
# -------------------------------------------------------------------------
# Remove all occurrences of the given parameters
@@ -82,7 +82,7 @@
{
my $self = shift;
# Revert qq to the qq_orig hashref
- $self->{qq} = $self->deepcopy($self->{qq_orig});
+ $self->{qq} = $self->_deepcopy($self->{qq_orig});
$self
}
@@ -111,42 +111,36 @@
}
# Return the current query as a string of html hidden input tags
-sub hidden
+sub hidden
{
my $self = shift;
my $str = '';
for my $key (sort keys %{$self->{qq}}) {
for my $value (@{$self->{qq}->{$key}}) {
$str .= qq(<input type="hidden" name="$key" value="$value" />\n);
- }
+ }
}
return $str;
}
# -------------------------------------------------------------------------
-# Parse query string, storing as hash (qq) of key => arrayref pairs
-sub parse_qs
-{
- my $self = shift;
- my $qs = shift;
- for (split /&/, $qs) {
- my ($key, $value) = split /=/;
- $self->{qq}->{$key} ||= [];
- push @{$self->{qq}->{$key}}, $value if defined $value && $value ne '';
- }
- $self
+# Set the output separator to use by default
+sub separator
+{
+ my $self = shift;
+ $self->{sep} = shift;
}
# Deep copy routine, originally swiped from a Randal Schwartz column
-sub deepcopy
+sub _deepcopy
{
my ($self, $this) = @_;
if (! ref $this) {
return $this;
} elsif (ref $this eq "ARRAY") {
- return [map $self->deepcopy($_), @$this];
+ return [map $self->_deepcopy($_), @$this];
} elsif (ref $this eq "HASH") {
- return {map { $_ => $self->deepcopy($this->{$_}) } keys %$this};
+ return {map { $_ => $self->_deepcopy($this->{$_}) } keys %$this};
} elsif (ref $this eq "CODE") {
return $this;
} elsif (sprintf $this) {
@@ -157,14 +151,46 @@
}
}
-# Set the output separator to use by default
-sub separator
-{
- my $self = shift;
- $self->{sep} = shift;
-}
-
-# Constructor - either new($qs) where $qs is a scalar query string or a
+# Parse query string, storing as hash (qq) of key => arrayref pairs
+sub _parse_qs
+{
+ my $self = shift;
+ my $qs = shift;
+ for (split /[&;]/, $qs) {
+ my ($key, $value) = map { uri_unescape($_) } split /=/, $_, 2;
+ $self->{qq}->{$key} ||= [];
+ push @{$self->{qq}->{$key}}, $value if defined $value && $value ne '';
+ }
+ $self
+}
+
+# Process arrayref arguments into hash (qq) of key => arrayref pairs
+sub _init_from_arrayref
+{
+ my ($self, $arrayref) = @_;
+ while (@$arrayref) {
+ my $key = shift @$arrayref;
+ my $value = shift @$arrayref;
+ my $key_unesc = uri_unescape($key);
+
+ $self->{qq}->{$key_unesc} ||= [];
+ if (defined $value && $value ne '') {
+ my @values;
+ if (! ref $value) {
+ @values = split "\0", $value;
+ }
+ elsif (ref $value eq 'ARRAY') {
+ @values = @$value;
+ }
+ else {
+ die "Invalid value found: $value. Not string or arrayref!";
+ }
+ push @{$self->{qq}->{$key_unesc}}, map { uri_unescape($_) } @values;
+ }
+ }
+}
+
+# Constructor - either new($qs) where $qs is a scalar query string or a
# a hashref of key => value pairs, or new(key => val, key => val);
# In the array form, keys can repeat, and/or values can be arrayrefs.
sub new
@@ -172,30 +198,18 @@
my $class = shift;
my $self = bless { qq => {} }, $class;
if (@_ == 1 && ! ref $_[0] && $_[0]) {
- my $qs = shift || '';
- # Standardise arg separator
- $qs =~ s/;/&/g;
- $self->parse_qs($qs);
+ $self->_parse_qs($_[0]);
}
elsif (@_ == 1 && ref $_[0] eq 'HASH') {
- for my $key (keys %{$_[0]}) {
- $self->{qq}->{$key} ||= [];
- my $value = $_[0]->{$key};
- push @{$self->{qq}->{$key}}, (ref $value eq 'ARRAY' ? @$value : $value)
- if defined $value && $value ne '';
- }
- }
- else {
- while (@_ >= 2) {
- my $key = shift;
- my $value = shift;
- $self->{qq}->{$key} ||= [];
- push @{$self->{qq}->{$key}}, (ref $value eq 'ARRAY' ? @$value : $value)
- if defined $value && $value ne '';
- }
- }
- # Clone the qq hashref to allow reversion
- $self->{qq_orig} = $self->deepcopy($self->{qq});
+ $self->_init_from_arrayref([ %{$_[0]} ]);
+ }
+ elsif (scalar(@_) % 2 == 0) {
+ $self->_init_from_arrayref(\@_);
+ }
+
+ # Clone the qq hashref to allow reversion
+ $self->{qq_orig} = $self->_deepcopy($self->{qq});
+
return $self;
}
# -------------------------------------------------------------------------
@@ -210,8 +224,13 @@
# Constructor - using a GET query string
$qq = URI::Query->new($query_string);
- # OR Constructor - using a set of key => value parameters
- $qq = URI::Query->new(%Vars);
+ # OR Constructor - using a hashref of key => value parameters
+ $qq = URI::Query->new($cgi->Vars);
+ # OR Constructor - using an array of successive keys and values
+ $qq = URI::Query->new(@params);
+
+ # Revert back to the initial constructor state (to do it all again)
+ $qq->revert;
# Remove all occurrences of the given parameters
$qq->strip('page', 'next');
@@ -244,27 +263,183 @@
# Get the current query string as a set of hidden input tags
print $qq->hidden;
- # Revert back to the initial constructor state (to do it all again)
- $qq->revert;
-
=head1 DESCRIPTION
URI::Query provides simple URI query string manipulation, allowing you
to create and manipulate URI query strings from GET and POST requests in
-web applications. This is primarily useful for creating links where you
+web applications. This is primarily useful for creating links where you
wish to preserve some subset of the parameters to the current request,
-and potentially add or replace others. Given a query string this is
-doable with regexes, of course, but making sure you get the anchoring
+and potentially add or replace others. Given a query string this is
+doable with regexes, of course, but making sure you get the anchoring
and escaping right is tedious and error-prone - this module is simpler.
+=head2 CONSTRUCTOR
+
+URI::Query objects can be constructed from scalar query strings
+('foo=1&bar=2&bar=3'), from a hashref which has parameters as keys, and
+values either as scalars or arrayrefs of scalars (to handle the case of
+parameters with multiple values e.g. { foo => '1', bar => [ '2', '3' ] }),
+or arrays composed of successive parameters-value pairs
+e.g. ('foo', '1', 'bar', '2', 'bar', '3'). For instance:
+
+ # Constructor - using a GET query string
+ $qq = URI::Query->new($query_string);
+
+ # Constructor - using an array of successive keys and values
+ $qq = URI::Query->new(@params);
+
+ # Constructor - using a hashref of key => value parameters,
+ # where values are either scalars or arrayrefs of scalars
+ $qq = URI::Query->new($cgi->Vars);
+
+URI::Query also handles L<CGI.pm>-style hashrefs, where multiple
+values are packed into a single string, separated by the "\0" (null)
+character.
+
+All keys and values are URI unescaped at construction time, and are
+stored and referenced unescaped. So a query string like:
+
+ group=prod%2Cinfra%2Ctest&op%3Aset=x%3Dy
+
+is stored as:
+
+ 'group' => 'prod,infra,test'
+ 'op:set' => 'x=y'
+
+You should always use the unescaped/normal variants in methods i.e.
+
+ $qq->replace('op:set' => 'x=z');
+
+NOT:
+
+ $qq->replace('op%3Aset' => 'x%3Dz');
+
+
+=head2 MODIFIER METHODS
+
+All modifier methods change the state of the URI::Query object in some
+way, and return $self, so they can be used in chained style e.g.
+
+ $qq->revert->strip('foo')->replace(bar => 123);
+
+Note that URI::Query stashes a copy of the parameter set that existed
+at construction time, so that any changes made by these methods can be
+rolled back using 'revert()'. So you don't (usually) need to keep
+multiple copies around to handle incompatible changes.
+
+=over 4
+
+=item revert()
+
+Revert the current parameter set back to that originally given at
+construction time i.e. discard all changes made since construction.
+
+=item strip($param1, $param2, ...)
+
+Remove all occurrences of the given parameters and their values from
+the current parameter set.
+
+=item strip_except($param1, $param2, ...)
+
+Remove all parameters EXCEPT those given from the current parameter
+set.
+
+=item strip_null()
+
+Remove all parameters that have a value of undef from the current
+parameter set.
+
+=item replace($param1 => $value1, $param2, $value2, ...)
+
+Replace the values of the given parameters in the current parameter set
+with these new ones. Parameter names must be scalars, but values can be
+either scalars or arrayrefs of scalars, when multiple values are desired.
+
+Note that 'replace' can also be used to add or append, since there's
+no requirement that the parameters already exist in the current parameter
+set.
+
+=item separator($separator)
+
+Set the argument separator to use for output. Default: '&'.
+
+=back
+
+=head2 OUTPUT METHODS
+
+=over 4
+
+=item "$qq", stringify(), stringify($separator)
+
+Return the current parameter set as a conventional param=value query
+string, using $separator as the separator if given. e.g.
+
+ foo=1&bar=2&bar=3
+
+Note that all parameters and values are URI escaped by stringify(), so
+that query-string reserved characters do not occur within elements. For
+instance, a parameter set of:
+
+ 'group' => 'prod,infra,test'
+ 'op:set' => 'x=y'
+
+will be stringified as:
+
+ group=prod%2Cinfra%2Ctest&op%3Aset=x%3Dy
+
+=item hash()
+
+Return a hash (in list context) or hashref (in scalar context) of the
+current parameter set. Single-item parameters have scalar values, while
+while multiple-item parameters have arrayref values e.g.
+
+ {
+ foo => 1,
+ bar => [ 2, 3 ],
+ }
+
+=item hash_arrayref()
+
+Return a hash (in list context) or hashref (in scalar context) of the
+current parameter set. All values are returned as arrayrefs, including
+those with single values e.g.
+
+ {
+ foo => [ 1 ],
+ bar => [ 2, 3 ],
+ }
+
+=item hidden()
+
+Returns the current parameter set as a concatenated string of hidden
+input tags, one per parameter-value e.g.
+
+ <input type="hidden" name="foo" value="1" />
+ <input type="hidden" name="bar" value="2" />
+ <input type="hidden" name="bar" value="3" />
+
+=back
=head1 BUGS AND CAVEATS
-None known.
-
-Note that this module doesn't do any input unescaping of query strings -
-you're (currently) expected to handle that explicitly yourself.
+Please report bugs and/or feature requests to
+C<bug-uri-query at rt.cpan.org>, or through
+the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=URI-Query>.
+
+Should allow unescaping of input to be turned off, for situations in
+which it's already been done. Please let me know if you find you
+actually need this.
+
+I don't think it makes sense on the output side though, since you need
+to understand the structure of the query to escape elements correctly.
+
+
+=head1 PATCHES
+
+URI::Query code lives at L<https://github.com/gavincarr/URI-Query>.
+Patches / pull requests welcome!
=head1 AUTHOR
@@ -274,11 +449,11 @@
=head1 COPYRIGHT
-Copyright 2004-2010, Gavin Carr. All Rights Reserved.
-
-This program is free software. You may copy or redistribute it under the
+Copyright 2004-2011, Gavin Carr. All Rights Reserved.
+
+This program is free software. You may copy or redistribute it under the
same terms as perl itself.
=cut
-
+# vim:sw=4:et
Modified: trunk/liburi-query-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/debian/changelog?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/debian/changelog (original)
+++ trunk/liburi-query-perl/debian/changelog Tue Jan 25 22:48:11 2011
@@ -1,8 +1,9 @@
-liburi-query-perl (0.07-2) UNRELEASED; urgency=low
+liburi-query-perl (0.08-1) UNRELEASED; urgency=low
* Added myself to Uploaders
+ * New upstream release
- -- Nicholas Bamber <nicholas at periapt.co.uk> Tue, 25 Jan 2011 22:48:06 +0000
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Tue, 25 Jan 2011 22:50:30 +0000
liburi-query-perl (0.07-1) unstable; urgency=low
Modified: trunk/liburi-query-perl/t/01_constructor.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/01_constructor.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/01_constructor.t (original)
+++ trunk/liburi-query-perl/t/01_constructor.t Tue Jan 25 22:48:11 2011
@@ -1,33 +1,46 @@
# Basic URI::Query tests
-use Test::More tests => 17;
+use Test::More;
use_ok(URI::Query);
use strict;
my $qq;
# Constructor - scalar version
-ok($qq = URI::Query->new('foo=1&foo=2&bar=3;bog=abc;bar=7;fluffy=3'), "constructor1 ok");
+ok($qq = URI::Query->new('foo=1&foo=2&bar=3;bog=abc;bar=7;fluffy=3'),
+ "scalar constructor ok");
is($qq->stringify, 'bar=3&bar=7&bog=abc&fluffy=3&foo=1&foo=2',
sprintf("stringifies ok (%s)", $qq->stringify));
# Constructor - array version
-ok($qq = URI::Query->new(foo => 1, foo => 2, bar => 3, bog => 'abc', bar => 7, fluffy => 3), "array constructor ok");
+ok($qq = URI::Query->new(foo => 1, foo => 2, bar => 3, bog => 'abc', bar => 7, fluffy => 3),
+ "array constructor ok");
is($qq->stringify, 'bar=3&bar=7&bog=abc&fluffy=3&foo=1&foo=2',
sprintf("stringifies ok (%s)", $qq->stringify));
# Constructor - hashref version
-ok($qq = URI::Query->new({ foo => [ 1, 2 ], bar => [ 3, 7 ], bog => 'abc', fluffy => 3 }), "hashref constructor ok");
+ok($qq = URI::Query->new({ foo => [ 1, 2 ], bar => [ 3, 7 ], bog => 'abc', fluffy => 3 }),
+ "hashref constructor ok");
+is($qq->stringify, 'bar=3&bar=7&bog=abc&fluffy=3&foo=1&foo=2',
+ sprintf("stringifies ok (%s)", $qq->stringify));
+
+# Constructor - CGI.pm-style hashref version, packed values
+ok($qq = URI::Query->new({ foo => "1\0002", bar => "3\0007", bog => 'abc', fluffy => 3 }),
+ "cgi-style hashref constructor ok");
is($qq->stringify, 'bar=3&bar=7&bog=abc&fluffy=3&foo=1&foo=2',
sprintf("stringifies ok (%s)", $qq->stringify));
# Bad constructor args
-for my $bad ((undef, '', \"foo", [ foo => 1 ], \*bad)) {
- my $b2 = $bad;
- $b2 = '[undef]' unless defined $bad;
- $qq = URI::Query->new($bad);
- ok(ref $qq eq 'URI::Query', "bad '$b2' constructor ok");
- is($qq->stringify, '', sprintf("stringifies ok (%s)", $qq->stringify));
+{
+ no warnings qw(once);
+ for my $bad ((undef, '', \"foo", [ foo => 1 ], \*bad)) {
+ my $b2 = $bad;
+ $b2 = '[undef]' unless defined $bad;
+ $qq = URI::Query->new($bad);
+ ok(ref $qq eq 'URI::Query', "bad '$b2' constructor ok");
+ is($qq->stringify, '', sprintf("stringifies ok (%s)", $qq->stringify));
+ }
}
-# arch-tag: 714ab082-385f-4158-bbf5-7547759ec65e
+done_testing;
+
Modified: trunk/liburi-query-perl/t/02_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/02_methods.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/02_methods.t (original)
+++ trunk/liburi-query-perl/t/02_methods.t Tue Jan 25 22:48:11 2011
@@ -41,4 +41,3 @@
is($qq->stringify, 'bog=abc&foo=1&foo=2&zero=0',
sprintf("strip_null correct (%s)", $qq->stringify));
-# arch-tag: 41878e14-bac6-41ab-9fa8-329151afb4de
Modified: trunk/liburi-query-perl/t/03_hash.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/03_hash.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/03_hash.t (original)
+++ trunk/liburi-query-perl/t/03_hash.t Tue Jan 25 22:48:11 2011
@@ -63,5 +63,3 @@
report $out, "hidden";
is($out, $result{hidden}, 'hidden ok');
-
-# arch-tag: 5f2184d9-67f0-4f89-a1e8-1f67beabdaa2
Modified: trunk/liburi-query-perl/t/04_revert.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/04_revert.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/04_revert.t (original)
+++ trunk/liburi-query-perl/t/04_revert.t Tue Jan 25 22:48:11 2011
@@ -23,5 +23,3 @@
my $str3 = $qq->stringify;
is($str1, $str3, "strings identical after revert");
-
-# arch-tag: 8db23dc8-a686-467f-a2f0-ca9127bb1f18
Modified: trunk/liburi-query-perl/t/05_sep.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/05_sep.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/05_sep.t (original)
+++ trunk/liburi-query-perl/t/05_sep.t Tue Jan 25 22:48:11 2011
@@ -62,5 +62,3 @@
report $out, "default";
is($out, $result{default}, "setting default separator ok");
-
-# arch-tag: c8d36b26-e951-4445-a280-bfdcb652b4e0
Modified: trunk/liburi-query-perl/t/06_eq.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-query-perl/t/06_eq.t?rev=67874&op=diff
==============================================================================
--- trunk/liburi-query-perl/t/06_eq.t (original)
+++ trunk/liburi-query-perl/t/06_eq.t Tue Jan 25 22:48:11 2011
@@ -13,5 +13,3 @@
ok($qq2 = URI::Query->new('bar=3'), 'qq2 constructor ok');
isnt($qq1, $qq2, 'ne ok');
-
-# arch-tag: 0fa9697e-843a-4cd3-a4d5-c4aac67430a0
More information about the Pkg-perl-cvs-commits
mailing list