Browse files

Make URI module pass tests needed for integration with LWP::Simple. A…

…dd default_port method like p5.
  • Loading branch information...
1 parent 20808f1 commit 9943c579479319e7a497a5c75d2bdda165f9fae0 @ronaldxs ronaldxs committed Aug 7, 2011
Showing with 80 additions and 16 deletions.
  1. +24 −13 lib/URI.pm
  2. +1 −1 lib/URI/DefaultPort.pm
  3. +53 −0 t/lwp-simple.t
  4. +2 −2 t/rfc-3986-examples.t
View
37 lib/URI.pm
@@ -47,23 +47,23 @@ method parse (Str $str) {
# now deprecated
$!uri = $!grammar.parse_result;
- my $comp_container = $!grammar.parse_result<URI_reference><URI> //
+ my $comp_container = $!grammar.parse_result<URI_reference><URI> ||
$!grammar.parse_result<URI_reference><relative_ref>;
$!scheme = $comp_container<scheme>;
$!query = $comp_container<query>;
$!frag = $comp_container<fragment>;
- $comp_container = $comp_container<hier_part> // $comp_container<relative_part>;
+ $comp_container = $comp_container<hier_part> || $comp_container<relative_part>;
$!authority = $comp_container<authority>;
- $!path = $comp_container<path_abempty> //
+ $!path = $comp_container<path_abempty> ||
$comp_container<path_absolute> ;
- $!is_absolute = ?($!path // $.scheme);
+ $!is_absolute = ?($!path || $!scheme);
- $!path //= $comp_container<path_noscheme> //
+ $!path ||= $comp_container<path_noscheme> ||
$comp_container<path_rootless> ;
- @!segments = $!path<segment>.list() // ('');
- if my $first_chunk = $!path<segment_nz_nc> // $!path<segment_nz> {
+ @!segments = $!path<segment>.list() || ('');
+ if my $first_chunk = $!path<segment_nz_nc> || $!path<segment_nz> {
unshift @!segments, $first_chunk;
}
if @!segments.elems == 0 {
@@ -142,20 +142,25 @@ method authority {
}
method host {
- return ($!authority<host> // '').lc;
+ return ($!authority<host> || '').lc;
+}
+
+method default_port {
+ URI::DefaultPort::scheme_port($.scheme)
}
method _port {
# port 0 is off limits and see also RT 96424
- item $!authority<port> || Int;
+ # $!authority<port>.Int doesn't work because of RT 96472
+ $!authority<port> ?? ($!authority<port> ~ '').Int !! Int;
}
method port {
- $._port // URI::DefaultPort::scheme_port($.scheme);
+ $._port // $.default_port;
}
method path {
- return ~($!path // '').lc;
+ return ~($!path || '');
}
method absolute {
@@ -167,10 +172,16 @@ method relative {
}
method query {
- item ~($!query // '');
+ item ~($!query || '');
+}
+
+method path_query {
+ $.query ?? $.path ~ '?' ~ $.query !! $.path
}
+
+
method frag {
- return ~($!frag // '').lc;
+ return ~($!frag || '').lc;
}
method fragment { $.frag }
View
2 lib/URI/DefaultPort.pm
@@ -29,7 +29,7 @@ package URI::DefaultPort {
our sub scheme_port(Str $scheme) {
# guessing the // Int should be unnecessary some day ...
- return %default_port{$scheme} // Int;
+ return %default_port{$scheme}.Int // Int;
}
}
View
53 t/lwp-simple.t
@@ -0,0 +1,53 @@
+#
+# Test URI capabilities needed for the LWP::Simple parse_url() method
+#
+
+use v6;
+use Test;
+
+use URI;
+
+my @test = (
+ 'Simple URL without path',
+ 'http://www.rakudo.org',
+ ['http', 'www.rakudo.org', 80, ''],
+
+ 'Port other than 80',
+ 'http://www.altavista.com:81/',
+ ['http', 'www.altavista.com', 81, '/'],
+
+ 'HTTPS scheme, and default port != 80',
+ 'https://www.rakudo.org/rakudo-latest.tar.bz2',
+ ['https', 'www.rakudo.org', 443, '/rakudo-latest.tar.bz2'],
+
+ '#GH-1 http://github.com/cosimo/perl6-lwp-simple/issues/#issue/1',
+ 'http://www.c64.com/path/with/multiple/slashes/',
+ ['http', 'www.c64.com', 80, '/path/with/multiple/slashes/'],
+
+ 'FTP url',
+ 'ftp://get.opera.com/pub/opera/win/1054/en/Opera_1054_en_Setup.exe',
+ ['ftp', 'get.opera.com', 21, '/pub/opera/win/1054/en/Opera_1054_en_Setup.exe'],
+
+ 'HTTP URL with double-slashes',
+ 'http://tinyurl.com/api-create.php?url=http://digg.com',
+ ['http', 'tinyurl.com', 80, '/api-create.php?url=http://digg.com'],
+
+);
+
+for @test -> $test, $url, $results {
+ my $u = URI.new($url);
+ is($u.scheme, $results.[0], "Scheme for $url is $results.[0]");
+ is($u.host, $results.[1], "Hostname for $url is $results.[1]");
+ is($u.port, $results.[2], "Port for $url is $results.[2]");
+ is($u.path_query, $results.[3], "Path for $url is $results.[3]");
+}
+
+# Check that port is returned as a number,
+# or IO::Socket::INET.open() fails
+my $port = URI.new('http:5984//localhost/foo/test/').port;
+say $port;
+is($port.WHAT, 'Int()', 'port is returned as a Int, to avoid problems on sock.open()');
+
+done;
+
+
View
4 t/rfc-3986-examples.t
@@ -16,12 +16,12 @@ is($u.path, '/rfc/rfc2396.txt', 'http path');
$u.parse('ldap://[2001:db8::7]/c=GB?objectClass?one');
is($u.scheme, 'ldap', 'ldap scheme');
is($u.host, '[2001:db8::7]', 'ldap host');
-is($u.path, '/c=gb', 'ldap path');
+is($u.path, '/c=GB', 'ldap path');
is($u.query, 'objectClass?one', 'ldap query');
$u.parse('mailto:John.Doe@example.com');
is($u.scheme, 'mailto', 'mailto scheme');
-is($u.path, 'john.doe@example.com', 'news path');
+is($u.path, 'John.Doe@example.com', 'news path');
$u.parse('news:comp.infosystems.www.servers.unix');
is($u.scheme, 'news', 'news scheme');

0 comments on commit 9943c57

Please sign in to comment.