[svn:mod_parrot] r476 - in mod_parrot/trunk: languages/perl6/lib src

Author: jhorwitz
Date: Tue Oct 28 16:53:51 2008
New Revision: 476

Modified:
   mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm
   mod_parrot/trunk/src/module.c

Log:
fix bug where every hook is always registered


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 Oct 28 16:53:51 2008
@@ -20,8 +20,6 @@
 use ModParrot::Const;
 use Apache::Const;
 
-our @preloaded_modules = ();
-our @postconfig_requires = ();
 our %loaded_modules;
 
 sub load($handler)
@@ -35,6 +33,9 @@
 sub server_create()
 {
     my %cfg;
+    %cfg<preloaded_modules> = [];
+    %cfg<postconfig_requires> = [];
+    push(%cfg<preloaded_modules>, "My::Test");
     return %cfg;
 }
 
@@ -44,61 +45,94 @@
     return %cfg;
 }
 
+# determine the type of handler and call it appropriately
+# handler types are: package, subroutine, and method
+# XXX currently forces package handlers
+# XXX broken until we can pass flattened arrays to handler()
+#sub call_handler($handler, *@args)
+#{
+#    my $status = ::($handler)::handler(*@args);
+#}
+
 sub response_handler($ctx)
 {
     my $r = $ctx.request_rec();
 
     unless ($r.handler() ~~ any(<modperl6 perl6-script>)) {
-        return $Apache::Const::DECLINED
+        return $Apache::Const::DECLINED;
     }
 
     my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
     my %dircfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module",
         $r.per_dir_config());
 
-    my $handler = %dircfg{'response_handler'};
+    my $handler = %dircfg<response_handler>;
     load($handler);
 
     $r.content_type('text/html');
+    # XXX switch to call_handler when flattened array passing is fixed
+    #my $status = call_handler($handler, $r);
     my $status = ::($handler)::handler($r);
     return $status;
 }
 
-sub post_config_handler($ctx, $handler)
+sub post_config_handler($ctx)
 {
     #my $conf_pool = $ctx.conf_pool();
     #my $log_pool = $ctx.log_pool();
     #my $temp_pool = $ctx.temp_pool();
     #my $s = $ctx.server_rec();
 
+    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    $*ERR.say("modules: " ~ join(',', %cfg<preloaded_modules>));
+
     # preload modules
-    for @preloaded_modules -> $m {
-        # XXX fix when namespace interpolation works
-        # use ::($m);
-        eval "use $m";
+    for %cfg<preloaded_modules> -> $m {
+        $*ERR.say("loading $m");
+        use $m;
     }
 
     # load postconfig requires
-    for @postconfig_requires -> $r {
-        # XXX does this work???
+    for %cfg<postconfig_requires> -> $r {
         require $r;
     }
 
+    my $handler = %cfg<post_config_handler>;
+    unless ($handler) {
+        return $Apache::Const::OK;
+    }
+
     # run the postconfig handler
     load($handler);
-    #my $status = ::($handler)::handler($conf_pool, $log_pool, $temp_pool, $s);
+    # XXX switch to call_handler when flattened array passing is fixed
+    # XXX fix when we have pool & server_rec objects
+    #my $status = call_handler($handler, $conf_pool, $log_pool, $temp_pool, $s);
+    #my $status = call_handler($handler);
     my $status = ::($handler)::handler();
     return $status;
 }
 
 sub cmd_perl6responsehandler(%dircfg, @args)
 {
-    %dircfg{'response_handler'} = @args[0];
+    %dircfg<response_handler> = @args[0];
+}
+
+sub cmd_perl6module(%mconfig, @args)
+{
+    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    push(%cfg<preloaded_modules>, @args[0]);
 }
 
 # register configuration directives
 my @cmds = (
     {
+        'name' => 'Perl6Module',
+        'args_how' => $Apache::Const::TAKE1,
+        'func' => &cmd_perl6module,
+        'req_override' => $Apache::Const::RSRC_CONF,
+        'errmsg' => 'usage: Perl6Module module'
+    },
+    {
         'name' => 'Perl6ResponseHandler',
         'args_how' => $Apache::Const::TAKE1,
         'func' => &cmd_perl6responsehandler,
@@ -109,6 +143,7 @@
 
 # register hooks
 my @hooks = (
+    $ModParrot::Const::MP_HOOK_POST_CONFIG,
     $ModParrot::Const::MP_HOOK_RESPONSE
 );
 

Modified: mod_parrot/trunk/src/module.c
==============================================================================
--- mod_parrot/trunk/src/module.c	(original)
+++ mod_parrot/trunk/src/module.c	Tue Oct 28 16:53:51 2008
@@ -433,9 +433,9 @@
         hook_index = Parrot_PMC_get_intval(interp, hpmc);
         if (hook_index == MP_HOOK_ALL) {
             do_all = 1;
-        }
-        for (i = 0; i < MP_HOOK_LAST; i++) {
-            minfo->hooks[i] = 1;
+            for (i = 0; i < MP_HOOK_LAST; i++) {
+                minfo->hooks[i] = 1;
+            }
         }
     }
     for (i = 0; i < num && !do_all; i++) {