[svn:mod_parrot] r345 - in mod_parrot/trunk: eg/perl6 languages/perl6/lib/ModPerl6

Author: jhorwitz
Date: Fri May 30 12:57:44 2008
New Revision: 345

Added:
   mod_parrot/trunk/eg/perl6/counter
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm

Log:
first stab at ModPerl6::Registry


Added: mod_parrot/trunk/eg/perl6/counter
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/eg/perl6/counter	Fri May 30 12:57:44 2008
@@ -0,0 +1,28 @@
+#!/usr/bin/perl6
+
+# $Id$
+
+# This is the registry version of the counter.  See ModPerl6/Counter.pm for
+# more details.
+#
+# Usage:
+# Create a perl6-bin directory
+# Copy this file to perl6-bin
+#
+# ParrotIncludePath /path/to/eg/perl6:/path/to/parrot/runtime/parrot/library:/pa
+th/to/mod_parrot/lib
+# ParrotLoad ModParrot/HLL/perl6.pbc
+# ParrotAddHandler perl6 perl6-script
+# <Directory /path/to/perl6-bin>
+#     Options +ExecCGI
+#     SetHandler perl6-script
+#     ParrotHandler ModPerl6::Registry
+# </Directory>
+
+our $x;
+unless ($x) {
+    $x = 1;
+}
+say "<h1>Hello, I'm a mod_perl6 response handler!</h1>";
+say "Page views for this interpreter: $x";
+$x++;

Added: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm	Fri May 30 12:57:44 2008
@@ -0,0 +1,65 @@
+# $Id$
+
+module ModPerl6::Registry;
+
+our %registry;
+
+sub load_script($path)
+{
+    my $fh = open($path, 'r');
+    if (defined($fh)) {
+        my $data = "";
+        while (my $line = $fh.readline()) {
+            $data ~= "$line\n";
+        }
+        $fh.close();
+        $data;
+    }
+    else {
+        undef;
+    }
+}
+
+sub gen_module_name($path)
+{
+    # until we have substitutions, use split/join to sanitize the path.
+    # for some reason, split isn't working inside of mod_parrot, so we'll
+    # just generate random module names until we fix the problem
+
+    #my $path = "$path";
+    #my @pieces = split('/', $path);
+    #@pieces.push(split('-', $path));
+    #my $mod = "ModPerl6::Registry::Script::" ~ join('_', @pieces);
+
+    my $mod;
+    repeat {
+        $mod = "ModPerl6::Registry::Script" ~ rand(1000000);
+    } while (%registry{$mod});
+
+    $mod;
+}
+
+sub handler($r)
+{
+    my $script = $r.filename();
+    unless (%registry{$script}) {
+        my $data = load_script($script);
+        my $mod = gen_module_name($script);
+        my $code = "module $mod; sub _handler { $data }";
+        eval $code;
+        %registry{$script} = $mod;
+        %registry{$mod} = $script;
+    }
+
+    my $interp = ModParrot::Interpreter.new();
+    $interp.capture_stdout(1);
+    my $mod = %registry{$script};
+    ::($mod)::_handler();
+    my $buf = $interp.dump_stdout();
+    $interp.capture_stdout(0);
+
+    # should probably be write()
+    $r.puts($buf);
+
+    0;
+}