[svn:mod_parrot] r550 - mod_parrot/trunk/languages/perl6/lib/ModPerl6

Author: jhorwitz
Date: Wed Dec 17 13:58:59 2008
New Revision: 550

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

Log:
fudge setting %*ENV until hash value binding works again
fix header parsing


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	Wed Dec 17 13:58:59 2008
@@ -68,3 +68,14 @@
   return_result:
     .return($P0)
 .end
+
+# NAME: setenv
+# PURPOSE: sets the value of an environment variable
+# FUDGES: %*ENV<foo> = 'bar' and its workaround %*ENV<foo> := 'bar';
+.sub setenv
+    .param pmc key
+    .param pmc val
+
+    $P0 = get_hll_global '%ENV'
+    $P0[key] = val
+.end

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	Wed Dec 17 13:58:59 2008
@@ -26,7 +26,12 @@
     my $out = '';
     my $headers_out = $r.headers_out();
     for $in.split(/\n/) -> $line {
-        if (!$headers_done && $line ~~ /<header_regex>/) {
+        if ($line eq '') {
+            if ($headers_done) {
+                $out ~= "\n";
+            }
+        }
+        elsif (!$headers_done && $line ~~ /<header_regex>/) {
             my $key = ~$<header_regex>[0];
             my $val = ~$<header_regex>[1];
             given $key.lc {
@@ -36,9 +41,7 @@
         }
         # this will catch non-headers as well as the blank line postamble
         else {
-            if ($headers_done) {
-            }
-            else {
+            unless ($headers_done) {
                 $r.notes.set('modperl6-parsed-headers', 'yes');
                 $headers_done = 1;
             }
@@ -54,7 +57,9 @@
 # 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, $_) !! $_)});
+    for @args -> $arg {
+        $r.puts($do_headers ?? parse_headers($r, $arg) !! $arg);
+    }
 }
 
 sub handler($r)
@@ -79,19 +84,19 @@
     my $cookies = $headers_in.get('Cookie');
 
     # set environment variables expected by CGI scripts
-    # XXX binding (:=) works, but assigning (=) doesn't
+    # XXX use %*ENV when Rakudo RT #61412 is fixed
     my $args = $r.args();
     my $uri = $args ?? ($r.uri() ~ '?' ~ $args) !! $r.uri();
-    %*ENV<MODPERL6> := 1;
-    %*ENV<QUERY_STRING> := $args;
-    %*ENV<PATH_INFO> := $r.path_info();
-    %*ENV<REQUEST_METHOD> := $r.method();
-    %*ENV<REQUEST_URI> := $uri;
-    %*ENV<CONTENT_LENGTH> := $content_length;
-    %*ENV<HTTP_COOKIE> := $cookies;
-    %*ENV<SERVER_NAME> := $r.hostname;
-    # XXX requires server_rec
-    # %*ENV<SERVER_PORT> := ;
+    ModPerl6::Fudge::setenv('MODPERL6', 1);
+    ModPerl6::Fudge::setenv('QUERY_STRING', $args);
+    ModPerl6::Fudge::setenv('PATH_INFO', $r.path_info);
+    ModPerl6::Fudge::setenv('REQUEST_METHOD', $r.method);
+    ModPerl6::Fudge::setenv('REQUEST_URI', $uri);
+    ModPerl6::Fudge::setenv('CONTENT_LENGTH', $content_length);
+    ModPerl6::Fudge::setenv('HTTP_COOKIE', $cookies);
+    ModPerl6::Fudge::setenv('SERVER_NAME', $r.hostname);
+    ## XXX requires server_rec
+    #ModPerl6::Fudge::setenv('SERVER_PORT', $server_port);
 
     # XXX kludge alert!  temporary workaround until we can subclass FileHandle
     our &CORE::say := &*say;