From: Tomas Doran <bobtfish@bobtfish.net>
Date: Mon, 31 Jan 2011 09:16:11 +0000 (+0000)
Subject: Fix Engine::Stomp with psgi
X-Git-Tag: 5.89001~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=1e5dad0099d51c919670c0e765615937b0fd4dae

Fix Engine::Stomp with psgi
---

diff --git a/Changes b/Changes
index fa94b38..a121d40 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+ - Fixed Catalyst::Engine::Stomp
+ - Fixed issues auto-loading engine with older scripts.
+
 5.89000 2011-01-24 09:28:45 (TRIAL release)
 
  This is a development release from psgi branch of Catalyst-Runtime.
diff --git a/TODO b/TODO
index 03a4674..218cbda 100644
--- a/TODO
+++ b/TODO
@@ -35,7 +35,7 @@ http://github.com/willert/catalyst-plugin-log4perl-simple/tree
   * Add some tests for Catalyst::Test::local_request
   * Docs
   * Test all the options work on all of the scripts
-  * Test (and fix if needed) Engine::Stomp and ::Wx
+  * Test (and fix if needed) ::Wx
   * Document how to use your own .psgi (and how you need to do ReverseProxy yourself if you do)
   * Document migration for setting engine in setup
   * Document migration for setting engine in $ENV
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 1d598dd..3fc68c3 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -30,6 +30,7 @@ use Class::C3::Adopt::NEXT;
 use List::MoreUtils qw/uniq/;
 use attributes;
 use String::RewritePrefix;
+use Catalyst::Engine::Loader;
 use utf8;
 use Carp qw/croak carp shortmess/;
 use Try::Tiny;
@@ -70,11 +71,10 @@ our $GO        = Catalyst::Exception::Go->new;
 #maybe we should just make them attributes with a default?
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
-  engine_class context_class request_class response_class stats_class
+  engine_loader context_class request_class response_class stats_class
   setup_finished _psgi_app/;
 
 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
-__PACKAGE__->engine_class('Catalyst::Engine');
 __PACKAGE__->request_class('Catalyst::Request');
 __PACKAGE__->response_class('Catalyst::Response');
 __PACKAGE__->stats_class('Catalyst::Stats');
@@ -2589,20 +2589,26 @@ Sets up engine.
 
 =cut
 
+sub engine_class {
+    my $class = shift;
+    $class->engine_loader->catalyst_engine_class(@_);
+}
+
 sub setup_engine {
     my ($class) = @_;
 
+    $class->engine_loader(Catalyst::Engine::Loader->new(application_name => $class));
+
     my $engine = $class->engine_class;
     Class::MOP::load_class($engine);
 
     if ($ENV{MOD_PERL}) {
-        require 'Catalyst/Engine/Loader.pm';
-        my $apache = Catalyst::Engine::Loader->auto;
+        my $apache = $class->engine_loader->auto;
         # FIXME - Immutable
         $class->meta->add_method(handler => sub {
             my $r = shift;
-            my $app = $class->psgi_app;
-            $apache->call_app($r, $app);
+            my $psgi_app = $class->psgi_app;
+            $apache->call_app($r, $psgi_app);
         });
     }
 
diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 407ceb5..16895f3 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -791,10 +791,11 @@ sub run {
 
     # FIXME - we should stash the options in an attribute so that custom args
     # like Gitalist's --git_dir are possible to get from the app without stupid tricks.
-    my $server = pop @args if blessed $args[-1];
-    my $options = pop @args if ref($args[-1]) eq 'HASH';
+    my $server = pop @args if (scalar @args && blessed $args[-1]);
+    my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH');
     if (! $server ) {
-        $server = Catalyst::Engine::Loader->auto(); # We're not being called from a script,
+        $server = Catalyst::Engine::Loader->new(application_name => ref($self))->auto();
+        # We're not being called from a script,
                                                     # so auto detect what backend to run on.
                                                     # This should never happen, as mod_perl
                                                     # never calls ->run, instead the $app->handle
diff --git a/lib/Catalyst/Engine/Loader.pm b/lib/Catalyst/Engine/Loader.pm
index 0b81933..5ac028f 100644
--- a/lib/Catalyst/Engine/Loader.pm
+++ b/lib/Catalyst/Engine/Loader.pm
@@ -12,6 +12,27 @@ has application_name => (
     required => 1,
 );
 
+has catalyst_engine_class => (
+    isa => 'Str',
+    is => 'rw',
+    lazy => 1,
+    builder => '_guess_catalyst_engine_class',
+);
+
+sub _guess_catalyst_engine_class {
+    my $self = shift;
+    my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE');
+    if (!defined $old_engine) {
+        return 'Catalyst::Engine';
+    }
+    elsif ($old_engine =~ /^(CGI|FCGI|HTTP|Apache.*)$/) {
+        return 'Catalyst::Engine';
+    }
+    elsif (my ($type) = $old_engine =~ /^(Stomp|Test::MessageDriven|Wx)$/) {
+        return 'Catalyst::Engine::' . $type;
+    }
+}
+
 around guess => sub {
     my ($orig, $self) = (shift, shift);
     my $engine = $self->$orig(@_);