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

Author: jhorwitz
Date: Thu Dec 11 13:30:02 2008
New Revision: 544

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

Log:
temporary fix for parrot pdd22io branch merge, since we don't have an IO
string layer anymore.  other registry-style HLLs will need a similar fix.  the
*right* way to do this is to subclass the FileHandle PMC, but that's not
possible just yet.



Modified: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm	(original)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm	Thu Dec 11 13:30:02 2008
@@ -14,43 +14,47 @@
 {
     my $name = $path;
     # sanitize the module name
-    # XXX fix when \w works in character classes
-    #$name .= subst(/<-[\w]>/, '_', :global);
     $name .= subst(/<-alnum>/, '_', :global);
     return "ModPerl6::Registry::Script::$name";
 }
 
 # this is temporary until mod_parrot supports output filters
-sub parse_headers($r, $buf is rw)
+sub parse_headers($r, $in)
 {
+    my $headers_done = 0;
+    return $in if $r.notes.get('modperl6-parsed-headers');
+    my $out = '';
     my $headers_out = $r.headers_out();
-    my $top;
-    my $bottom;
-    if ($buf ~~ /^([\N+\n]+)\n(.*)/) {
-        $top = ~$0;
-        $bottom = ~$1;
-    }
-    else {
-        $top = $buf;
-        $bottom = '';
-    }
-    my $n = 0;
-    $top .= chomp;
-    while ($top ~~ /<header_regex>/) {
-        $n++;
-        my $key = $<header_regex>[0];
-        my $val = $<header_regex>[1];
-        given $key.lc {
-            when 'content-type' { $r.content_type($val); }
-            default { $headers_out.set($key, $val); }
+    for $in.split(/\n/) -> $line {
+        if (!$headers_done && $line ~~ /<header_regex>/) {
+            my $key = ~$<header_regex>[0];
+            my $val = ~$<header_regex>[1];
+            given $key.lc {
+                when 'content-type' { $r.content_type($val); }
+                default { $headers_out.set($key, $val); }
+            }
+        }
+        # this will catch non-headers as well as the blank line postamble
+        else {
+            if ($headers_done) {
+            }
+            else {
+                $r.notes.set('modperl6-parsed-headers', 'yes');
+                $headers_done = 1;
+            }
+            if ($line.chars) {
+                $out ~= $line ~ "\n";
+            }
         }
-        $top .= subst(/<header_regex>/, '');
     }
+    return $out;
+}
 
-    # modify the output only if we found headers
-    if ($n++) {
-        $buf = $bottom;
-    }
+
+# XXX kludge alert!  temporary workaround until we can subclass FileHandle
+sub registry_print($r, $do_headers, *@args)
+{
+    @args.map({$r.puts($do_headers ?? parse_headers($r, $_) !! $_)});
 }
 
 sub handler($r)
@@ -89,21 +93,22 @@
     # XXX requires server_rec
     # %*ENV<SERVER_PORT> := ;
 
-    my $interp = ModParrot::Interpreter.new();
-    $interp.capture_stdout(1);
+    # XXX kludge alert!  temporary workaround until we can subclass FileHandle
+    our &CORE::say := &*say;
+    our &CORE::print := &*print;
+    my $do_headers = %dircfg<options><parseheaders>;
+
+    &*say = sub (*@args) { registry_print($r, $do_headers, |@args, "\n"); };
+    &*print = sub (*@args) { registry_print($r, $do_headers, |@args); };
+
     my $mod = %registry{$script};
     #::($mod)::_handler();
-    my $res = ModPerl6::Fudge::call_sub_with_namespace($mod, '_handler');
 
-    my $buf = $interp.dump_stdout();
-    $interp.capture_stdout(0);
-
-    if (%dircfg<options><parseheaders>) {
-        parse_headers($r, $buf);
-    }
+    my $res = ModPerl6::Fudge::call_sub_with_namespace($mod, '_handler');
 
-    # should probably be write()
-    $r.puts($buf);
+    # XXX kludge alert!  temporary workaround until we can subclass FileHandle
+    &*say = &CORE::say;
+    &*print = &CORE::print;
 
     return 0;
 }

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 Dec 11 13:30:02 2008
@@ -70,7 +70,7 @@
 
     # options set with Perl6Options
     %cfg<options> = {
-        parse_headers => False,
+        parseheaders => False,
     };
 
     return %cfg;