Commit | Line | Data |
b1ededd4 |
1 | package Catalyst::EngineLoader; |
532f0516 |
2 | use Moose; |
3 | use Catalyst::Exception; |
acbecf08 |
4 | use Catalyst::Utils; |
532f0516 |
5 | use namespace::autoclean; |
6 | |
7 | extends 'Plack::Loader'; |
8 | |
acbecf08 |
9 | has application_name => ( |
10 | isa => 'Str', |
11 | is => 'ro', |
12 | required => 1, |
13 | ); |
14 | |
1085c936 |
15 | has compat_options => ( |
16 | traits => ['Hash'], |
17 | is => 'ro', |
18 | isa => 'HashRef', |
19 | default => sub { +{} }, |
20 | handles => { |
21 | has_compat_option => 'exists', |
22 | compat_option => 'get', |
23 | }, |
24 | ); |
25 | |
26 | sub needs_psgi_engine_compat_hack { |
27 | my ($self) = @_; |
28 | return $self->has_compat_option('requested_engine') |
29 | && $self->compat_option('requested_engine') eq 'PSGI'; |
30 | } |
31 | |
1e5dad00 |
32 | has catalyst_engine_class => ( |
33 | isa => 'Str', |
34 | is => 'rw', |
35 | lazy => 1, |
36 | builder => '_guess_catalyst_engine_class', |
37 | ); |
38 | |
39 | sub _guess_catalyst_engine_class { |
40 | my $self = shift; |
41 | my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE'); |
42 | if (!defined $old_engine) { |
43 | return 'Catalyst::Engine'; |
44 | } |
45 | elsif ($old_engine =~ /^(CGI|FCGI|HTTP|Apache.*)$/) { |
46 | return 'Catalyst::Engine'; |
47 | } |
0ea8962d |
48 | else { |
49 | return 'Catalyst::Engine::' . $old_engine; |
1e5dad00 |
50 | } |
51 | } |
52 | |
532f0516 |
53 | around guess => sub { |
54 | my ($orig, $self) = (shift, shift); |
55 | my $engine = $self->$orig(@_); |
56 | if ($engine eq 'Standalone') { |
57 | if ( $ENV{MOD_PERL} ) { |
58 | my ( $software, $version ) = |
d7132282 |
59 | $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; |
532f0516 |
60 | $version =~ s/_//g; |
d7132282 |
61 | $version =~ s/(\.[^.]+)\./$1/g; |
62 | |
532f0516 |
63 | if ( $software eq 'mod_perl' ) { |
64 | if ( $version >= 1.99922 ) { |
65 | $engine = 'Apache2'; |
66 | } |
67 | |
68 | elsif ( $version >= 1.9901 ) { |
69 | Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' ); |
70 | $engine = 'Apache2::MP19'; |
71 | } |
72 | |
73 | elsif ( $version >= 1.24 ) { |
74 | $engine = 'Apache1'; |
75 | } |
76 | |
77 | else { |
78 | Catalyst::Exception->throw( message => |
79 | qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); |
80 | } |
81 | } |
82 | } |
83 | } |
d7132282 |
84 | |
acbecf08 |
85 | my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE'); |
86 | if (!defined $old_engine) { # Not overridden |
87 | } |
88 | elsif ($old_engine =~ /^(CGI|FCGI|HTTP|Apache.*)$/) { |
89 | # Trust autodetect |
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 | |
532f0516 |
105 | return $engine; |
106 | }; |
107 | |
acbecf08 |
108 | # Force constructor inlining |
109 | __PACKAGE__->meta->make_immutable( replace_constructor => 1 ); |
df1fa879 |
110 | |
532f0516 |
111 | 1; |
df1fa879 |
112 | |
113 | __END__ |
114 | |
115 | =head1 NAME |
116 | |
b1ededd4 |
117 | Catalyst::EngineLoader - The Catalyst Engine Loader |
df1fa879 |
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 | |
1085c936 |
137 | =begin Pod::Coverage |
138 | |
139 | needs_psgi_engine_compat_hack |
140 | |
141 | =end Pod::Coverage |
142 | |
df1fa879 |
143 | =cut |