[svn:mod_parrot] r566 - in mod_parrot/trunk: languages/perl6/lib/ModPerl6 lib/ModParrot lib/ModParrot/HLL src/pmc t/response/TestAPI

Author: jhorwitz
Date: Thu Jan  1 13:19:36 2009
New Revision: 566

Added:
   mod_parrot/trunk/t/response/TestAPI/modparrothandle.pir
Modified:
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm
   mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
   mod_parrot/trunk/lib/ModParrot/Interpreter.pir
   mod_parrot/trunk/src/pmc/modparrothandle.pmc

Log:
add 'stdout' and 'stdin' methods to ModParrotHandle to tie Parrot I/O to Apache I/O


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 Jan  1 13:19:36 2009
@@ -4,6 +4,7 @@
 
 # for perl 6 functionality not yet supported by rakudo
 use ModPerl6::Fudge;
+use Apache::Const;
 
 module ModPerl6::Registry;
 
@@ -53,15 +54,6 @@
     return $out;
 }
 
-
-# XXX kludge alert!  temporary workaround until we can subclass FileHandle
-sub registry_print($r, $do_headers, *@args)
-{
-    for @args -> $arg {
-        $r.puts($do_headers ?? parse_headers($r, $arg) !! $arg);
-    }
-}
-
 sub handler($r)
 {
     my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
@@ -98,22 +90,26 @@
     ## 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;
-    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();
 
+    # XXX rip this out when we have a pure-perl6 Apache::RequestRec
+    my $rr = q:PIR<
+        $P0 = find_lex "$r"
+        getattribute %r, $P0, 'r'
+    >;
+
+    # tie stdout to $r, saving the old stdout filehandle
+    my $mpi = ModParrot::Interpreter.new();
+    my $stdout = $mpi.stdout($r);
+
+    # run our code
+    #::($mod)::_handler();
     my $res = ModPerl6::Fudge::call_sub_with_namespace($mod, '_handler');
 
-    # XXX kludge alert!  temporary workaround until we can subclass FileHandle
-    &*say = &CORE::say;
-    &*print = &CORE::print;
+    # reset stdout
+    $mpi.stdout($stdout);
 
-    return 0;
+    return $Apache::Const::OK;
 }

Modified: mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	Thu Jan  1 13:19:36 2009
@@ -39,6 +39,8 @@
     $P0.'register'($P1)
     $P1 = get_class ['ModParrot'; 'Context']
     $P0.'register'($P1)
+    $P1 = get_class ['ModParrotHandle']
+    $P0.'register'($P1)
 .end
 
 # declare namespace AFTER loading compiler

Modified: mod_parrot/trunk/lib/ModParrot/Interpreter.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/Interpreter.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/Interpreter.pir	Thu Jan  1 13:19:36 2009
@@ -140,55 +140,104 @@
     .return($S0)
 .end
 
-=item C<capture_stdout(INT flag)>
+=item C<PMC stdout(PMC handle :optional)>
 
 =over 4
 
-WARNING: This method is temporary and WILL go away.  Enables capture of
-standard output to an internal string buffer.
+With no arguments, returns the current stdout.
+
+If C<handle> is provided, this method will assign it to stdout.  If the
+C<handle> is a ModParrot;Apache;RequestRec object, a new ModParrotHandle will
+be created and tied to stdout.  FileHandles and ModParrotHandles will be
+assigned directly to stdout.  After assignment, returns the previous stdout.
 
 =back
 
 =cut
 
-.sub capture_stdout :method
-    .param int enabled
-    .local pmc pio
-
-    pio = getstdout
-    unless enabled goto disable_capture
-    push pio, "string"
+.sub stdout :method
+    .param pmc handle :optional
+    .param int got_handle :opt_flag
+    .local pmc stdout, fh
+
+    stdout = getstdout
+    unless got_handle goto done
+    $I0 = isa handle, ['ModParrot';'Apache';'RequestRec']
+    if $I0 goto have_r
+    $I0 = isa handle, ['FileHandle']
+    if $I0 goto have_filehandle
+    $I0 = isa handle, ['ModParrotHandle']
+    if $I0 goto have_modparrothandle
+    $P0 = new 'Exception'
+    $P0 = 'Cannot set stdout to an incompatible PMC'
+    throw $P0
+
+  have_r:
+    fh = new 'ModParrotHandle'
+    fh.'open'(handle, 'w')
+    fh.'setstdout'(fh)
+    goto done
+
+  have_filehandle:
+    fh = new 'ModParrotHandle'
+    fh.'setstdout'(handle)
     goto done
-  disable_capture:
-    $S0 = pop pio
+
+  have_modparrothandle:
+    handle.'setstdout'()
+
   done:
-.end
+    .return(stdout)
+.end 
 
-=item C<STRING dump_stdout(INT flag)>
+=item C<PMC stdin(PMC handle :optional)>
 
 =over 4
 
-WARNING: This method is temporary and WILL go away.  Returns the contents of
-the stdout string buffer created by C<capture_stdout()>.
+With no arguments, returns the current stdin.
+
+If C<handle> is provided, this method will assign it to stdin.  If the
+C<handle> is a ModParrot;Apache;RequestRec object, a new ModParrotHandle will
+be created and tied to stdin.  FileHandles and ModParrotHandles will be
+assigned directly to stdin.  After assignment, returns the previous stdin.
 
 =back
 
 =cut
 
