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