[svn:mod_parrot] r487 - in mod_parrot/trunk/languages/perl6/lib: . ModPerl6

Author: jhorwitz
Date: Tue Nov 11 11:34:00 2008
New Revision: 487

Added:
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir
Modified:
   mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm

Log:
implement Perl6Options
added ModPerl6::Fudge module for functionality unimplemented in rakudo
using ModPerl6::Fudge for interpolated namespace support


Added: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir	Tue Nov 11 11:34:00 2008
@@ -0,0 +1,20 @@
+# $Id$
+
+# This file contains functions we need but Rakudo doesn't yet support
+
+.namespace ['ModPerl6';'Fudge']
+
+# NAME: call_sub_with_namespace
+# PURPOSE: call a sub defined in a namespace
+# FUDGES: calling subs with interpolated namespaces
+.sub call_sub_with_namespace
+    .param string ns
+    .param string name
+    .param pmc args :slurpy
+
+    $P0 = split '::', ns
+    $P1 = get_hll_global $P0, name
+    $P0 = $P1(args :flat)
+
+    .return($P0)
+.end

Modified: mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	(original)
+++ mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	Tue Nov 11 11:34:00 2008
@@ -20,7 +20,14 @@
 use ModParrot::Const;
 use Apache::Const;
 
+# for perl 6 functionality not yet supported by rakudo
+use ModPerl6::Fudge;
+
 our %loaded_modules;
+our %valid_options = <
+    enable
+    parseheaders
+>.map({($_,1)});
 
 sub load($handler)
 {
@@ -34,6 +41,11 @@
 {
     my %cfg;
 
+    # options set with Perl6Options
+    %cfg<options> = {
+        parse_headers => True,
+    };
+
     # preloading
     %cfg<preloaded_modules> = [];
     %cfg<postconfig_requires> = [];
@@ -78,7 +90,12 @@
     load($handler);
 
     $r.content_type('text/html');
-    my $status = ::($handler)::handler($r);
+    #my $status = ::($handler)::handler($r);
+    my $status = ModPerl6::Fudge::call_sub_with_namespace(
+        $handler,
+        'handler',
+        $r
+    );
     return $status;
 }
 
@@ -91,12 +108,12 @@
     my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
 
     # preload modules
-    for %cfg<preloaded_modules> -> $m {
+    for %cfg<preloaded_modules>.values -> $m {
         use $m;
     }
 
     # load postconfig requires
-    for %cfg<postconfig_requires> -> $r {
+    for %cfg<postconfig_requires>.values -> $r {
         require $r;
     }
 
@@ -108,7 +125,11 @@
     # run the postconfig handler
     load($handler);
     #my $status = ::($handler)::handler($conf_pool, $log_pool, $temp_pool, $s);
-    my $status = ::($handler)::handler();
+    #my $status = ::($handler)::handler();
+    my $status = ModPerl6::Fudge::call_sub_with_namespace(
+        $handler,
+        'handler'
+    );
     return $status;
 }
 
@@ -123,9 +144,35 @@
     push(%cfg<preloaded_modules>, @args[0]);
 }
 
+sub cmd_perl6options(%mconfig, @args)
+{
+    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    if (@args[0] ~~ /(\+|\-)(.+)/) {
+        my $modifier = ~$/[0];
+        my $option = ~$/[1].lc;
+        my $val = ($modifier eq '+');
+	if (%valid_options{$option}) {
+                %cfg<options>{$option} = $val; 
+        }
+        else {
+            default { die "invalid option '$option'"; }
+        }
+    }
+    else {
+        die "missing modifier prefix (+ or -)";
+    }
+}
+
 # register configuration directives
 my @cmds = (
     {
+        'name' => 'Perl6Options',
+        'args_how' => $Apache::Const::ITERATE,
+        'func' => &cmd_perl6options,
+        'req_override' => $Apache::Const::RSRC_CONF,
+        'errmsg' => 'usage: Perl6Options [+/-]option ...'
+    },
+    {
         'name' => 'Perl6Module',
         'args_how' => $Apache::Const::TAKE1,
         'func' => &cmd_perl6module,