Merge remote-tracking branch 'origin/ng-compat'

Makefile

@@ -1,11 +1,13 @@
 PERL6=perl6
 
-SOURCES=lib/November/CGI.pm lib/Text/Markup/Wiki/Minimal.pm \
+SOURCES=lib/November/URI/Grammar.pm lib/November/URI.pm \
+	lib/November/CGI.pm lib/Text/Markup/Wiki/Minimal.pm \
 	lib/Text/Markup/Wiki/MediaWiki.pm lib/Digest.pm \
-	lib/November/Storage.pm lib/November/Storage/File.pm lib/November/Tags.pm \
-	lib/November/URI.pm lib/November/URI/Grammar.pm lib/Dispatcher.pm \
-	lib/Dispatcher/Rule.pm lib/November/Session.pm lib/November/Utils.pm \
-    lib/November/Config.pm lib/Test/InputOutput.pm lib/Test/CGI.pm \
+	lib/November/Storage.pm lib/November/Utils.pm \
+	lib/November/Config.pm lib/November/Storage/File.pm lib/November/Tags.pm \
+	lib/Dispatcher/Rule.pm lib/Dispatcher.pm \
+	lib/November/Session.pm lib/November/Utils.pm \
+    lib/Test/InputOutput.pm lib/Test/CGI.pm \
     lib/November/Cache.pm lib/November.pm
 
 PIRS=$(SOURCES:.pm=.pir)

lib/Digest.pm

@@ -1,49 +1,13 @@
 module Digest;
 
