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

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

From:
jhorwitz
Date:
September 7, 2009 07:23
Subject:
[svn:mod_parrot] r664 - mod_parrot/trunk/languages/perl6/lib/ModPerl6
Message ID:
20090907142326.5BB5C1844F5@xx12.develooper.com
Author: jhorwitz
Date: Mon Sep  7 07:23:22 2009
New Revision: 664

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

Log:
fix stdin/stdout binding with some inline PIR


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 07:23:22 2009
@@ -98,22 +98,41 @@
 
     my $mod = %registry{$script};
 
-    # tie I/O to $r, saving the old filehandles
-    my $mpi = ::ModParrot::Interpreter.new();
-    my $stdin = $mpi.stdin($r);
-    my $stdout = $mpi.stdout($r);
-    $*IN := $mpi.stdin;
-    $*OUT := $mpi.stdout;
+
+    # tie stdin to $r
+    my $stdin;
+    my $oldstdin = $*IN;
+    q:PIR{
+        $P0 = new 'ModParrotHandle'
+        $P1 = find_lex '$r'
+        $P2 = $P0.'open'($P1, 'r')
+        $P3 = get_hll_global 'IO'
+        $P4 = $P3.'new'('PIO' => $P2)
+        store_lex '$stdin', $P4
+    };
+    $*IN := $stdin;
+
+    # tie stdout to $r
+    my $stdout;
+    my $oldstdout = $*OUT;
+    q:PIR{
+        $P0 = new 'ModParrotHandle'
+        $P1 = find_lex '$r'
+        $P2 = $P0.'open'($P1, 'w')
+        $P3 = get_hll_global 'IO'
+        $P4 = $P3.'new'('PIO' => $P2)
+        store_lex '$stdout', $P4
+    };
+    $*OUT := $stdout;
+
 
     # run our code
     #::($mod)::_handler();
     my $res = ModPerl6::Fudge::call_sub_with_namespace($mod, 'reg__handler');
 
     # restore I/O filehandles
-    $mpi.stdin($stdin);
-    $mpi.stdout($stdout);
-    $*IN := $stdin;
-    $*OUT := $stdout;
+    $*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