develooper Front page | perl.cvs.mod_parrot | Postings from September 2009

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

From:
jhorwitz
Date:
September 7, 2009 12:32
Subject:
[svn:mod_parrot] r666 - mod_parrot/trunk/languages/perl6/lib/ModPerl6
Message ID:
20090907193215.1A0B51844F5@xx12.develooper.com
Author: jhorwitz
Date: Mon Sep  7 12:32:11 2009
New Revision: 666

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

Log:
fix I/O tying for latest Rakudo
remove workaround for setting CGI environment variables


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	Mon Sep  7 12:32:11 2009
@@ -83,25 +83,25 @@
     # XXX use %*ENV when Rakudo RT #61412 is fixed
     my $args = $r.args();
     my $uri = $args ?? ($r.uri() ~ '?' ~ $args) !! $r.uri();
-    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);
+    #ModPerl6::Fudge::setenv('MODPERL6', 1);
+    #ModPerl6::Fudge::setenv('QUERY_STRING', $args);
+    %*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> = $server_port;
 
     my $do_headers = %dircfg<options><parseheaders>;
 
     my $mod = %registry{$script};
 
+    ### Tie I/O handles to the request -- VERY SENSITIVE TO RAKUDO CHANGES! ###
 
-    # tie stdin to $r
     my $stdin;
-    my $oldstdin = $*IN;
     q:PIR{
         $P0 = new 'ModParrotHandle'
         $P1 = find_lex '$r'
@@ -110,11 +110,10 @@
         $P4 = $P3.'new'('PIO' => $P2)
         store_lex '$stdin', $P4
     };
-    $*IN := $stdin;
+    my $*IN := $stdin;
 
     # tie stdout to $r
     my $stdout;
-    my $oldstdout = $*OUT;
     q:PIR{
         $P0 = new 'ModParrotHandle'
         $P1 = find_lex '$r'
@@ -123,16 +122,13 @@
         $P4 = $P3.'new'('PIO' => $P2)
         store_lex '$stdout', $P4
     };
-    $*OUT := $stdout;
+    my $*OUT := $stdout;
 
+    ### End of I/O tying ###
 
     # run our code
     #::($mod)::_handler();
     my $res = ModPerl6::Fudge::call_sub_with_namespace($mod, 'reg__handler');
 
-    # restore I/O filehandles
-    $*IN := $oldstdin;
-    $*OUT := $oldstdout;
-
     return $Apache::Const::OK;
 }



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About