-# Known digests: md5, sha1, sha256, sha512, ripemd160
-sub digest(Str $text, Str $algo is copy = 'md5') is export {
-	$algo = uc $algo;
-	my $binary = Q:PIR {
-		.local string text
-		.local string algo
-		.local pmc digest
-
-		# Input
-		$P0 = find_lex '$text'
-		text = $P0
-		$P0 = find_lex '$algo'
-		algo = $P0
-
-		# Choose the right digest.
-		$P1 = loadlib 'digest_group'
-		if algo == 'MD5' goto MD5
-		if algo == 'SHA1' goto SHA1
-		if algo == 'SHA256' goto SHA256
-		if algo == 'SHA512' goto SHA512
-		if algo == 'RIPEMD160' goto RIPEMD160
-	MD5:
-		digest = new 'MD5'
-		goto COMPUTE
-	SHA1:
-		digest = new 'SHA1'
-		goto COMPUTE
-	SHA256:
-		digest = new 'SHA256'
-		goto COMPUTE
-	SHA512:
-		digest = new 'SHA512'
-		goto COMPUTE
-	RIPEMD160:
-		digest = new 'RIPEMD160'
+use Digest::MD5;
+use Digest::SHA;
 
-	COMPUTE:
-		# Calculate the digest.
-		digest.'Init'()
-		digest.'Update'(text)
-		$S0 = digest.'Final'()
-
-		%r = box $S0
-	};
-	# Convert to hex.
-	return [~] map { sprintf '%02x', .ord }, $binary.comb;
+# Known digests: md5, sha1, sha256, sha512, ripemd160
+sub digest(Str $text, Str $algo = 'md5') is export {
+	given $algo {
+		when 'md5' { return Digest::MD5.md5_hex($text) }
+		when 'sha256' { return Digest::SHA.sha256_hex($text) }
+		default { !!! "digest for $algo not yet implemented" }
+	}
 }

lib/Digest/SHA.pm

@@ -0,0 +1,22 @@
+class Digest::SHA:auth<thou>:ver<0.01> {
+    pir::load_bytecode('Digest/sha256.pbc');
+
+    multi method sha256_hex (Str $str) {
+        my $sha256_hex = Q:PIR {
+            .local pmc f, g, str
+            str = find_lex '$str'
+            f = get_root_global ['parrot'; 'Digest'], '_sha256sum'
+            $P1 = f(str)
+            g = get_root_global ['parrot'; 'Digest'], '_sha256_hex'
+            $S0 = g($P1)
+            %r = box $S0
+        };
+
+        return $sha256_hex;
+    }
+
+    multi method sha256_hex (@strs) {
+        return self.sha256_hex(@strs.join(""));
+    }
+}
+

lib/Dispatcher/Rule.pm

@@ -9,17 +9,21 @@ has Code $.code;
 
 method match (@chunks) {
     return False if @chunks != @!pattern;
-    for @chunks Z @!pattern -> $chunk, Object $rule is copy {
+    # RAKUDO: Z seems to have a bug (fixed in nom), where [1,2] Z [*,*] yields (1, Any, 2, Any): the Whatever is lost
+    #for @chunks Z @!pattern -> $chunk, $rule is copy {
+    for ^@chunks -> $i {
+        my $chunk = @chunks[$i];
+        my $rule = @!pattern[$i];
+        #note "- chunk ({$chunk.perl}), rule ({$rule.perl})";
 
         my $param;
         if $rule ~~ Pair { ($param, $rule) = $rule.kv }
 
         if ~$chunk ~~ $rule {
             if $param {
-                self."$param" = (~$/ || ~$chunk);
+                self."$param"() = ~($/ // $chunk);
             } else {
-                # RAKUDO: /./ ~~ Regex us false, but /./ ~~ Code is true  
-                @!args.push($/ || $chunk) if $rule ~~ Code | Whatever; # should by Regex | Whatever
+                @!args.push($/ || $chunk) if $rule ~~ Regex | Whatever;
             }
         }
         else {
@@ -35,7 +39,7 @@ method apply {
     #$!code(| @!args, controller => $.controller, action => $.action );
     # workaround:
     if $!controller and $!action {
-        $!code(| @!args,action => $.action, controller => $.controller  );
+        $!code(| @!args, action => $.action, controller => $.controller );
     } elsif $!action {
         $!code(| @!args, action => $.action );
     } elsif $!controller {

lib/November.pm

@@ -1,5 +1,8 @@
 use v6;
 
+# RAKUDO: Needed because of [perl #73912]
+class November { ... }
+
 use November::Session;
 use November::Cache;
 use Digest;
@@ -39,15 +42,16 @@ class November does November::Session does November::Cache {
             ['out'],                  { self.log_out },
             ['register'],             { self.register },
             ['recent'],               { self.list_recent_changes },
-            ['history'],              { self.view_page_history(~$^page) },
+            ['history', /^ <-[?/]>+ $/], { self.view_page_history(~$^page) },
             ['all'],                  { self.list_all_pages },
         ];
 
         my @chunks = $cgi.uri.chunks.list;
         $d.dispatch(@chunks);
     }
 
-    method view_page($page is rw='Main_Page') {
+    # RAKUDO: Should `is rw` work with constant defaults? (It doesn't.)
+    method view_page($page is copy = 'Main_Page') {
         $page .= subst('%20', '_', :g);
 
         unless $.storage.wiki_page_exists($page) {
@@ -92,7 +96,7 @@ class November does November::Session does November::Cache {
 
     }
 
-    method edit_page($page is rw) {
+    method edit_page($page is copy) {
         $page .= subst('%20', '_', :g);
         my $sessions = self.read_sessions();
 
@@ -187,7 +191,9 @@ class November does November::Session does November::Cache {
     }
 
     method read_users {
-        return {} unless $.config.userfile_path ~~ :e;
+        # RAKUDO: NYI ~~ :X file 
+        #return {} unless $.config.userfile_path ~~ :e;
+        return {} unless $.config.userfile_path.IO.e;
         return eval( slurp( $.config.userfile_path ) );
     }
 
@@ -281,7 +287,7 @@ class November does November::Session does November::Cache {
     }
 
     method error_page($message = "An internal error occurred. Apologies.") {
-        self.response( 'error.tmpl', { MESSAGE => $message } );
+        self.response( 'error.tmpl', { MESSAGE => $message ~ "<pre>{self.perl}</pre>" } );
     }
 
     method list_recent_changes {
@@ -292,7 +298,7 @@ class November does November::Session does November::Cache {
         );
     }
 
-    method view_page_history($page is rw = 'Main_Page') {
+    method view_page_history($page is copy = 'Main_Page') {
         $page .= subst('%20', '_', :g);
 
         unless $.storage.wiki_page_exists($page) {
@@ -305,7 +311,7 @@ class November does November::Session does November::Cache {
         self.response('page_history.tmpl',
             {
             'TITLE'     => $title,
-            'CHANGES'   => self.get_changes($page, limit => 50),
+            'CHANGES'   => self.get_changes(:$page, limit => 50),
             }
         );
     }
@@ -367,8 +373,9 @@ class November does November::Session does November::Cache {
         self.response('list_all_pages.tmpl', %params);
     }
 
-    # RAKUDO: die at hash merge if %params undef, so I use default value
-    method response ($tmpl, %params?={}, %opts?) {
+    # RAKUDO: Instead of %params? we do %params = {}, because the former
+    #         doesn't quite work. [perl #79642]
+    method response ($tmpl, %params = {}, %opts = {}) {
         my $template = HTML::Template.from_file($.config.template_path ~ $tmpl);
 
         $template.with_params(
@@ -389,9 +396,9 @@ class November does November::Session does November::Cache {
         my $root = $!config.web_root;
         if $title {
             if $page ~~ m/':'/ {
-                return qq|<a href="{ $root ~ $page }">$title</a>|;
+                return qq|<a href="{ $root ~ $page }">{$title}</a>|;
             } else {
-                return qq|<a href="$root/view/$page">$title</a>|;
+                return qq|<a href="$root/view/$page">{$title}</a>|;
             }
         } else {
             return sprintf('<a href="%s/%s/%s" %s >%s</a>',
@@ -405,9 +412,9 @@ class November does November::Session does November::Cache {
 
     method make_extlink($url, $title) {
         if $title {
-            return qq|<a href="$url">$title</a>|;
+            return qq|<a href="$url">{$title}</a>|;
         } else {
-            return qq|<a href="$url">$url</a>|;
+            return qq|<a href="$url">{$url}</a>|;
         }
     }
 }

lib/November/CGI.pm

@@ -112,7 +112,7 @@ class November::CGI {
         }
     }
 
-    sub unescape($string is rw) {
+    our sub unescape($string is copy) {
         $string .= subst('+', ' ', :g);
         # RAKUDO: This could also be rewritten as a single .subst :g call.
         #         ...when the semantics of .subst is revised to change $/,

lib/November/Cache.pm

@@ -15,14 +15,14 @@ method set-cache-entry( $key, $value ) {
 
 method get-cache-entry( $key ) {
     my $file = self.cache-dir ~ '/' ~ $key;
-    return Nil unless $file ~~ :e;
+    return Nil unless $file.IO ~~ :e;
     my $string = slurp( $file );
     return $string;
 }
 
 method remove-cache-entry( $key ) {
     my $file = self.cache-dir ~ '/' ~ $key;
-    return unless $file ~~ :e;
+    return unless $file.IO ~~ :e;
     unlink( $file );
 }
 

lib/November/Session.pm

@@ -17,7 +17,7 @@ method remove_session($id) {
 }
 
 method read_sessions {
-    return {} unless self.sessionfile-path ~~ :e;
+    return {} unless self.sessionfile-path.IO ~~ :e;
     my $string = slurp( self.sessionfile-path );
     my $stuff = eval( $string );
     return $stuff;

lib/November/Storage/File.pm

@@ -26,11 +26,11 @@ class November::Storage::File is November::Storage {
     }
 
     method wiki_page_exists($page) {
-        return ($.content_path ~ $page) ~~ :e;
+        return ($.content_path ~ $page).IO ~~ :e;
     }
 
     method read_recent_changes {
-        return [] unless $.recent_changes_path ~~ :e;
+        return [] unless $.recent_changes_path.IO ~~ :e;
         return eval( slurp( $.recent_changes_path ) );
     }
 
@@ -42,7 +42,7 @@ class November::Storage::File is November::Storage {
 
     method read_page_history($page) {
         my $file = $.content_path ~ $page;
-        return [] unless $file ~~ :e;
+        return [] unless $file.IO ~~ :e;
         my $page_history = eval( slurp($file) );
         return $page_history;
     }
@@ -56,7 +56,7 @@ class November::Storage::File is November::Storage {
 
     method read_modification($modification_id) {
         my $file = $.modifications_path ~ $modification_id;
-        return [] unless $file ~~ :e;
+        return [] unless $file.IO ~~ :e;
         return eval( slurp($file) );
     }
 

lib/November/Tags.pm

@@ -4,9 +4,10 @@ use November::Config;
 
 class November::Tags {
     my $server_root = November::Config.new.server_root;
-    my $.page_tags_path  is rw = $server_root ~ 'data/page_tags/';
-    my $.tags_count_path is rw = $server_root ~ 'data/tags_count';
-    my $.tags_index_path is rw = $server_root ~ 'data/tags_index';
+    # TODO Nasty hack to enable testing to use different paths
+    has $.page_tags_path is rw  = $server_root ~ 'data/page_tags/';
+    has $.tags_count_path is rw = $server_root ~ 'data/tags_count';
+    has $.tags_index_path is rw = $server_root ~ 'data/tags_index';
 
     method update_tags($_: Str $page, Str $new_tags) {
         my $old_tags = .read_page_tags($page).chomp;
@@ -37,7 +38,9 @@ class November::Tags {
             }
             unless any($index{$t}.values) eq $page {
                 $index{$t}.push($page);
-                $index{$t} = grep { $_ ne '' }, $index{$t}.values;
+                # RAKUDO: bug w/ var on both lhs and rhs
+                my @tmp = grep { $_ ne '' }, $index{$t}.values;
+                $index{$t} = @tmp;
             }
         }
 
@@ -64,15 +67,17 @@ class November::Tags {
             # RAKUDO: @ not implemented yet
             #if $index{$t} && any(@ $index{$t}) eq $page {
             if $index{$t} && any($index{$t}.values) eq $page {
-                    $index{$t} = grep { $_ ne $page }, $index{$t}.values;
+                    # RAKUDO: bug w/ var on both lhs and rhs
+                    my @tmp = grep { $_ ne $page }, $index{$t}.values;
+                    $index{$t} = @tmp;
             }
         }
         self.write_tags_index($index);
     }
 
     method read_page_tags(Str $page) {
         my $file = $.page_tags_path ~ $page;
-        return '' unless $file ~~ :e;
+        return '' unless $file.IO ~~ :e;
         return slurp($file);
     }
 
@@ -85,7 +90,7 @@ class November::Tags {
 
     method read_tags_count() {
         my $file = $.tags_count_path;
-        return {} unless $file ~~ :e;
+        return {} unless $file.IO ~~ :e;
         return eval slurp $file;
     }
 
@@ -98,14 +103,14 @@ class November::Tags {
 
     method read_tags_index() {
         my $file = $.tags_index_path;
-        return {} unless $file ~~ :e;
+        return {} unless $file.IO ~~ :e;
         return eval slurp $file;
     }
 
     method write_tags_index(Hash $index) {
         my $file = $.tags_index_path;
         my $fh = open( $file, :w );
-        $fh.say( $index.perl );
+-        $fh.say( $index.perl );
         $fh.close;
     }