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

[svn:mod_parrot] r574 - mod_parrot/trunk/lib/ModParrot/HLL

From:
jhorwitz
Date:
January 2, 2009 09:14
Subject:
[svn:mod_parrot] r574 - mod_parrot/trunk/lib/ModParrot/HLL
Message ID:
20090102171432.BBFB8CB9FA@x12.develooper.com
Author: jhorwitz
Date: Fri Jan  2 09:14:32 2009
New Revision: 574

Modified:
   mod_parrot/trunk/lib/ModParrot/HLL/lolcode.pir

Log:
update for new architecture


Modified: mod_parrot/trunk/lib/ModParrot/HLL/lolcode.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/HLL/lolcode.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/HLL/lolcode.pir	Fri Jan  2 09:14:32 2009
@@ -17,10 +17,26 @@
 .namespace [ 'ModParrot'; 'HLL'; 'lolcode' ]
 
 .sub __onload :anon :load
+    .local pmc add_module, cmds, hooks, mp_const
+
     load_bytecode 'languages/lolcode/lolcode.pbc'
     load_bytecode 'CGI/QueryHash.pbc'
+    load_bytecode 'ModParrot/Apache/RequestRec.pbc'
+    load_bytecode 'ModParrot/Apache/Module.pbc'
+    load_bytecode 'ModParrot/Constants.pbc'
+
     $P0 = new 'Hash'
     set_hll_global 'lolcode_registry', $P0
+
+    # we have no directives, so this will remain empty
+    cmds = new 'ResizablePMCArray'
+
+    hooks = new 'ResizablePMCArray'
+    mp_const = get_root_global [ 'ModParrot'; 'Constants' ], 'table'
+    $I0 = mp_const['MP_HOOK_RESPONSE']
+    hooks[0] = $I0
+    add_module = get_hll_global [ 'ModParrot'; 'Apache'; 'Module' ], 'add'
+    $P1 = add_module("modparrot_lolcode_module", "lolcode", cmds, hooks)
 .end
 
 .sub load
@@ -31,8 +47,8 @@
     registry = get_hll_global 'lolcode_registry'
     $I0 = exists registry[file]
     if $I0 goto load_from_registry
-    $P0 = open file, '<'
-    source = $P0.'slurp'(0)
+    $P0 = open file, 'r'
+    source = $P0.'readall'()
     close $P0
     $P1 = compreg 'lolcode'
     $P2 = $P1.'compile'(source)
@@ -44,18 +60,15 @@
     .return($P2)
 .end
 
-#.sub config
-
 # response handler
-.sub handler
+.sub response_handler
     .param pmc ctx
-    .param pmc handler_name
     .local string script_path
     .local string output
     .local string key
     .local pmc r
     .local pmc ap_const
-    .local pmc interp
+    .local pmc interp, oldin, oldout
     .local pmc code
     .local pmc query_parse
     .local pmc query
@@ -68,12 +81,24 @@
     # get the request_rec object
     r = ctx.'request_rec'()
 
+    # is this LOLCODE?
+    $S0 = r.'handler'()
+    if $S0 == 'application/x-httpd-lolcode' goto have_lolcode
+    status = ap_const['DECLINED']
+    .return(status)
+
+  have_lolcode:
     # get the interpreter object
     interp = ctx.'interp'()
-    script_path = r.'filename'()
 
+    # tie I/O to the request
+    oldout = interp.'stdout'(r)
+    oldin = interp.'stdin'(r)
+
+    # load the code
+    script_path = r.'filename'()
     push_eh report_error
-        code = load(script_path)
+    code = load(script_path)
     pop_eh
 
     # set default content type
@@ -103,17 +128,15 @@
     goto query_loop
   query_loop_end:
 
-    interp.'capture_stdout'(1)
+    r.'content_type'("text/html")
     push_eh report_error
-        status = code()
+    code()
     pop_eh
-    output = interp.'dump_stdout'()
-    interp.'capture_stdout'(0)
-    r.'puts'(output)
-    status = 0
+    status = ap_const['OK']
     goto return_status
 
   report_error:
+    pop_eh
     get_results '0,0', $P0, $S0
     $S1 = script_path
     concat $S1, ": "
@@ -123,6 +146,9 @@
     status = ap_const['HTTP_INTERNAL_SERVER_ERROR']
 
   return_status:
+    # restore filehandles
+    interp.'stdout'(oldout)
+    interp.'stdin'(oldin)
     # return status code
     .return(status)
 .end



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