use Class::C3::Adopt::NEXT;
use List::MoreUtils qw/uniq/;
use attributes;
+use String::RewritePrefix;
+use Catalyst::EngineLoader;
use utf8;
use Carp qw/croak carp shortmess/;
+use Try::Tiny;
+use Plack::Middleware::Conditional;
+use Plack::Middleware::ReverseProxy;
BEGIN { require 5.008004; }
#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
- setup_finished/;
+ engine_loader context_class request_class response_class stats_class
+ setup_finished _psgi_app/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
-__PACKAGE__->engine_class('Catalyst::Engine::CGI');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
__PACKAGE__->stats_class('Catalyst::Stats');
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.80028';
+our $VERSION = '5.89002';
sub import {
my ( $class, @arguments ) = @_;
and access it from the stash.
+Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
+
=cut
sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
my $comps = $c->components;
my $check = $appclass."::View::".$name;
- return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ if( exists $comps->{$check} ) {
+ return $c->_filter_component( $comps->{$check}, @args );
+ }
+ else {
+ $c->log->warn( "Attempted to use view '$check', but does not exist" );
+ }
}
my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
use Moose;
# this attr will receive 'baz' at construction time
- has 'bar' => (
+ has 'bar' => (
is => 'rw',
isa => 'Str',
);
You can then get the value 'baz' by calling $c->model('Foo')->bar
+(or $self->bar inside code in the model).
+
+B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
+as a way of reading config within your code, as this B<will not> give you the
+correctly merged config back. You B<MUST> take the config values supplied to
+the constructor and use those instead.
=cut
$class->setup_log( delete $flags->{log} );
$class->setup_plugins( delete $flags->{plugins} );
$class->setup_dispatcher( delete $flags->{dispatcher} );
- $class->setup_engine( delete $flags->{engine} );
+ if (my $engine = delete $flags->{engine}) {
+ $class->log->warn("Specifying the engine in ->setup is no longer supported, XXX FIXME");
+ }
+ $class->setup_engine();
$class->setup_stats( delete $flags->{stats} );
for my $flag ( sort keys %{$flags} ) {
push( @{ $c->stack }, $code );
no warnings 'recursion';
- eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
+ # N.B. This used to be combined, but I have seen $c get clobbered if so, and
+ # I have no idea how, ergo $ret (which appears to fix the issue)
+ eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
}
# Content-Length
- if ( $response->body && !$response->content_length ) {
+ if ( defined $response->body && length $response->body && !$response->content_length ) {
# get the length from a filehandle
- if ( blessed( $response->body ) && $response->body->can('read') )
+ if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
{
my $stat = stat $response->body;
if ( $stat && $stat->size > 0 ) {
# Always expect worst case!
my $status = -1;
- eval {
+ try {
if ($class->debug) {
my $secs = time - $START || 1;
my $av = sprintf '%.3f', $COUNT / $secs;
my $c = $class->prepare(@arguments);
$c->dispatch;
$status = $c->finalize;
- };
-
- if ( my $error = $@ ) {
- chomp $error;
- $class->log->error(qq/Caught exception in engine "$error"/);
}
+ catch {
+ chomp(my $error = $_);
+ $class->log->error(qq/Caught exception in engine "$error"/);
+ };
$COUNT++;
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
- #XXX reuse coderef from can
- # Allow engine to direct the prepare flow (for POE)
- if ( $c->engine->can('prepare') ) {
- $c->engine->prepare( $c, @arguments );
- }
- else {
- $c->prepare_request(@arguments);
- $c->prepare_connection;
- $c->prepare_query_parameters;
- $c->prepare_headers;
- $c->prepare_cookies;
- $c->prepare_path;
-
- # Prepare the body for reading, either by prepare_body
- # or the user, if they are using $c->read
- $c->prepare_read;
-
- # Parse the body unless the user wants it on-demand
- unless ( ref($c)->config->{parse_on_demand} ) {
- $c->prepare_body;
+ try {
+ # Allow engine to direct the prepare flow (for POE)
+ if ( my $prepare = $c->engine->can('prepare') ) {
+ $c->engine->$prepare( $c, @arguments );
+ }
+ else {
+ $c->prepare_request(@arguments);
+ $c->prepare_connection;
+ $c->prepare_query_parameters;
+ $c->prepare_headers;
+ $c->prepare_cookies;
+ $c->prepare_path;
+
+ # Prepare the body for reading, either by prepare_body
+ # or the user, if they are using $c->read
+ $c->prepare_read;
+
+ # Parse the body unless the user wants it on-demand
+ unless ( ref($c)->config->{parse_on_demand} ) {
+ $c->prepare_body;
+ }
}
}
+ # VERY ugly and probably shouldn't rely on ->finalize actually working
+ catch {
+ # failed prepare is always due to an invalid request, right?
+ $c->response->status(400);
+ $c->response->content_type('text/plain');
+ $c->response->body('Bad Request');
+ $c->finalize;
+ die $_;
+ };
my $method = $c->req->method || '';
my $path = $c->req->path;
=head2 $c->request_class
-Returns or sets the request class.
+Returns or sets the request class. Defaults to L<Catalyst::Request>.
=head2 $c->response_class
-Returns or sets the response class.
+Returns or sets the response class. Defaults to L<Catalyst::Response>.
=head2 $c->read( [$maxlength] )
=cut
-sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
+sub run { my $c = shift; return $c->engine->run( $c, $c->_finalized_psgi_app, @_ ) }
=head2 $c->set_action( $action, $code, $namespace, $attrs )
=cut
+sub engine_class {
+ my $class = shift;
+ $class->engine_loader->catalyst_engine_class(@_);
+}
+
sub setup_engine {
- my ( $class, $engine ) = @_;
+ my ($class) = @_;
- if ($engine) {
- $engine = 'Catalyst::Engine::' . $engine;
- }
+ $class->engine_loader(Catalyst::EngineLoader->new(application_name => $class));
+
+ my $engine = $class->engine_class;
+ Class::MOP::load_class($engine);
- if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
- $engine = 'Catalyst::Engine::' . $env;
+ if ($ENV{MOD_PERL}) {
+ my $apache = $class->engine_loader->auto;
+ # FIXME - Immutable
+ $class->meta->add_method(handler => sub {
+ my $r = shift;
+ my $psgi_app = $class->psgi_app;
+ $apache->call_app($r, $psgi_app);
+ });
}
- if ( $ENV{MOD_PERL} ) {
- my $meta = Class::MOP::get_metaclass_by_name($class);
+ $class->engine( $engine->new );
- # create the apache method
- $meta->add_method('apache' => sub { shift->engine->apache });
+ return;
+}
- my ( $software, $version ) =
- $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
+sub _finalized_psgi_app {
+ my ($app) = @_;
- $version =~ s/_//g;
- $version =~ s/(\.[^.]+)\./$1/g;
+ unless ($app->_psgi_app) {
+ my $psgi_app = $app->_setup_psgi_app;
+ $app->_psgi_app($psgi_app);
+ }
- if ( $software eq 'mod_perl' ) {
+ return $app->_psgi_app;
+}
- if ( !$engine ) {
+sub _setup_psgi_app {
+ my ($app) = @_;
- if ( $version >= 1.99922 ) {
- $engine = 'Catalyst::Engine::Apache2::MP20';
- }
+ if (my $home = Path::Class::Dir->new($app->config->{home})) {
+ my $psgi_file = $home->file(
+ Catalyst::Utils::appprefix($app) . '.psgi',
+ );
- elsif ( $version >= 1.9901 ) {
- $engine = 'Catalyst::Engine::Apache2::MP19';
- }
+ return Plack::Util::load_psgi($psgi_file)
+ if -e $psgi_file;
+ }
- elsif ( $version >= 1.24 ) {
- $engine = 'Catalyst::Engine::Apache::MP13';
- }
+ return $app->_wrapped_legacy_psgi_app($app->psgi_app);
+}
- else {
- Catalyst::Exception->throw( message =>
- qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
- }
+# Note - this is for back compatibility. Catalyst should not know or care about
+# how it's deployed. The recommended way of configuring this is now to
+# use the ReverseProxy middleware yourself if you want it in a .psgi
+# file.
+sub _wrapped_legacy_psgi_app {
+ my ($app, $psgi_app) = @_;
+
+ $psgi_app = Plack::Middleware::Conditional->wrap(
+ $psgi_app,
+ builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
+ condition => sub {
+ my ($env) = @_;
+ return if $app->config->{ignore_frontend_proxy};
+ return $env->{REMOTE_ADDR} eq '127.0.0.1'
+ || $app->config->{using_frontend_proxy};
+ },
+ );
- }
+ # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
+ # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
+ # Thanks to Mark Blythe for this fix
+ #
+ # Note that this has probably the same effect as
+ # Plack::Middleware::LighttpdScriptNameFix and we should switch to that if
+ # we can.
+ $psgi_app = Plack::Middleware::Conditional->wrap(
+ $psgi_app,
+ builder => sub {
+ my ($to_wrap) = @_;
+ return sub {
+ my ($env) = @_;
+ $env->{PATH_INFO} ||= delete $env->{SCRIPT_NAME};
+ return $to_wrap->($env);
+ };
+ },
+ condition => sub {
+ my ($env) = @_;
+ my $server = $env->{SERVER_SOFTWARE};
+ return unless $server;
+ return $server =~ /lighttpd/ ? 1 : 0;
+ },
+ );
- # install the correct mod_perl handler
- if ( $version >= 1.9901 ) {
- *handler = sub : method {
- shift->handle_request(@_);
- };
- }
- else {
- *handler = sub ($$) { shift->handle_request(@_) };
- }
+ $psgi_app = Plack::Middleware::Conditional->wrap(
+ $psgi_app,
+ builder => sub {
+ my ($to_wrap) = @_;
+ return sub {
+ my ($env) = @_;
- }
+ my @script_name = split(m!/!, $env->{PATH_INFO});
+ my @path_translated = split(m!/|\\\\?!, $env->{PATH_TRANSLATED});
+ my @path_info;
- elsif ( $software eq 'Zeus-Perl' ) {
- $engine = 'Catalyst::Engine::Zeus';
- }
+ while ($script_name[$#script_name] eq $path_translated[$#path_translated]) {
+ pop(@path_translated);
+ unshift(@path_info, pop(@script_name));
+ }
- else {
- Catalyst::Exception->throw(
- message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
- }
- }
+ unshift(@path_info, '', '');
- unless ($engine) {
- $engine = $class->engine_class;
- }
+ $env->{PATH_INFO} = join('/', @path_info);
+ $env->{SCRIPT_NAME} = join('/', @script_name);
- Class::MOP::load_class($engine);
+ return $to_wrap->($env);
+ };
+ },
+ condition => sub {
+ my ($env) = @_;
+ my $server = $env->{SERVER_SOFTWARE};
+ return unless $server;
+ return $server =~ /IIS\/[6-9]\.[0-9]/ ? 1 : 0;
+ },
+ );
- # check for old engines that are no longer compatible
- my $old_engine;
- if ( $engine->isa('Catalyst::Engine::Apache')
- && !Catalyst::Engine::Apache->VERSION )
- {
- $old_engine = 1;
- }
+ return $psgi_app;
+}
- elsif ( $engine->isa('Catalyst::Engine::Server::Base')
- && Catalyst::Engine::Server->VERSION le '0.02' )
- {
- $old_engine = 1;
- }
+=head2 $c->psgi_app
- elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
- && $engine->VERSION eq '0.01' )
- {
- $old_engine = 1;
- }
+Returns a PSGI application code reference for the catalyst application
+C<$c>. This is the bare application without any middlewares
+applied. C<${myapp}.psgi> is not taken into account.
- elsif ($engine->isa('Catalyst::Engine::Zeus')
- && $engine->VERSION eq '0.01' )
- {
- $old_engine = 1;
- }
+This is what you want to be using to retrieve the PSGI application code
+reference of your Catalyst application for use in F<.psgi> files.
- if ($old_engine) {
- Catalyst::Exception->throw( message =>
- qq/Engine "$engine" is not supported by this version of Catalyst/
- );
- }
+=cut
- # engine instance
- $class->engine( $engine->new );
+sub psgi_app {
+ my ($app) = @_;
+ return $app->engine->build_psgi_app($app);
}
=head2 $c->setup_home
rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
+dd070: Dhaval Dhanani <dhaval070@gmail.com>
+
=head1 LICENSE
This library is free software. You can redistribute it and/or modify it under
projects / catagits/Catalyst-Runtime.git / blobdiff