From: Tomas Doran <bobtfish@bobtfish.net>
Date: Mon, 24 May 2010 15:44:11 +0000 (+0000)
Subject: Put some of the mod_perl code back. This is pretty much untested and won't work,... 
X-Git-Tag: 5.89000~27
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=532f0516947cf047368e91150ca2ab1cfd4c1e64

Put some of the mod_perl code back. This is pretty much untested and won't work, but is a start
---

diff --git a/Makefile.PL b/Makefile.PL
index af124ca..e69faa3 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -23,6 +23,7 @@ requires 'Data::OptList';
 requires 'Moose' => '1.03';
 requires 'MooseX::MethodAttributes::Inheritable' => '0.19';
 requires 'MooseX::Role::WithOverloading' => '0.05';
+requires 'MooseX::Types::LoadableClass' => '0.003';
 requires 'Carp';
 requires 'Class::C3::Adopt::NEXT' => '0.07';
 requires 'CGI::Simple::Cookie' => '1.109';
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 4714ed6..d864126 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -29,6 +29,7 @@ use Tree::Simple::Visitor::FindByUID;
 use Class::C3::Adopt::NEXT;
 use List::MoreUtils qw/uniq/;
 use attributes;
+use String::RewritePrefix;
 use utf8;
 use Carp qw/croak carp shortmess/;
 use Try::Tiny;
@@ -2552,8 +2553,9 @@ sub setup_engine {
     unless ($engine) {
         $engine = $class->engine_class;
     }
-    $engine = 'Catalyst::Engine::' . $engine
-        unless $engine =~ /^Catalyst::Engine/;
+    else {
+        $engine = String::RewritePrefix->rewrite( { '' => 'Catalyst::Engine::', '+' => '' }, $engine );
+    }
 
     $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP';
 
@@ -2591,6 +2593,11 @@ sub setup_engine {
         );
     }
 
+    if ($ENV{MOD_PERL}) {
+        # FIXME - Immutable
+        $class->meta->add_method(handler => sub { shift->handle_request(@_) });
+    }
+
     $class->engine( $engine->new );
     $class->psgi_app( $class->engine->build_psgi_app($class) );
 }
diff --git a/lib/Catalyst/Engine/Loader.pm b/lib/Catalyst/Engine/Loader.pm
new file mode 100644
index 0000000..bb23841
--- /dev/null
+++ b/lib/Catalyst/Engine/Loader.pm
@@ -0,0 +1,42 @@
+package Catalyst::Engine::Loader;
+use Moose;
+use Catalyst::Exception;
+use namespace::autoclean;
+
+extends 'Plack::Loader';
+
+around guess => sub {
+    my ($orig, $self) = (shift, shift);
+    my $engine = $self->$orig(@_);
+    if ($engine eq 'Standalone') {
+        if ( $ENV{MOD_PERL} ) {
+            my ( $software, $version ) =
+                $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
+
+            $version =~ s/_//g;
+            if ( $software eq 'mod_perl' ) {
+                if ( $version >= 1.99922 ) {
+                    $engine = 'Apache2';
+                }
+
+                elsif ( $version >= 1.9901 ) {
+                    Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' );
+                    $engine = 'Apache2::MP19';
+                }
+
+                elsif ( $version >= 1.24 ) {
+                    $engine = 'Apache1';
+                }
+
+                else {
+                    Catalyst::Exception->throw( message =>
+                          qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
+                }
+            }
+        }
+    }
+    return $engine;
+};
+
+__PACKAGE__->meta->make_immutable( inline_constructor => 0 );
+1;
diff --git a/lib/Catalyst/ScriptRole.pm b/lib/Catalyst/ScriptRole.pm
index 4d93e57..6bea8c1 100644
--- a/lib/Catalyst/ScriptRole.pm
+++ b/lib/Catalyst/ScriptRole.pm
@@ -3,7 +3,8 @@ use Moose::Role;
 use MooseX::Types::Moose qw/Str Bool/;
 use Pod::Usage;
 use MooseX::Getopt;
-use Plack::Loader;
+use Catalyst::Engine::Loader;
+use MooseX::Types::LoadableClass qw/LoadableClass/;
 use namespace::autoclean;
 
 with 'MooseX::Getopt' => {
@@ -29,6 +30,26 @@ has help => (
     cmd_aliases   => ['?', 'h'],
 );
 
+has loader_class => (
+    isa => LoadableClass,
+    is => 'ro',
+    coerce => 1,
+    default => 'Catalyst::Engine::Loader',
+    documentation => 'The class to use to detect and load the PSGI engine',
+);
+
+has _loader => (
+    isa => 'Plack::Loader',
+    default => sub {
+        shift->loader_class->new
+    },
+    handles => {
+        load_engine => 'load',
+        autoload_engine => 'auto',
+    },
+    lazy => 1,
+);
+
 sub _getopt_spec_exception {}
 
 sub _getopt_spec_warnings {
@@ -67,10 +88,10 @@ sub _run_application {
     Class::MOP::load_class($app);
     my $server;
     if (my $e = $self->can('_plack_engine_name') ) {
-        $server = Plack::Loader->load($self->$e, $self->_plack_loader_args);
+        $server = $self->load_engine($self->$e, $self->_plack_loader_args);
     }
     else {
-        $server = Plack::Loader->auto($self->_plack_loader_args);
+        $server = $self->autoload_engine($self->_plack_loader_args);
     }
     $app->run($self->_application_args, $server);
 }