Permalink
Browse files

Allow URI port method to return default port for scheme and add _port…

… method for parsed port like p5 URI.
  • Loading branch information...
1 parent cdc2cb2 commit e7b5451ccb8fe0d51406d557ecc3ecde568b9fdc @ronaldxs ronaldxs committed Aug 3, 2011
Showing with 53 additions and 2 deletions.
  1. +9 −1 lib/URI.pm
  2. +40 −0 lib/URI/DefaultPort.pm
  3. +4 −1 t/01.t
View
@@ -3,6 +3,7 @@ class URI;
use IETF::RFC_Grammar;
use IETF::RFC_Grammar::URI;
use URI::Escape;
+use URI::DefaultPort;
has $.grammar is ro;
has Bool $.is_validating is rw = False;
@@ -122,6 +123,7 @@ method new(Str $uri_pos1?, Str :$uri, :$is_validating) {
$obj.is_validating = $is_validating;
}
+ # todo add error for both defined
if $uri.defined or $uri_pos1.defined {
$obj.parse($uri.defined ?? $uri !! $uri_pos1);
}
@@ -141,8 +143,14 @@ method host {
return ($!authority<host> // '').lc;
}
+method _port {
+ # todo fix || to //
+ my $rc = item $!authority<port> || Int;
+ $rc;
+}
+
method port {
- item $!authority<port> // '';
+ my $rc = $._port // scheme_port($.scheme);
}
method path {
View
@@ -0,0 +1,40 @@
+use v6;
+
+# This logic seems to belong somewhere related to URI but not in the URI
+# module itself.
+
+package URI::DefaultPort {
+
+ my %default_port = (
+ ftp => 21,
+ ssh => 22,
+ telnet => 23,
+ tn3270 => 23,
+ gopher => 70,
+ http => 80,
+ pop => 110,
+ news => 119,
+ ldap => 389,
+ https => 443,
+ rlogin => 513,
+ rtsp => 554,
+ rtspu => 554,
+ snews => 563,
+ ldaps => 636,
+ rsync => 873,
+ mms => 1755,
+ sip => 5060,
+ sips => 5061
+ );
+
+ # todo fix this so it isn't export
+ sub scheme_port(Str $scheme) is export {
+ # guessing the // Int should be unnecessary some day ...
+ my $rc = %default_port{$scheme} // Int;
+ say "scheme_port returning ", $rc.perl, " for ", $scheme.perl;
+ $rc;
+ }
+
+}
+
+# vim:ft=perl6
View
5 t/01.t
@@ -1,6 +1,6 @@
use v6;
use Test;
-plan 40;
+plan 43;
use URI;
ok(1,'We use URI and we are still alive');
@@ -28,6 +28,8 @@ is($u.scheme, 'https', 'scheme');
is($u.host, 'example.com', 'host');
is( "$u", 'https://example.com',
'https://eXAMplE.COM stringifies to https://example.com');
+is($u.port, 443, 'default https port');
+is($u._port, Int, 'no specified port');
$u.parse('/foo/bar/baz');
@@ -52,6 +54,7 @@ $u.parse('http://foo.com');
ok($u.segments.list.perl eq '[""]', ".segments return [''] for empty path");
ok($u.absolute, 'http://foo.com has an absolute path');
nok($u.relative, 'http://foo.com does not have a relative path');
+is($u.port, 80, 'default http port');
# test URI parsing with <> or "" and spaces
$u.parse("<http://foo.com> ");

0 comments on commit e7b5451

Please sign in to comment.