Rose-URI-1.00/0000750000076500001200000000000011350146141011571 5ustar johnadminRose-URI-1.00/Changes0000755000076500001200000000242411350146070013077 0ustar johnadmin1.00 (03.17.2010) - John Siracusa * Updated tests to accomodate new default escaping rules in URI::Escape 3.30 (and, presumably, later versions). * Bumped version number to reflect API stability. 0.50 (10.21.2008) - John Siracusa * Fixed a bug that caused empty query parameters to be omitted from the query string. * Added the omit_empty_query_params object attribute (with class- wide default override) to preserve the old behavior. 0.022 (02.06.2008) - John Siracusa * Improved handling or "keyword"-style query string (e.g., "/bar?foo") 0.021 (10.06.2005) - John Siracusa * Simplified cloning. * Corrected POD errors. 0.02 (10.05.2005) - John Siracusa * Fix cloning bugs. * Added configurable default query param separator. * Added POD links. 0.012 (12.09.2004) - John Siracusa * Fixed rel() to do explicit string comparison instead of relying on overload(), which seems to fail in perl 5.6.0 in that particular case. 0.011 (11.14.2004) - John Siracusa * Added copyright info. 0.01 (11.13.2004) - John Siracusa * Initial release. Rose-URI-1.00/lib/0000750000076500001200000000000011350146141012337 5ustar johnadminRose-URI-1.00/lib/Rose/0000750000076500001200000000000011350146141013247 5ustar johnadminRose-URI-1.00/lib/Rose/URI.pm0000755000076500001200000004717211350145764014301 0ustar johnadminpackage Rose::URI; use strict; use Carp(); use URI::Escape(); use Rose::Object; our @ISA = qw(Rose::Object); use overload ( '""' => sub { shift->as_string }, 'bool' => sub { length shift->as_string }, fallback => 1, ); our $Make_URI; our $SCHEME_RE = '[a-zA-Z][a-zA-Z0-9.+\-]*'; our $VERSION = '1.00'; # Class data use Rose::Class::MakeMethods::Generic ( inheritable_scalar => [ 'default_query_param_separator', 'default_omit_empty_query_params', ], ); # Object data use Rose::Object::MakeMethods::Generic ( scalar => [ 'username', 'password', 'scheme', 'host', 'port', 'path', 'fragment', 'query_param_separator' => { interface => 'get_set_init' }, ], ); __PACKAGE__->default_query_param_separator('&'); __PACKAGE__->default_omit_empty_query_params(0); sub init_query_param_separator { ref(shift)->default_query_param_separator } sub new { my($class) = shift; my $self = { username => '', password => '', scheme => '', host => '', port => '', path => '', query => {}, fragment => '', }; bless $self, $class; $self->init(@_); return $self; } sub init { my($self) = shift; if(@_ == 1) { $self->init_with_uri(@_); } else { $self->SUPER::init(@_); } } sub init_with_uri { my($self) = shift; $self->$Make_URI($_[0]); } sub clone { my($self) = shift; return bless _deep_copy($self), ref($self); } sub parse_query { my($self, $query) = @_; $self->{'query_string'} = undef; unless(defined $query && $query =~ /\S/) { $self->{'query'} = { }; return 1; } my @params; if(index($query, '&') >= 0) { @params = split(/&/, $query); } elsif(index($query, ';') >= 0) { @params = split(/;/, $query); } elsif(index($query, '=') < 0) { $self->{'query_string'} = __unescape_uri($query); $self->{'query'} = { $self->{'query_string'} => undef }; return 1; } @params = ($query) unless(@params); my %query; foreach my $item (@params) { my($param, $value) = map { __unescape_uri($_) } split(/=/, $item); $param = __unescape_uri($item) unless(defined($param)); if(exists $query{$param}) { if(ref $query{$param}) { push(@{$query{$param}}, $value); } else { $query{$param} = [ $query{$param}, $value ]; } } else { $query{$param} = $value; } } $self->{'query'} = \%query; return 1; } sub query_hash { my($self) = shift; return (wantarray) ? %{$self->{'query'}} : { %{$self->{'query'}} }; } sub omit_empty_query_params { my($self) = shift; if(@_) { return $self->{'omit_empty_query_params'} = $_[0] ? 1 : 0; } return defined $self->{'omit_empty_query_params'} ? $self->{'omit_empty_query_params'} : ref($self)->default_omit_empty_query_params; } sub query_param { my($self) = shift; if(@_ == 1) { return $self->{'query'}{$_[0]} if(exists $self->{'query'}{$_[0]}); return; } elsif(@_ == 2) { $self->{'query_string'} = undef; if(ref $_[1]) { return $self->{'query'}{$_[0]} = [ @{$_[1]} ]; } return $self->{'query'}{$_[0]} = $_[1]; } Carp::croak "query_param() takes either one or two arguments"; } sub query_params { my($self) = shift; return sort keys %{$self->{'query'}} unless(@_); my $params = $self->query_param(@_); $params = (ref $params) ? [ @$params ] : (defined $params) ? [ $params ] : []; return (wantarray) ? @$params : $params; } sub query_param_add { my($self, $name, $value) = @_; Carp::croak "query_add_param() takes two arguments" unless(@_ == 3); my $params = $self->query_params($name); push(@$params, (ref $value) ? @$value : $value); $self->query_param($name => (@$params > 1) ? $params : $params->[0]); return (wantarray) ? @$params : $params; } sub query_param_exists { my($self, $param) = @_; Carp::croak "Missing query param argument" unless(defined $param); return exists $self->{'query'}{$param}; } sub query_param_delete { my($self) = shift; Carp::croak "query_param_delete() takes one or more arguments" unless(@_); foreach my $param (@_) { if(defined $self->{'query_string'} && $param eq $self->{'query_string'}) { $self->{'query_string'} = undef; } delete $self->{'query'}{$param}; } } sub as_string { my($self) = shift; my $scheme = $self->scheme; my $user = $self->userinfo_escaped; my $port = $self->port; my $query = $self->query; my $frag = __escape_uri($self->fragment); return ((length $scheme) ? "$scheme://" : '') . ((length $user) ? "$user\@" : '') . $self->host . ((length $port) ? ":$port" : '') . __escape_uri_whole($self->path) . ((length $query) ? "?$query" : '') . ((length $frag) ? "#$frag" : ''); } sub query { my($self) = shift; if(@_ == 1) { if(ref $_[0]) { $self->{'query'} = _deep_copy($_[0]) } else { $self->parse_query($_[0]); } } elsif(@_) { $self->{'query'} = _deep_copy({ @_ }); } my $want = wantarray; return unless(defined wantarray); if(defined $self->{'query_string'}) { return __escape_uri($self->{'query_string'}); } my(@query, $omit_empty); foreach my $param (sort keys %{$self->{'query'}}) { my @values = $self->query_params($param); # Contortions to avoid calling this method in the common(?) case where # every query parameter has at least one value. if(!@values && !(defined $omit_empty ? $omit_empty : ($omit_empty = $self->omit_empty_query_params))) { @values = (''); } foreach my $value (@values) { push(@query, __escape_uri($param) . '=' . __escape_uri($value)); } } return join($self->query_param_separator, @query); } sub query_form { my($self) = shift; if(@_) { $self->{'query_string'} = undef; $self->{'query'} = { }; for(my $i = 0; $i < $#_; $i += 2) { $self->query_param_add($_[$i] => $_[$i + 1]); } } return unless(defined(wantarray)); my @query; foreach my $param ($self->query_params) { foreach my $value ($self->query_params($param)) { push(@query, $param, $value); } } return @query; } sub abs { my($self, $base) = @_; return $self unless($base && !length $self->scheme); my $new = $self->as_string; $new =~ s{^/}{}; $base =~ s{/$}{}; return Rose::URI->new("/$new") unless($base =~ m{^$SCHEME_RE://}o); return Rose::URI->new("$base/$new"); } sub rel { my($self, $base) = @_; return $self unless($base); my $uri = $self->as_string; if($uri =~ m{^$base/?}) { $uri =~ s{^$base/?}{}; return Rose::URI->new($uri); } return $self; } sub userinfo { my($self) = shift; my $user = $self->username; my $pass = $self->password; if(length $user && length $pass) { return join(':', $user, $pass); } return $user if(length $user); return ''; } sub userinfo_escaped { my($self) = shift; my $user = __escape_uri($self->username); my $pass = __escape_uri($self->password); if(length $user && length $pass) { return join(':', $user, $pass); } return $user if(length $user); return ''; } sub __uri_from_apache_uri { my($self) = shift; my $uri = Apache::URI->parse(Apache->request, @_); $self->{'username'} = $uri->user || ''; $self->{'password'} = $uri->password || ''; $self->{'scheme'} = $uri->scheme || ''; $self->{'host'} = $uri->hostname || ''; $self->{'port'} = $uri->port || ''; $self->{'path'} = $uri->path || ''; $self->{'fragment'} = $uri->fragment || ''; $self->parse_query($uri->query); return $uri; } sub __uri_from_uri { my($self) = shift; my $uri = URI->new(@_); if($uri->can('user')) { $self->{'username'} = $uri->user; } elsif($uri->can('userinfo')) { if(my $userinfo = $uri->userinfo) { if(my($user, $pass) = split(':', $userinfo)) { $self->{'username'} = __unescape_uri($user); $self->{'password'} = __unescape_uri($pass); } } } $self->{'scheme'} = __unescape_uri($uri->scheme || ''); $self->{'host'} = __unescape_uri($uri->host || '') if($uri->can('host')); $self->{'port'} = __unescape_uri($uri->_port || '') if($uri->can('_port')); $self->{'path'} = __unescape_uri($uri->path || '') if($uri->can('path')); $self->{'fragment'} = __unescape_uri($uri->fragment || ''); $self->parse_query($uri->query); return $uri; } if(exists $ENV{'MOD_PERL'} && require mod_perl && $mod_perl::VERSION < 1.99) { require Apache; require Apache::URI; require Apache::Util; *__escape_uri = \&Apache::Util::escape_uri; *__unescape_uri = \&Apache::Util::unescape_uri_info; $Make_URI = \&__uri_from_apache_uri; } else { *__escape_uri = \&URI::Escape::uri_escape; *__unescape_uri = sub { my $e = URI::Escape::uri_unescape(@_); $e =~ s/\+/ /g; return $e; }; require URI; $Make_URI = \&__uri_from_uri; } sub __escape_uri_whole { URI::Escape::uri_escape($_[0], (@_ > 1) ? (defined $_[1] ? $_[1] : ()) : q(^A-Za-z0-9\-_.,'!~*#?&()/?@\:\[\]=)); } # Based on code from Clone::PP sub _deep_copy { my($data) = shift; my $ref_type = ref $data or return $data; my $copy; if($ref_type eq 'HASH') { $copy = {}; %$copy = map { !ref($_) ? $_ : _deep_copy($_) } %$data; } elsif($ref_type eq 'ARRAY') { $copy = []; @$copy = map { !ref($_) ? $_ : _deep_copy($_) } @$data; } elsif($ref_type eq 'REF' or $ref_type eq 'SCALAR') { $copy = \(my $var = ''); $$copy = _deep_copy($$data); } elsif($ref_type->isa(__PACKAGE__)) # cloning { $copy = _deep_copy({ %{$data} }); } else { $copy = $data; } return $copy; } 1; __END__ =head1 NAME Rose::URI - A URI class that allows easy and efficient manipulation of URI components. =head1 SYNOPSIS use Rose::URI; $uri = Rose::URI->new('http://un:pw@foo.com/bar/baz?a=1&b=two+3'); $scheme = $uri->scheme; $user = $uri->username; $pass = $uri->password; $host = $uri->host; $path = $uri->path; ... $b = $uri->query_param('b'); # $b = "two 3" $a = $uri->query_param('a'); # $a = 1 $uri->query_param_delete('b'); $uri->query_param('c' => 'blah blah'); ... print $uri; =head1 DESCRIPTION L is an alternative to L. The important differences are as follows. L provides a rich set of query string manipulation methods. Query parameters can be added, removed, and checked for their existence. L allows the entire query to be set or returned as a whole via the L or L methods, and the L module provides a few more methods for query string manipulation. L supports query parameters with multiple values (e.g. "a=1&a=2"). L has limited support for this through L's list return value. Better methods are available in L. L uses Apache's C-based URI parsing and HTML escaping functions when running in a mod_perl 1.x web server environment. L stores each URI "in pieces" (scheme, host, path, etc.) and then assembles those pieces when the entire URI is needed as a string. This technique is based on the assumption that the URI will be manipulated many more times than it is stringified. If this is not the case in your usage scenario, then L may be a better alternative. Now some similarities: both classes use the L module to allow "magic" stringification. Both L and L objects can be printed and compared as if they were strings. L actually uses the L class to do the heavy lifting of parsing URIs when not running in a mod_perl 1.x environment. Finally, a caveat: L supports only "http"-like URIs. This includes ftp, http, https, and other similar looking URIs. L supports many more esoteric URI types (gopher, mailto, etc.) If you need to support these formats, use L instead. =head1 CONSTRUCTOR =over 4 =item B Constructs a URI object based on URI or PARAMS, where URI is a string and PARAMS are described below. Returns a new L object. The query string portion of the URI argument may use either "&" or ";" as the parameter separator. Examples: $uri = Rose::URI->new('/foo?a=1&b=2'); $uri = Rose::URI->new('/foo?a=1;b=2'); # same thing The L parameter determines what is used when the query string (or the whole URI) is output as a string later. L uses L or L (when running under mod_perl 1.x) to do its URI string parsing. Valid PARAMS are: fragment host password path port query scheme username query_param_separator Which correspond to the following URI pieces: ://@?# All the above parameters accept strings. See below for more information about the L parameter. The L parameter determines the separator used when constructing the query string. It is "&" by default (e.g. "a=1&b=2") =back =head1 CLASS METHODS =over 4 =item B Get or set a boolean value that determines whether or not query parameters with "empty" (that is, undef or zero-length) values will be omitted from the L string by default. The default value is false. =item B Get or set the character used to separate query parameters in the stringified version of L objects. Defaults to "&". =back =head1 OBJECT METHODS =over 4 =item B This method exists solely for compatibility with L. Returns an absolute L object. If the current URI is already absolute, then a reference to it is simply returned. If the current URI is relative, then a new absolute URI is constructed by combining the URI and the BASE, and returned. =item B Returns the URI as a string. The string is "URI escaped" (reserved URI characters are replaced with %xx sequences), but not "HTML escaped" (ampersands are not escaped, for example). =item B Returns a copy of the L object. =item B Get or set the fragment portion of the URI. =item B Get or set a boolean value that determines whether or not query parameters with "empty" (that is, undef or zero-length) values will be omitted from the L string. The default value is determined by the L class method. =item B Get or set the password portion of the URI. =item B Get or set the path portion of the URI. =item B Get or set the port number portion of the URI. =item B Get or sets the URI's query. QUERY may be an appropriately escaped query string (e.g. "a=1&b=2&c=a+long+string"), a reference to a hash, or a list of name/value pairs. Query strings may use either "&" or ";" as their query separator. If a "&" character exists anywhere in the query string, it is assumed to be the separator. If none of the characters "&", ";", or "=" appears in the query string, then the entire query string is taken as a single parameter name with an undefined value. Hashes and lists should specify multiple parameter values using array references. Here are some examples representing the query string "a=1&a=2&b=3" $uri->query("a=1&a=2&b=3"); # string $uri->query("a=1;a=2;b=3"); # same thing $uri->query({ a => [ 1, 2 ], b => 3 }); # hash ref $uri->query(a => [ 1, 2 ], b => 3); # list Returns the current (or new) query as a URI-escaped (but not HTML-escaped) query string. =item B Implementation of L's method of the same name. This exists for backwards compatibility purposes only and should not be used (or necessary). See the L documentation for more details. =item B Returns the current query as a hash (in list context) or reference to a hash (in scalar context), with multiple parameter values represented by array references (see the L method for details). The return value is a shallow copy of the actual query hash. It should be treated as read-only unless you really know what you are doing. Example: $uri = Rose::URI->new('/foo?a=1&b=2&a=2'); $h = $uri->query_hash; # $h = { a => [ 1, 2 ], b => 2 } =item B Get or set a query parameter. If only NAME is passed, it returns the value of the query parameter named NAME. Parameters with multiple values are returned as array references. If both NAME and VALUE are passed, it sets the parameter named NAME to VALUE, where VALUE can be a simple scalar value or a reference to an array of simple scalar values. Examples: $uri = Rose::URI->new('/foo?a=1'); $a = $uri->query_param('a'); # $a = 1 $uri->query_param('a' => 3); # query string is now "a=3" $uri->query_param('b' => [ 4, 5 ]); # now "a=3&b=4&b=5" $b = $uri->query_param('b'); # $b = [ 4, 5 ]; =item B Same as the L method, except the return value is always either an array (in list context) or reference to an array (in scalar context), even if there is only one value. Examples: $uri = Rose::URI->new('/foo?a=1&b=1&b=2'); $a = $uri->query_params('a'); # $a = [ 1 ] @a = $uri->query_params('a'); # @a = ( 1 ) $b = $uri->query_params('a'); # $b = [ 1, 2 ] @b = $uri->query_params('a'); # @b = ( 1, 2 ) =item B Adds a new value to a query parameter. Example: $uri = Rose::URI->new('/foo?a=1&b=1'); $a = $uri->query_param_add('b' => 2); # now "a=2&b=1&b=2" Returns an array (in list context) or reference to an array (in scalar context) of the new parameter value(s). =item B Deletes all instances of the parameter named NAME from the query. =item B Returns a boolean value indicating whether or not a parameter named NAME exists in the query string. =item B Get or set the character used to separate query parameters in the stringified version of the URI. Defaults to the return value of the L class method ("&" by default). =item B This method exists solely for compatibility with L. Returns a relative URI reference if it is possible to make one that denotes the same resource relative to BASE. If not, then the current URI is simply returned. =item B Get or set the scheme portion of the URI. =item B Returns the L and L attributes joined by a ":" (colon). The username and password are not escaped in any way. If there is no password, only the username is returned (without the colon). If neither exist, an empty string is returned. =item B Returns the L and L attributes joined by a ":" (colon). The username and password are URI-escaped, but not HTML-escaped. If there is no password, only the username is returned (without the colon). If neither exist, an empty string is returned. =item B Get or set the username portion of the URI. =back =head1 AUTHOR John C. Siracusa (siracusa@gmail.com) =head1 LICENSE Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Rose-URI-1.00/Makefile.PL0000755000076500001200000000225011077741663013572 0ustar johnadminrequire 5.006; use ExtUtils::MakeMaker; my $MM_Version = $ExtUtils::MakeMaker::VERSION; if($MM_Version =~ /_/) # dev version { $MM_Version = eval $MM_Version; die $@ if($@); } WriteMakefile(NAME => 'Rose::URI', PMLIBDIRS => [ 'lib' ], VERSION_FROM => 'lib/Rose/URI.pm', ($^O =~ /darwin/i ? (dist => { DIST_CP => 'cp' }) : ()), # Avoid Mac OS X ._* files PREREQ_PM => { Rose::Object => '0.015', overload => 0, URI => 0, URI::Escape => 0, }, ($MM_Version >= 6.48 ? (MIN_PERL_VERSION => '5.6.0') : ()), ($MM_Version >= 6.31 ? (LICENSE => 'perl') : ()), ($MM_Version <= 6.44 ? () : (META_MERGE => { resources => { license => 'http://dev.perl.org/licenses/', bugtracker => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-URI', repository => 'http://rose.googlecode.com/svn/trunk/modules/Rose-URI', }, }))); Rose-URI-1.00/MANIFEST0000755000076500001200000000023011350146141012725 0ustar johnadminChanges lib/Rose/URI.pm Makefile.PL MANIFEST t/basic.t t/pod.t t/query.t META.yml Module meta-data (added by MakeMaker) Rose-URI-1.00/META.yml0000660000076500001200000000140311350146141013043 0ustar johnadmin--- #YAML:1.0 name: Rose-URI version: 1.00 abstract: ~ author: [] license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: overload: 0 perl: 5.006000 Rose::Object: 0.015 URI: 0 URI::Escape: 0 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-URI license: http://dev.perl.org/licenses/ repository: http://rose.googlecode.com/svn/trunk/modules/Rose-URI no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Rose-URI-1.00/t/0000750000076500001200000000000011350146141012034 5ustar johnadminRose-URI-1.00/t/basic.t0000755000076500001200000000721111350145702013315 0ustar johnadmin#!/usr/bin/perl -w use strict; use Test::More tests => 28; BEGIN { use_ok('Rose::URI'); } my $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); ok(ref $uri eq 'Rose::URI' && $uri eq 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'parse full URI (&)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1;a=2;b=3#blah'); ok(ref $uri eq 'Rose::URI' && $uri eq 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'parse full URI (;)'); is($uri->scheme, 'http', 'scheme()'); is($uri->username, 'un', 'username()'); is($uri->password, 'pw', 'password()'); is($uri->host, 'ob.com', 'host()'); is($uri->port, '81', 'port()'); is($uri->path, '/bar/baz', 'path()'); is($uri->query, 'a=1&a=2&b=3', 'query()'); is($uri->fragment, 'blah', 'fragment()'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->abs, 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'abs() (simple)'); $uri = Rose::URI->new('/bar/baz?a=1&a=2&b=3#blah'); is($uri->abs('http://ob.com:81/'), 'http://ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'abs() (with base 1)'); $uri = Rose::URI->new('/bar/baz?a=1&a=2&b=3#blah'); is($uri->abs('http://ob.com:81'), 'http://ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'abs() (with base 2)'); $uri = Rose::URI->new('bar/baz?a=1&a=2&b=3#blah'); is($uri->abs('http://ob.com:81'), 'http://ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'abs() (with base 3)'); $uri = Rose::URI->new('bar/baz?a=1&a=2&b=3#blah'); is($uri->abs('http://ob.com:81/'), 'http://ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'abs() (with base 4)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel, 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'rel (no base)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel('http://un:pw@ob.com:81/'), 'bar/baz?a=1&a=2&b=3#blah', 'rel (good base 1)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel('http://un:pw@ob.com:81'), 'bar/baz?a=1&a=2&b=3#blah', 'rel (good base 2)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel('http://ob.com:81'), 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'rel (bad base 1)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel('http://un:pw@ob.com/'), 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'rel (bad base 2)'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri->rel('http://un:pw@ob.com:82/'), 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah', 'rel (bad base 3)'); $uri->query_param(c => '1 + 1 = 2'); is($uri, 'http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3&c=1%20%2B%201%20%3D%202#blah', 'escape 1'); $uri->path('/Foo Bar/Baz'); $uri->username('u/n&'); $uri->query_param(c => '?5/1 + 1-3 = 2_()'); # URI::Escape 3.30 escapes () but older versions do not ok($uri eq 'http://u%2Fn%26:pw@ob.com:81/Foo%20Bar/Baz?a=1&a=2&b=3&c=%3F5%2F1%20%2B%201-3%20%3D%202_()#blah' || $uri eq 'http://u%2Fn%26:pw@ob.com:81/Foo%20Bar/Baz?a=1&a=2&b=3&c=%3F5%2F1%20%2B%201-3%20%3D%202_%28%29#blah', 'escape 2'); my @values = (1, 2); my %query = (a => \@values, b => 3); $uri->query(\%query); my $original_uri = $uri->as_string; $values[0] = 8; $query{'b'} = 9; is($uri->as_string, $original_uri, 'deep copy 1'); my $uri2 = $uri->clone; is($uri2->as_string, $original_uri, 'clone 1'); $values[0] = 7; is($uri2->as_string, $original_uri, 'clone 2'); Rose::URI->default_query_param_separator(';'); $uri = Rose::URI->new('http://un:pw@ob.com:81/bar/baz?a=1&a=2&b=3#blah'); is($uri, 'http://un:pw@ob.com:81/bar/baz?a=1;a=2;b=3#blah', 'default query param separator (;)'); Rose-URI-1.00/t/pod.t0000755000076500001200000000025310760063517013024 0ustar johnadmin#!/usr/bin/perl -w use strict; use Test::More; eval 'use Test::Pod 1.00'; plan(skip_all => 'Test::Pod 1.00 required for testing POD') if($@); all_pod_files_ok(); Rose-URI-1.00/t/query.t0000755000076500001200000001023011077741663013412 0ustar johnadmin#!/usr/bin/perl -w use strict; use Test::More tests => 37; BEGIN { use_ok('Rose::URI'); } # # new() # my $uri = Rose::URI->new('/baz?a=1&a=2&b=3'); is($uri->query, 'a=1&a=2&b=3', 'parse simple (&)'); $uri = Rose::URI->new('/baz?a=1;a=2;b=3'); is($uri->query, 'a=1&a=2&b=3', 'parse simple (;)'); # # query_param_separator() # $uri->query_param_separator(';'); is($uri->query, 'a=1;a=2;b=3', 'switch separator'); $uri->query_param_separator('&'); is($uri->query, 'a=1&a=2&b=3', 'switch separator'); # # query() # $uri->query('foo+bar'); is($uri->as_string, '/baz?foo%20bar', 'get/set string (keywords) 0'); is($uri->query, 'foo%20bar', 'get/set string (keywords) 1'); ok($uri->query_param_exists('foo bar'), 'get/set string (keywords) 2'); $uri->query_param_delete('xxx'); ok($uri->query_param_exists('foo bar'), 'get/set string (keywords) 2.1'); $uri->query_param_delete('foo bar'); ok(!$uri->query_param_exists('foo bar'), 'get/set string (keywords) 2.2'); $uri->query('foo'); is($uri->query, 'foo', 'get/set string (keywords) 3'); ok($uri->query_param_exists('foo'), 'get/set string (keywords) 4'); $uri->query("a=1&a=2&b=3"); is($uri->query, 'a=1&a=2&b=3', 'get/set string (&)'); $uri->query("a=1;a=2;b=3+4+5"); is($uri->query, 'a=1&a=2&b=3%204%205', 'get/set string (;)'); $uri->query({ a => [ 1, 2 ], b => 3 }); is($uri->query, 'a=1&a=2&b=3', 'get/set hash'); $uri->query(a => [ 1, 2 ], b => 3); is($uri->query, 'a=1&a=2&b=3', 'get/set list'); # # query_param() # $uri->query_param('b' => 4); ok($uri->query_param('b', 4), 'get/set scalar'); $uri->query_param('a' => [ 11, 12 ]); my $a = $uri->query_param('a'); ok(ref $a eq 'ARRAY' && @$a == 2 && $a->[0] == 11 && $a->[1] == 12, 'get/set array ref'); $uri->query_param('b' => 3); my $b = $uri->query_params('b'); ok(ref $b eq 'ARRAY' && @$b == 1 && $b->[0] == 3, 'get array ref (single)'); $uri->query_param('a' => [ 1, 2 ]); $a = $uri->query_params('a'); ok(ref $a eq 'ARRAY' && @$a == 2 && $a->[0] == 1 && $a->[1] == 2, 'get array ref (multiple)'); # # query_params() # $uri->query_params('b' => 4); my @b = $uri->query_params('b'); ok(@b == 1 && $b[0] == 4, 'get array (single)'); $uri->query_params('a' => [ 11, 12 ]); my @a = $uri->query_params('a'); ok(@a == 2 && $a[0] == 11 && $a[1] == 12, 'get array (multiple)'); # # query_form() # $uri->query_form(a => 1, a => 2, b => 3); my @f = $uri->query_form; ok(@f == 6 && $f[0] eq 'a' && $f[1] == 1 && $f[2] eq 'a' && $f[3] == 2 && $f[4] eq 'b' && $f[5] == 3, 'list'); # # query_hash() # my $h = $uri->query_hash; ok(keys(%$h) == 2 && ref $h eq 'HASH' && $h->{'a'}[0] == 1 && $h->{'a'}[1] == 2 && $h->{'b'} == 3, 'hash ref'); my %h = $uri->query_hash; ok(keys(%h) == 2 && $h{'a'}[0] == 1 && $h{'a'}[1] == 2 && $h{'b'} == 3, 'hash'); # # query_param_add() # $uri->query_param_add(b => 4); @b = $uri->query_params('b'); ok(@b == 2 && $b[0] == 3 && $b[1] == 4, 'scalar'); $uri->query_param_add(b => [ 5, 6 ]); @b = $uri->query_params('b'); ok(@b == 4 && $b[0] == 3 && $b[1] == 4 && $b[2] == 5 && $b[3] == 6, 'array ref'); # # query_param_exists() # ok($uri->query_param_exists('a'), 'exists'); ok(!$uri->query_param_exists('z'), 'not exists'); # # query_param_delete() # $uri->query_param_delete('b'); ok(!$uri->query_param_exists('b'), 'delete'); $uri->query_param('c' => 5); is($uri->query, 'a=1&a=2&c=5', 'Final check'); # # omit_empty_query_params() # $uri = Rose::URI->new('/baz?aye=1&aye=2&b=&cee=3&dee=&eee=4'); is(ref($uri)->default_omit_empty_query_params, 0, 'default_omit_empty_query_params'); is($uri->omit_empty_query_params, 0, 'omit_empty_query_params default'); is($uri->query, 'aye=1&aye=2&b=&cee=3&dee=&eee=4', 'query omit_empty_query_params(0) 1'); Rose::URI->default_omit_empty_query_params(1); is($uri->query, 'aye=1&aye=2&cee=3&eee=4', 'query default_omit_empty_query_params(1)'); Rose::URI->default_omit_empty_query_params(0); is($uri->query, 'aye=1&aye=2&b=&cee=3&dee=&eee=4', 'query omit_empty_query_params(0) 2'); $uri->omit_empty_query_params(1); is($uri->query, 'aye=1&aye=2&cee=3&eee=4', 'query omit_empty_query_params(1)');