-.sub dump_stdout :method
-    .local pmc pio
-    .local string buf, data
-
-    pio = getstdout
-    data = ""
-
-  read_loop:
-    buf = read pio, 4096
-    data .= buf
-    $I0 = length buf
-    if $I0 == 4096 goto read_loop
+.sub stdin :method
+    .param pmc handle :optional
+    .param int got_handle :opt_flag
+    .local pmc stdin, fh
+
+    stdin = getstdin
+    unless got_handle goto done
+    $I0 = isa handle, ['ModParrot';'Apache';'RequestRec']
+    if $I0 goto have_r
+    $I0 = isa handle, ['FileHandle']
+    if $I0 goto have_filehandle
+    $I0 = isa handle, ['ModParrotHandle']
+    if $I0 goto have_modparrothandle
+    $P0 = new 'Exception'
+    $P0 = 'Cannot set stdin to an incompatible PMC'
+    throw $P0
+
+  have_r:
+    fh = new 'ModParrotHandle'
+    fh.'open'(handle, 'r')
+    fh.'setstdin'(fh)
+    goto done
+
+  have_filehandle:
+    fh = new 'ModParrotHandle'
+    fh.'setstdin'(handle)
+    goto done
+
+  have_modparrothandle:
+    handle.'setstdin'()
 
-  .return(data)
+  done:
+    .return(stdin)
 .end
 
 =back

Modified: mod_parrot/trunk/src/pmc/modparrothandle.pmc
==============================================================================
--- mod_parrot/trunk/src/pmc/modparrothandle.pmc	(original)
+++ mod_parrot/trunk/src/pmc/modparrothandle.pmc	Thu Jan  1 13:19:36 2009
@@ -531,6 +531,40 @@
 
 /*
 
+=item C<METHOD setstdout(PMC *fh :optional)>
+
+TEMPORARY method to set this filehandle as stdout.  Will be removed in favor
+of a non-experimental setstdout or identical functionality in Parrot.
+
+Sets the provided filehandle as stdout, or SELF if no arguments are provided.
+
+=cut
+
+*/
+
+    METHOD setstdout(PMC *fh :optional, INTVAL got_fh :opt_flag) {
+        _PIO_STDOUT(INTERP) = got_fh ? fh : SELF;
+    }
+
+/*
+
+=item C<METHOD setstdin(PMC *fh :optional)>
+
+TEMPORARY method to set a filehandle as stdin.  Will be removed in favor
+of a non-experimental setstdin or identical functionality in Parrot.
+
+Sets the provided filehandle as stdin, or SELF if no arguments are provided.
+
+=cut
+
+*/
+
+    METHOD setstdin(PMC *fh :optional, INTVAL got_fh :opt_flag) {
+         _PIO_STDIN(INTERP) = got_fh ? fh : SELF;
+    }
+
+/*
+
 =back
 
 =cut

Added: mod_parrot/trunk/t/response/TestAPI/modparrothandle.pir
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/t/response/TestAPI/modparrothandle.pir	Thu Jan  1 13:19:36 2009
@@ -0,0 +1,80 @@
+# $Id$
+
+.namespace [ 'TestAPI::modparrothandle' ]
+
+.sub handler
+    .param pmc r
+    .local pmc fh, old, ap_const
+
+    ap_const = get_root_global [ 'ModParrot'; 'Apache'; 'Constants' ], 'table'
+
+    r.'puts'("1..11\n")
+
+  START_1:
+    fh = new 'ModParrotHandle'
+    $S0 = typeof fh
+    if $S0 == "ModParrotHandle" goto OK_1
+    r.'puts'("not ")
+  OK_1:
+    r.'puts'("ok 1 - object\n")
+
+  START_2:
+    push_eh NOT_OK_2
+    fh.'open'(r, "w")
+    pop_eh
+    goto OK_2
+  NOT_OK_2:
+    r.'puts'("not ")
+  OK_2:
+    r.'puts'("ok 2 - open\n") 
+
+  START_3:
+    fh.'puts'("ok 3 - puts\n") 
+
+  START_4:
+    old = getstdout
+    fh.'setstdout'()
+    say "ok 4 - setstdout (ModParrotHandle)"
+
+  START_5:
+    fh.'setstdout'(old)
+    print "not "
+    r.'puts'("ok 5 - setstdout (reset to old stdout)\n")
+
+  START_6:
+    old = getstdin
+    fh.'setstdin'()
+    r.'puts'("ok 6 - setstdin (ModParrotHandle)\n")
+
+  START_7:
+    push_eh NOT_OK_7
+    fh.'close'()
+    pop_eh
+    goto OK_7
+  NOT_OK_7:
+    r.'puts'("not ")
+  OK_7:
+    r.'puts'("ok 7 - close\n")
+
+  START_8:
+    fh.'open'(r, "r")
+    $S0 = fh.'read'(1024)
+    if $S0 == "" goto OK_8
+    r.'puts'("not ")
+  OK_8:
+    r.'puts'("ok 8 - read\n")
+
+  START_9:
+    r.'puts'("not ok 9 - readline # TODO\n")
+
+  START_10:
+    r.'puts'("not ok 10 - readall # TODO\n")
+
+  START_11:
+    fh.'setstdin'(old)
+    r.'puts'("ok 11 - setstdin (reset to old stdin)\n")
+
+    $I0 = ap_const['OK']
+    .return($I0)
+.end
+