lib/Catalyst/EngineLoader.pm

   1 package Catalyst::EngineLoader;
   2 use Moose;
   3 use Catalyst::Exception;
   4 use Catalyst::Utils;
   5 use namespace::autoclean;
   6
   7 extends 'Plack::Loader';
   8
   9 has application_name => (
  10     isa => 'Str',
  11     is => 'ro',
  12     required => 1,
  13 );
  14
  15 has requested_engine => (
  16     is        => 'ro',
  17     isa       => 'Str',
  18     predicate => 'has_requested_engine',
  19 );
  20
  21 sub needs_psgi_engine_compat_hack {
  22     my ($self) = @_;
  23     return $self->has_requested_engine
  24         && $self->requested_engine eq 'PSGI';
  25 }
  26
  27 has catalyst_engine_class => (
  28     isa => 'Str',
  29     is => 'rw',
  30     lazy => 1,
  31     builder => '_guess_catalyst_engine_class',
  32 );
  33
  34 sub _guess_catalyst_engine_class {
  35     my $self = shift;
  36     my $old_engine = $self->has_requested_engine
  37         ? $self->requested_engine
  38         : Catalyst::Utils::env_value($self->application_name, 'ENGINE');
  39     if (!defined $old_engine) {
  40         return 'Catalyst::Engine';
  41     }
  42     elsif ($old_engine =~ /^(PSGI|CGI|FastCGI|HTTP|Apache.*)$/) {
  43         return 'Catalyst::Engine';
  44     }
  45     else {
  46         return 'Catalyst::Engine::' . $old_engine;
  47     }
  48 }
  49
  50 around guess => sub {
  51     my ($orig, $self) = (shift, shift);
  52     my $engine = $self->$orig(@_);
  53     if ($engine eq 'Standalone') {
  54         if ( $ENV{MOD_PERL} ) {
  55             my ( $software, $version ) =
  56               $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
  57             $version =~ s/_//g;
  58             $version =~ s/(\.[^.]+)\./$1/g;
  59
  60             if ( $software eq 'mod_perl' ) {
  61                 if ( $version >= 1.99922 ) {
  62                     $engine = 'Apache2';
  63                 }
  64
  65                 elsif ( $version >= 1.9901 ) {
  66                     Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' );
  67                     $engine = 'Apache2::MP19';
  68                 }
  69
  70                 elsif ( $version >= 1.24 ) {
  71                     $engine = 'Apache1';
  72                 }
  73
  74                 else {
  75                     Catalyst::Exception->throw( message =>
  76                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
  77                 }
  78             }
  79         }
  80     }
  81
  82     my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE');
  83     if (!defined $old_engine) { # Not overridden
  84     }
  85     elsif ($old_engine =~ /^(PSGI|CGI|HTTP|Apache.*)$/) {
  86         # Trust autodetect
  87     }
  88     elsif ($old_engine eq 'FastCGI') {
  89         $engine = 'FCGI';
  90     }
  91     elsif ($old_engine eq "HTTP::Prefork") { # Too bad if you're customising, we don't handle options
  92                                              # write yourself a script to collect and pass in the options
  93         $engine = "Starman";
  94     }
  95     elsif ($old_engine eq "HTTP::POE") {
  96         Catalyst::Exception->throw("HTTP::POE engine no longer works, recommend you use Twiggy instead");
  97     }
  98     elsif ($old_engine eq "Zeus") {
  99         Catalyst::Exception->throw("Zeus engine no longer works");
 100     }
 101     else {
 102         warn("You asked for an unrecognised engine '$old_engine' which is no longer supported, this has been ignored.\n");
 103     }
 104
 105     return $engine;
 106 };
 107
 108 # Force constructor inlining
 109 __PACKAGE__->meta->make_immutable( replace_constructor => 1 );
 110
 111 1;
 112
 113 __END__
 114
 115 =head1 NAME
 116
 117 Catalyst::EngineLoader - The Catalyst Engine Loader
 118
 119 =head1 SYNOPSIS
 120
 121 See L<Catalyst>.
 122
 123 =head1 DESCRIPTION
 124
 125 Wrapper on L<Plack::Loader> which resets the ::Engine if you are using some
 126 version of mod_perl.
 127
 128 =head1 AUTHORS
 129
 130 Catalyst Contributors, see Catalyst.pm
 131
 132 =head1 COPYRIGHT
 133
 134 This library is free software. You can redistribute it and/or modify it under
 135 the same terms as Perl itself.
 136
 137 =begin Pod::Coverage
 138
 139 needs_psgi_engine_compat_hack
 140
 141 =end Pod::Coverage
 142
 143 =cut