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

Author: jhorwitz
Date: Thu Nov 20 12:51:22 2008
New Revision: 498

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

Log:
factor out handler dispatch to support multiple forms:
* regular handlers (NAMESPACE)
* literal handlers (NAMESPACE::custom_handler_name)
* method handlers (NAMESPACE.custom_handler_name)
method handlers only look for a "handler" method right now



Modified: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir	(original)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir	Thu Nov 20 12:51:22 2008
@@ -4,6 +4,22 @@
 
 .namespace ['ModPerl6';'Fudge']
 
+# NAME: resolve_sub
+# PURPOSE: look up and return subroutine PMC in a namespace
+# FUDGES: resolving subs with interpolated namespaces
+.sub resolve_sub
+    .param string ns
+    .param string name
+
+    $P0 = split '::', ns
+    $P1 = get_hll_global $P0, name
+    $I0 = isnull $P1
+    unless $I0 goto return_sub
+    $P1 = new 'Undef'
+  return_sub:
+    .return($P1)
+.end
+
 # NAME: call_sub_with_namespace
 # PURPOSE: call a sub defined in a namespace
 # FUDGES: calling subs with interpolated namespaces
@@ -12,9 +28,9 @@
     .param string name
     .param pmc args :slurpy
 
-    $P0 = split '::', ns
-    $P1 = get_hll_global $P0, name
-    $P0 = $P1(args :flat)
-
-    .return($P0)
+    $P1 = 'resolve_sub'(ns, name)
+    if null $P1 goto return_result
+    $P1 = $P0(args :flat)
+  return_result:
+    .return($P1)
 .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	Thu Nov 20 12:51:22 2008
@@ -74,6 +74,52 @@
     return %cfg;
 }
 
+# XXX should cache the handler form during configuration
+sub call_handler($ctx, $handler, *@args)
+{
+    my $sub;
+
+    # resolve a method handler
+    # XXX fix when array lvalues work
+    #my ($class, $method) = split('.', $handler);
+    my @pieces = split('.', $handler);
+    my $class = @pieces[0];
+    my $method = @pieces[1];
+    # i'd like to run this later with the other forms, but the calling
+    # conventions are different for methods so just run it here
+    if ($method) {
+        load($class);
+        # XXX need quotes, but works in tests without the "split" above
+        my $obj = "$class".new;
+	# XXX don't have subroutine interpolation, so we hardcode 'handler'
+        my $res = $obj.handler(|@args);
+        return $res;
+    }
+
+    # resolve a literal $handler()
+    # do this first so we don't load() until we need to
+    my @names = split('::', $handler);
+    my $subname = @names.pop;
+    my $ns = join('::', @names);
+    my $sub = ModPerl6::Fudge::resolve_sub($ns, $subname);
+    unless ($sub.isa('Block')) {
+        # load $handler and try $handler::handler() (common convention)
+        load($handler);
+        $sub = ModPerl6::Fudge::resolve_sub($handler, 'handler');
+    }
+
+    # run the handler
+    # XXX why doesn't 'Sub' work here?
+    if ($sub.isa('Block')) {
+        my $res = $sub(|@args);
+        return $res;
+    }
+
+    # nothing worked -- return an error
+    # XXX should also log something here
+    return $Apache::Const::HTTP_INTERNAL_SERVER_ERROR
+}
+    
 sub response_handler($ctx)
 {
     my $r = $ctx.request_rec();
@@ -87,15 +133,9 @@
         $r.per_dir_config());
 
     my $handler = %dircfg<response_handler>;
-    load($handler);
 
     $r.content_type('text/html');
-    #my $status = ::($handler)::handler($r);
-    my $status = ModPerl6::Fudge::call_sub_with_namespace(
-        $handler,
-        'handler',
-        $r
-    );
+    my $status = call_handler($ctx, $handler, $r);
     return $status;
 }
 
@@ -125,11 +165,7 @@
     # run the postconfig handler
     load($handler);
     #my $status = ::($handler)::handler($conf_pool, $log_pool, $temp_pool, $s);
-    #my $status = ::($handler)::handler();
-    my $status = ModPerl6::Fudge::call_sub_with_namespace(
-        $handler,
-        'handler'
-    );
+    my $status = call_handler($ctx, $handler, 'handler');
     return $status;
 }