Merge pull request #2 from moritz/master

Fix on current rakudo

lib/IETF/RFC_Grammar.pm

@@ -24,7 +24,7 @@ method parse_validating($parse_str) {
         or die "Parse failed";
 }
 
-submethod BUILD($!rfc, $!grammar) {}
+submethod BUILD(:$!rfc, :$!grammar) {}
 
 method new(Str $rfc, $grammar?) {
     my $init_grammar = $grammar;

lib/IETF/RFC_Grammar/URI.pm

@@ -23,7 +23,9 @@ grammar IETF::RFC_Grammar::URI is IETF::RFC_Grammar::IPv6 {
     };
 
     token URI               {
-        <scheme> ':' <hier_part> [ '?' <query> ]? [ '#' <fragment> ]?
+        # should be [ '?' <query> ]?
+        # but that triggers a rakudobug (RT #112148)
+        <scheme> ':' <hier_part> [ '?' <query> | <?> ] <?before .?> [ '#' <fragment> ]?
     };
 
     token hier_part     {

lib/URI.pm

@@ -5,10 +5,10 @@ use IETF::RFC_Grammar::URI;
 use URI::Escape;
 need URI::DefaultPort;
 
-has $.grammar is ro;
-has Bool $.is_validating is rw = False;
+has $.grammar;
+has $.is_validating is rw = False;
 has $!path;
-has Bool $!is_absolute is ro;
+has $!is_absolute;
 has $!scheme;
 has $!authority;
 has $!query;
@@ -29,7 +29,6 @@ method parse (Str $str) {
         $!frag = Mu;
     %!query_form = @!segments = Nil;
 
-    my $note_caught;
     try {
         if ($.is_validating) {
             $!grammar.parse_validating($c_str);
@@ -39,10 +38,11 @@ method parse (Str $str) {
         }
 
         CATCH {
-            $note_caught++; # exception handling still needs some work ...
+            default {
+                die "Could not parse URI: $str"
+            }
         }
     }
-    if $note_caught {die "Could not parse URI: $str"  }
 
     # now deprecated
     $!uri = $!grammar.parse_result;
@@ -74,7 +74,9 @@ method parse (Str $str) {
     try {
         %!query_form = split_query( ~$!query );
         CATCH {
-            %!query_form = Nil;
+            default {
+                %!query_form = ();
+            }
         }
     }
 }
@@ -111,22 +113,22 @@ method init ($str) {
 }
 
 # new can pass alternate grammars some day ...
-submethod BUILD($!is_validating?) {
+submethod BUILD(:$!is_validating) {
     $!grammar = IETF::RFC_Grammar.new('rfc3896');
 }
 
 method new(Str $uri_pos1?, Str :$uri, :$is_validating) {
     my $obj = self.bless(*);
 
     if $is_validating.defined {
-        $obj.is_validating = $is_validating;
+        $obj.is_validating = ?$is_validating;
     }
 
     if $uri.defined and $uri_pos1.defined {
         die "Please specify the uri by name or position but not both.";
     }
     elsif $uri.defined or $uri_pos1.defined {
-        $obj.parse($uri.defined ?? $uri !! $uri_pos1);
+        $obj.parse($uri // $uri_pos1);
     }
 
     return $obj;

lib/URI/Escape.pm

@@ -4,25 +4,22 @@ package URI::Escape {
 
     use IETF::RFC_Grammar::URI;
 
-    our %escapes;
-
-    for 0 .. 255 -> $c {  # map broken in module / package ?
-        %escapes{ chr($c) } = sprintf '%%%02X', $c
-    }
+    my %escapes = (^256).map: {
+        ;
+        .chr => sprintf '%%%02X', $_
+    };
 
     # in moving from RFC 2396 to RFC 3986 this selection of characters
     # may be due for an update ...
 
     # commented line below used to work ...
 #    token artifact_unreserved {<[!*'()] +IETF::RFC_Grammar::URI::unreserved>};
 
-    sub uri_escape($s is copy, Bool :$no_utf8 = False) is export {
-        my $rc;
-        my $last_pos = 0;
-
-        while my $escape = $s ~~ m:c/<- [!*'()\-._~A..Za..z0..9]>+/ {
-            $rc ~=  $s.substr($last_pos, $/.from - $last_pos);
-            $rc ~= ($escape.comb().map: {
+    sub uri_escape($s, Bool :$no_utf8 = False) is export {
+        return $s unless defined $s;
+        $s.subst(:g, rx/<- [!*'()\-._~A..Za..z0..9]>+/,
+            -> $escape {
+            ($escape.Str.comb.map: {
                 ( $no_utf8 || ! 0x80 +& ord($_) ) ?? %escapes{ $_ } !!
                     do {
                         my $buf = $_.encode;
@@ -31,12 +28,7 @@ package URI::Escape {
                         }
                     }
            }).join;            
-           $last_pos = $/.to;           
-        }
-        # $s.defined test needed because of bug fixed in nom
-        if $s.defined and $s.chars > $last_pos { $rc ~= $s.substr($last_pos) }
-
-        return $rc;
+        });
     }
 
     # todo - automatic invalid UTF-8 detection
@@ -53,7 +45,7 @@ package URI::Escape {
                 $rc ~=  $s.substr($last_pos, $/.from - $last_pos);
 
                 # should be a better way with list context
-                my @encoded_octets = map { :16( .value ) }, $/.caps;
+                my @encoded_octets = map { :16( ~.value ) }, $/.caps;
                 # common case optimization
                 while @encoded_octets and ($no_utf8 or  @encoded_octets[0] < 0x80) {
                     $rc ~= chr(shift @encoded_octets);

t/01.t

@@ -51,7 +51,7 @@ is($u.segments[*-1], 'baz', 'last segment');
 $u = URI.new;
 $u.parse('http://foo.com');
 
-ok($u.segments.list.perl eq '[""]', ".segments return [''] for empty path");
+ok($u.segments == 1 && $u.segments[0] 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');
@@ -91,7 +91,7 @@ try {
     is($url_1_valid, 1, 'validating parser okd good URI');
     $u_v = URI.new('http:://?#?#', :is_validating<1>);
     CATCH {
-        $url_2_valid = 0;
+        default { $url_2_valid = 0 }
     }
 }
 is($url_2_valid, 0, 'validating parser rejected bad URI');