[svn:mod_parrot] r539 - mod_parrot/trunk/languages/perl6/lib

[email protected] Tue, 9 Dec 2008 11:42:06 -0800 (PST)
Newsgroups perl.cvs.mod_parrot
Message-ID <[email protected]>
Author: jhorwitz
Date: Tue Dec  9 11:42:06 2008
New Revision: 539

Modified:
   mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm

Log:
add Perl6CleanupHandler
fix for recent rakudos
some code cleanup



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 Dec  9 11:42:06 2008
@@ -110,11 +110,12 @@
 }
 
 # XXX should cache the handler form during configuration
-sub call_handler($ctx, $handler, *@args)
+sub call_handler($handler, *@args)
 {
     my $sub;
     my $res;
 
+    return $Apache::Const::DECLINED unless defined($handler);
     # resolve a method handler
     # XXX fix when array lvalues work
     #my ($class, $method) = split('.', $handler);
@@ -160,7 +161,26 @@
 
     return $Apache::Const::HTTP_INTERNAL_SERVER_ERROR;
 }
-    
+ 
+sub header_parser_handler($ctx)
+{
+    my $r = $ctx.request_rec();
+
+    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %dircfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module",
+        $r.per_dir_config());
+
+    # first phase that has a dir config, so register any cleanup handlers
+    if (%dircfg<cleanup_handler>) {
+        $r.pool.cleanup_register(&cleanup_handler, %dircfg<cleanup_handler>);
+    }
+
+    # back to the post_read_request handler
+    my $handler = %dircfg<header_parser_handler>;
+    my $status = call_handler($handler, $r);
+    return $status;
+}
+
 sub response_handler($ctx)
 {
     my $r = $ctx.request_rec();
@@ -176,7 +196,7 @@
     my $handler = %dircfg<response_handler>;
 
     $r.content_type('text/html');
-    my $status = call_handler($ctx, $handler, $r);
+    my $status = call_handler($handler, $r);
     return $status;
 }
 
@@ -205,9 +225,14 @@
     }
 
     # run the postconfig handler
-    load($handler);
     #my $status = ::($handler)::handler($conf_pool, $log_pool, $temp_pool, $s);
-    my $status = call_handler($ctx, $handler, 'handler');
+    my $status = call_handler($handler);
+    return $status;
+}
+
+sub cleanup_handler($handler)
+{
+    my $status = call_handler($handler);
     return $status;
 }
 
@@ -216,6 +241,16 @@
     %dircfg<response_handler> = @args[0];
 }
 
+sub cmd_perl6headerparserhandler(%dircfg, @args)
+{
+    %dircfg<header_parser_handler> = @args[0];
+} 
+
+sub cmd_perl6cleanuphandler(%dircfg, @args)
+{
+    %dircfg<cleanup_handler> = @args[0];
+} 
+
 sub cmd_perl6module(%mconfig, @args)
 {
     my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
@@ -225,8 +260,8 @@
 sub cmd_perl6options(%mconfig, @args)
 {
     if (@args[0] ~~ /(\+|\-)(.+)/) {
-        my $modifier = $0;
-        my $option = $1.lc;
+        my $modifier = ~$0;
+        my $option = (~$1).lc;
         my $val = ($modifier eq '+');
 	if (%valid_options{$option}) {
                 %mconfig<options>{$option} = $val; 
@@ -262,12 +297,27 @@
         'func' => &cmd_perl6responsehandler,
         'req_override' => $Apache::Const::OR_AUTHCFG,
         'errmsg' => 'usage: Perl6ResponseHandler handler-name'
+    },
+    {
+        'name' => 'Perl6HeaderParserHandler',
+        'args_how' => $Apache::Const::TAKE1,
+        'func' => &cmd_perl6headerparserhandler,
+        'req_override' => $Apache::Const::OR_AUTHCFG,
+        'errmsg' => 'usage: Perl6HeaderParserHandler handler-name'
+    },
+    {
+        'name' => 'Perl6CleanupHandler',
+        'args_how' => $Apache::Const::TAKE1,
+        'func' => &cmd_perl6cleanuphandler,
+        'req_override' => $Apache::Const::OR_AUTHCFG,
+        'errmsg' => 'usage: Perl6CleanupHandler handler-name'
     }
 );
 
 # register hooks
 my @hooks = (
     $ModParrot::Const::MP_HOOK_POST_CONFIG,
+    $ModParrot::Const::MP_HOOK_HEADER_PARSER,
     $ModParrot::Const::MP_HOOK_RESPONSE
 );