You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by ra...@apache.org on 2004/07/15 17:31:28 UTC
cvs commit: modperl-2.0/t/response/TestAPR uri.pm
randyk 2004/07/15 08:31:28
Modified: t/response/TestAPR uri.pm
Added: t/apr-ext uri.t
t/lib/TestAPRlib uri.pm
Log:
Reviewed by: stas
put common uri tests under t/lib/TestAPRlib/, and call them
from both t/apr/ and t/apr-ext/.
Revision Changes Path
1.1 modperl-2.0/t/apr-ext/uri.t
Index: uri.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use TestAPRlib::uri;
plan tests => TestAPRlib::uri::num_of_tests();
TestAPRlib::uri::test();
1.1 modperl-2.0/t/lib/TestAPRlib/uri.pm
Index: uri.pm
===================================================================
package TestAPRlib::uri;
# Testing APR::URI (more tests in TestAPI::uri)
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use APR::URI ();
use APR::Pool ();
use APR::Const -compile => qw(URI_UNP_OMITSITEPART URI_UNP_OMITUSER
URI_UNP_REVEALPASSWORD URI_UNP_OMITQUERY
URI_UNP_OMITPASSWORD URI_UNP_OMITPATHINFO
);
my %default_ports = (
ftp => 21,
gopher => 70,
http => 80,
https => 443,
nntp => 119,
prospero => 191,
snews => 563,
wais => 210,
);
my %url = (
scheme => ["http", "ftp" ],
user => ["user", "log" ],
password => ["password", "pass" ],
hostname => ["www.example.com", "ftp.example.com"],
port => [8000, 21 ],
path => ["/path/file.pl", "/pub" ],
query => ["query", undef ],
fragment => ["fragment", undef ],
);
my @keys_urls = qw(scheme user password hostname port path query
fragment);
my @keys_hostinfo = qw(user password hostname port);
sub num_of_tests {
return 27;
}
sub test {
my $pool = APR::Pool->new();
### parse ###
my $url0 = sprintf "%s://%s:%s\@%s:%d%s?%s#%s",
map { $url{$_}[0] } @keys_urls;
# warn "URL: $url\n";
my $hostinfo0 = sprintf "%s:%s\@%s:%d",
map { $url{$_}[0] } @keys_hostinfo;
my $parsed = APR::URI->parse($pool, $url0);
ok $parsed;
ok $parsed->isa('APR::URI');
for my $method (keys %url) {
no strict 'refs';
ok t_cmp($parsed->$method, $url{$method}[0], $method);
}
ok t_cmp($parsed->hostinfo, $hostinfo0, "hostinfo");
for my $method (keys %url) {
no strict 'refs';
$parsed->$method($url{$method}[1]);
t_debug("$method: " . ($url{$method}[1]||'undef') .
" => " . ($parsed->$method||'undef'));
}
### unparse ###
my $url_unparsed = $parsed->unparse;
# hostinfo is unaffected, since it's simply a field in the parsed
# record, and it's populated when parse is called, but when
# individual fields used to compose it are updated, it doesn't get
# updated: so we see the old value here
ok t_cmp($parsed->hostinfo, $hostinfo0, "hostinfo");
# - since 21 is the default port for ftp, unparse omits it
# - if no flags are passed to unparse, APR::URI_UNP_OMITPASSWORD
# is passed by default -- it hides the password
my $url1 = sprintf "%s://%s\@%s%s",
map { $url{$_}[1] } grep !/^(password|port)$/, @keys_urls;
ok t_cmp($url_unparsed, $url1, "unparsed url");
# various unparse flags #
{
# restore the query/fragment fields first
my $query_new = "my_query";
my $fragment_new = "my_fragment";
$parsed->query($query_new);
$parsed->fragment($fragment_new);
local $url{query}[1] = $query_new;
local $url{fragment}[1] = $fragment_new;
# omit the site part
{
my $url_unparsed = $parsed->unparse(APR::URI_UNP_OMITSITEPART);
my $url2 = sprintf "%s?%s#%s",
map { $url{$_}[1] } qw(path query fragment);
ok t_cmp($url_unparsed, $url2, "unparsed url: omit site");
}
# this time the password should appear as XXXXXXXX
{
local $url{password}[1] = "XXXXXXXX";
my $url_unparsed = $parsed->unparse(0);
my $url2 = sprintf "%s://%s:%s\@%s%s?%s#%s",
map { $url{$_}[1] } grep !/^port$/, @keys_urls;
ok t_cmp($url_unparsed, $url2, "unparsed url:reveal passwd");
}
# this time the user and the password should appear
{
my $url_unparsed = $parsed->unparse(APR::URI_UNP_REVEALPASSWORD);
my $url2 = sprintf "%s://%s:%s\@%s%s?%s#%s",
map { $url{$_}[1] } grep !/^port$/, @keys_urls;
ok t_cmp($url_unparsed, $url2, "unparsed url:reveal passwd");
}
# omit the user part / show password
{
my $url_unparsed = $parsed->unparse(
APR::URI_UNP_OMITUSER|APR::URI_UNP_REVEALPASSWORD);
my $url2 = sprintf "%s://:%s\@%s%s?%s#%s",
map { $url{$_}[1] } grep !/^(port|user)$/, @keys_urls;
ok t_cmp($url_unparsed, $url2, "unparsed url: omit user");
}
# omit the path, query and fragment strings
{
my $url_unparsed = $parsed->unparse(
APR::URI_UNP_OMITPATHINFO|APR::URI_UNP_REVEALPASSWORD);
my $url2 = sprintf "%s://%s:%s\@%s", map { $url{$_}[1] }
grep !/^(port|path|query|fragment)$/, @keys_urls;
ok t_cmp($url_unparsed, $url2, "unparsed url: omit path");
}
# omit the query and fragment strings
{
my $url_unparsed = $parsed->unparse(
APR::URI_UNP_OMITQUERY|APR::URI_UNP_OMITPASSWORD);
my $url2 = sprintf "%s://%s\@%s%s", map { $url{$_}[1] }
grep !/^(password|port|query|fragment)$/, @keys_urls;
ok t_cmp($url_unparsed, $url2, "unparsed url: omit query");
}
}
### port_of_scheme ###
while (my($scheme, $port) = each %default_ports) {
my $apr_port = APR::URI::port_of_scheme($scheme);
ok t_cmp($apr_port, $port, "scheme: $scheme");
}
}
1;
1.7 +4 -143 modperl-2.0/t/response/TestAPR/uri.pm
Index: uri.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/uri.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- uri.pm 8 Jul 2004 06:06:33 -0000 1.6
+++ uri.pm 15 Jul 2004 15:31:28 -0000 1.7
@@ -6,157 +6,18 @@
use warnings FATAL => 'all';
use Apache::Test;
-use Apache::TestUtil;
-
-use APR::URI ();
use Apache::Const -compile => 'OK';
-use APR::Const -compile => qw(URI_UNP_OMITSITEPART URI_UNP_OMITUSER
- URI_UNP_REVEALPASSWORD URI_UNP_OMITQUERY
- URI_UNP_OMITPASSWORD URI_UNP_OMITPATHINFO
- );
-
-my %default_ports = (
- ftp => 21,
- gopher => 70,
- http => 80,
- https => 443,
- nntp => 119,
- prospero => 191,
- snews => 563,
- wais => 210,
-);
-
-my %url = (
- scheme => ["http", "ftp" ],
- user => ["user", "log" ],
- password => ["password", "pass" ],
- hostname => ["www.example.com", "ftp.example.com"],
- port => [8000, 21 ],
- path => ["/path/file.pl", "/pub" ],
- query => ["query", undef ],
- fragment => ["fragment", undef ],
-);
-
-my @keys_urls = qw(scheme user password hostname port path query
- fragment);
-my @keys_hostinfo = qw(user password hostname port);
+use TestAPRlib::uri;
sub handler {
my $r = shift;
- plan $r, tests => 27;
-
- ### parse ###
- my $url0 = sprintf "%s://%s:%s\@%s:%d%s?%s#%s",
- map { $url{$_}[0] } @keys_urls;
- # warn "URL: $url\n";
- my $hostinfo0 = sprintf "%s:%s\@%s:%d",
- map { $url{$_}[0] } @keys_hostinfo;
-
- my $parsed = APR::URI->parse($r->pool, $url0);
- ok $parsed;
- ok $parsed->isa('APR::URI');
-
- for my $method (keys %url) {
- no strict 'refs';
- ok t_cmp($parsed->$method, $url{$method}[0], $method);
- }
-
- ok t_cmp($parsed->hostinfo, $hostinfo0, "hostinfo");
-
- for my $method (keys %url) {
- no strict 'refs';
- $parsed->$method($url{$method}[1]);
- t_debug("$method: " . ($url{$method}[1]||'undef') .
- " => " . ($parsed->$method||'undef'));
- }
-
- ### unparse ###
- my $url_unparsed = $parsed->unparse;
-
- # hostinfo is unaffected, since it's simply a field in the parsed
- # record, and it's populated when parse is called, but when
- # individual fields used to compose it are updated, it doesn't get
- # updated: so we see the old value here
- ok t_cmp($parsed->hostinfo, $hostinfo0, "hostinfo");
-
- # - since 21 is the default port for ftp, unparse omits it
- # - if no flags are passed to unparse, APR::URI_UNP_OMITPASSWORD
- # is passed by default -- it hides the password
- my $url1 = sprintf "%s://%s\@%s%s",
- map { $url{$_}[1] } grep !/^(password|port)$/, @keys_urls;
- ok t_cmp($url_unparsed, $url1, "unparsed url");
-
- # various unparse flags #
- {
- # restore the query/fragment fields first
- my $query_new = "my_query";
- my $fragment_new = "my_fragment";
- $parsed->query($query_new);
- $parsed->fragment($fragment_new);
- local $url{query}[1] = $query_new;
- local $url{fragment}[1] = $fragment_new;
-
- # omit the site part
- {
- my $url_unparsed = $parsed->unparse(APR::URI_UNP_OMITSITEPART);
- my $url2 = sprintf "%s?%s#%s",
- map { $url{$_}[1] } qw(path query fragment);
- ok t_cmp($url_unparsed, $url2, "unparsed url: omit site");
- }
-
- # this time the password should appear as XXXXXXXX
- {
- local $url{password}[1] = "XXXXXXXX";
- my $url_unparsed = $parsed->unparse(0);
- my $url2 = sprintf "%s://%s:%s\@%s%s?%s#%s",
- map { $url{$_}[1] } grep !/^port$/, @keys_urls;
- ok t_cmp($url_unparsed, $url2, "unparsed url:reveal passwd");
- }
-
- # this time the user and the password should appear
- {
- my $url_unparsed = $parsed->unparse(APR::URI_UNP_REVEALPASSWORD);
- my $url2 = sprintf "%s://%s:%s\@%s%s?%s#%s",
- map { $url{$_}[1] } grep !/^port$/, @keys_urls;
- ok t_cmp($url_unparsed, $url2, "unparsed url:reveal passwd");
- }
-
- # omit the user part / show password
- {
- my $url_unparsed = $parsed->unparse(
- APR::URI_UNP_OMITUSER|APR::URI_UNP_REVEALPASSWORD);
- my $url2 = sprintf "%s://:%s\@%s%s?%s#%s",
- map { $url{$_}[1] } grep !/^(port|user)$/, @keys_urls;
- ok t_cmp($url_unparsed, $url2, "unparsed url: omit user");
- }
-
- # omit the path, query and fragment strings
- {
- my $url_unparsed = $parsed->unparse(
- APR::URI_UNP_OMITPATHINFO|APR::URI_UNP_REVEALPASSWORD);
- my $url2 = sprintf "%s://%s:%s\@%s", map { $url{$_}[1] }
- grep !/^(port|path|query|fragment)$/, @keys_urls;
- ok t_cmp($url_unparsed, $url2, "unparsed url: omit path");
- }
-
- # omit the query and fragment strings
- {
- my $url_unparsed = $parsed->unparse(
- APR::URI_UNP_OMITQUERY|APR::URI_UNP_OMITPASSWORD);
- my $url2 = sprintf "%s://%s\@%s%s", map { $url{$_}[1] }
- grep !/^(password|port|query|fragment)$/, @keys_urls;
- ok t_cmp($url_unparsed, $url2, "unparsed url: omit query");
- }
- }
+ my $num_of_tests = TestAPRlib::uri::num_of_tests();
+ plan $r, tests => $num_of_tests;
- ### port_of_scheme ###
- while (my($scheme, $port) = each %default_ports) {
- my $apr_port = APR::URI::port_of_scheme($scheme);
- ok t_cmp($apr_port, $port, "scheme: $scheme");
- }
+ TestAPRlib::uri::test();
Apache::OK;
}