[svn:p5ee] r6837 - p5ee/trunk/App-Context/lib/Apache

Author: spadkins
Date: Sun Sep  3 18:57:14 2006
New Revision: 6837

Added:
   p5ee/trunk/App-Context/lib/Apache/App.pm

Log:
new

Added: p5ee/trunk/App-Context/lib/Apache/App.pm
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Context/lib/Apache/App.pm	Sun Sep  3 18:57:14 2006
@@ -0,0 +1,141 @@
+
+#############################################################################
+## $Id: App.pm 3666 2006-03-11 20:34:10Z spadkins $
+#############################################################################
+
+package Apache::App;
+$VERSION = (q$Revision: 3666 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn
+
+use Apache ();
+use App;
+
+my %env = %ENV;
+my $context;
+
+sub handler {
+    my $r = shift;
+
+    if ($ENV{PATH_INFO} eq "/_info") {
+        &info($r);
+        return;
+    }
+
+    my ($msg, $response);
+
+    # INITIALIZE THE CONTEXT THE FIRST TIME THIS APACHE CHILD PROCESS
+    # RECEIVES A REQUEST (should I do this sooner? at child init?)
+    # (so that the first request does not need to bear the extra burden)
+
+    # Also, the App class would cache the $context for me
+    # if I didn't want to cache it myself. But then I would have to 
+    # prepare the %options every request. hmmm...
+    # I don't suppose the $r->dir_config() call is expensive.
+
+    if (!defined $context) {
+        my %options = %{$r->dir_config()};
+        $options{context_class} = "App::Context::ModPerl" if (!defined $options{context_class});
+        eval {
+            $context = App->context(\%options);
+        };
+        $msg = $@ if ($@);
+    }
+
+    if ($ENV{PATH_INFO} eq "/_context") {
+        my $header = <<EOF;
+Content-type: text/plain
+
+App::Context::ModPerl - Context
+
+EOF
+        $r->print($header);
+        $r->print($context->dump());
+        return;
+    }
+    elsif ($ENV{PATH_INFO} eq "/_session") {
+        my $header = <<EOF;
+Content-type: text/plain
+
+App::Context::ModPerl - Session
+
+EOF
+        $r->print($header);
+        $r->print($context->{session}->dump());
+        return;
+    }
+    elsif ($ENV{PATH_INFO} eq "/_conf") {
+        my $header = <<EOF;
+Content-type: text/plain
+
+App::Context::ModPerl - Conf
+
+EOF
+        $r->print($header);
+        $r->print($context->{conf}->dump());
+        return;
+    }
+    elsif ($ENV{PATH_INFO} eq "/_options") {
+        my $header = <<EOF;
+Content-type: text/plain
+
+App::Context::ModPerl - Options
+
+EOF
+        $r->print($header);
+        my $options = $context->{options} || {};
+        foreach (sort keys %$options) {
+            $r->print("$key = $options->{$key}\n");
+        }
+        return;
+    }
+
+    # this should always be true
+    if (defined $context) {
+        # the response will be emitted from within dispatch_events()
+        $context->dispatch_events();
+    }
+    else {
+        # we had an error (maybe App-Context not installed? Perl @INC not set?)
+        $response = <<EOF;
+Content-type: text/plain
+
+Unable to create an App::Context.
+$msg
+
+EOF
+        $r->print($response);
+    }
+}
+
+sub info {
+    my $r = shift;
+    my $header = <<EOF;
+Content-type: text/plain
+
+Welcome to Apache::App
+
+EOF
+    $r->print($header);
+    print $r->as_string();
+    $r->print("\n");
+    $r->print("ENVIRONMENT VARIABLES\n");
+    $r->print("\n");
+    foreach my $var (sort keys %ENV) {
+        $r->print("$var=$ENV{$var}\n");
+    }
+    $r->print("\n");
+    $r->print("ENVIRONMENT VARIABLES (at startup)\n");
+    $r->print("\n");
+    foreach my $var (sort keys %env) {
+        $r->print("$var=$env{$var}\n");
+    }
+    $r->print("\n");
+    $r->print("DIRECTORY CONFIG\n");
+    $r->print("\n");
+    my %options = %{$r->dir_config()};
+    foreach my $var (sort keys %options) {
+        $r->print("$var=$options{$var}\n");
+    }
+}
+
+1;
+