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;
BEGIN { require 5.008004; }
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class stats_class
- setup_finished/;
+ setup_finished psgi_app/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
-__PACKAGE__->engine_class('Catalyst::Engine::CGI');
+__PACKAGE__->engine_class('Catalyst::Engine');
__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.80024';
+our $VERSION = '5.80025';
sub import {
my ( $class, @arguments ) = @_;
For example:
MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
- MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
+ MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
will mean that C<MyApp::Model::Foo> receives the following data when
constructed:
overrides => 'me',
});
+It's common practice to use a Moose attribute
+on the receiving component to access the config value.
+
+ package MyApp::Model::Foo;
+
+ use Moose;
+
+ # this attr will receive 'baz' at construction time
+ has 'bar' => (
+ is => 'rw',
+ isa => 'Str',
+ );
+
+You can then get the value 'baz' by calling $c->model('Foo')->bar
+
=cut
around config => sub {
Constructs an absolute L<URI> object based on the application root, the
provided path, and the additional arguments and query parameters provided.
-When used as a string, provides a textual URI.
+When used as a string, provides a textual URI. If you need more flexibility
+than this (i.e. the option to provide relative URIs etc.) see
+L<Catalyst::Plugin::SmartURI>.
If no arguments are provided, the URI for the current action is returned.
To return the current action and also provide @args, use
# 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;
my $config = $class->config->{ setup_components };
- my @comps = sort { length $a <=> length $b }
- $class->locate_components($config);
+ my @comps = $class->locate_components($config);
my %comps = map { $_ => 1 } @comps;
my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
%$config
);
- my @comps = $locator->plugins;
+ # XXX think about ditching this sort entirely
+ my @comps = sort { length $a <=> length $b } $locator->plugins;
return @comps;
}
=cut
sub setup_engine {
- my ( $class, $engine ) = @_;
-
- if ($engine) {
- $engine = 'Catalyst::Engine::' . $engine;
- }
-
- if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
- $engine = 'Catalyst::Engine::' . $env;
- }
-
- if ( $ENV{MOD_PERL} ) {
- my $meta = Class::MOP::get_metaclass_by_name($class);
-
- # create the apache method
- $meta->add_method('apache' => sub { shift->engine->apache });
-
- my ( $software, $version ) =
- $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
-
- $version =~ s/_//g;
- $version =~ s/(\.[^.]+)\./$1/g;
-
- if ( $software eq 'mod_perl' ) {
-
- if ( !$engine ) {
-
- if ( $version >= 1.99922 ) {
- $engine = 'Catalyst::Engine::Apache2::MP20';
- }
-
- elsif ( $version >= 1.9901 ) {
- $engine = 'Catalyst::Engine::Apache2::MP19';
- }
-
- elsif ( $version >= 1.24 ) {
- $engine = 'Catalyst::Engine::Apache::MP13';
- }
-
- else {
- Catalyst::Exception->throw( message =>
- qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
- }
-
- }
-
- # install the correct mod_perl handler
- if ( $version >= 1.9901 ) {
- *handler = sub : method {
- shift->handle_request(@_);
- };
- }
- else {
- *handler = sub ($$) { shift->handle_request(@_) };
- }
-
- }
-
- elsif ( $software eq 'Zeus-Perl' ) {
- $engine = 'Catalyst::Engine::Zeus';
- }
-
- else {
- Catalyst::Exception->throw(
- message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
- }
- }
+ my ($class, $engine) = @_;
unless ($engine) {
$engine = $class->engine_class;
}
+ else {
+ $engine = String::RewritePrefix->rewrite( { '' => 'Catalyst::Engine::', '+' => '' }, $engine );
+ }
+
+ $engine = 'Catalyst::Engine' if $engine eq 'Catalyst::Engine::HTTP';
Class::MOP::load_class($engine);
);
}
- # engine instance
+ if ($ENV{MOD_PERL}) {
+ require 'Catalyst/Engine/Loader.pm';
+ my $apache = Catalyst::Engine::Loader->auto;
+ # FIXME - Immutable
+ $class->meta->add_method(handler => sub {
+ my $r = shift;
+ my $app = $class->psgi_app;
+ $apache->call_app($r, $app);
+ });
+ }
+
$class->engine( $engine->new );
+ $class->psgi_app( $class->engine->build_psgi_app($class) );
+
}
=head2 $c->setup_home
Yuval Kogman, C<nothingmuch@woobling.org>
+rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
+
=head1 LICENSE
This library is free software. You can redistribute it and/or modify it under
projects / catagits/Catalyst-Runtime.git / blobdiff