X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=e68e18cb3f92738bfa7dd59c75052c9fcb8c332c;hb=refs%2Ftags%2F5.90112;hp=bc54ac726aa11f48cbe77f75d531842deb42a05c;hpb=70005e986f12f433f81595e35c902358487b7869;p=catagits%2FCatalyst-Runtime.git
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index bc54ac7..e68e18c 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -63,7 +63,9 @@ has request => (
is => 'rw',
default => sub {
my $self = shift;
- $self->request_class->new($self->_build_request_constructor_args);
+ my $class = ref $self;
+ my $composed_request_class = $class->composed_request_class;
+ return $composed_request_class->new( $self->_build_request_constructor_args);
},
lazy => 1,
);
@@ -77,11 +79,38 @@ sub _build_request_constructor_args {
\%p;
}
+sub composed_request_class {
+ my $class = shift;
+ return $class->_composed_request_class if $class->_composed_request_class;
+
+ my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]});
+
+ # For each trait listed, figure out what the namespace is. First we try the $trait
+ # as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try
+ # Catalyst::TraitFor::Request::$trait. If none load, throw error.
+
+ my $trait_ns = 'TraitFor::Request';
+ my @normalized_traits = map {
+ Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+ } @traits;
+
+ if ($class->debug && scalar(@normalized_traits)) {
+ my $column_width = Catalyst::Utils::term_width() - 6;
+ my $t = Text::SimpleTable->new($column_width);
+ $t->row($_) for @normalized_traits;
+ $class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" );
+ }
+
+ return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits));
+}
+
has response => (
is => 'rw',
default => sub {
my $self = shift;
- $self->response_class->new($self->_build_response_constructor_args);
+ my $class = ref $self;
+ my $composed_response_class = $class->composed_response_class;
+ return $composed_response_class->new( $self->_build_response_constructor_args);
},
lazy => 1,
);
@@ -92,6 +121,27 @@ sub _build_response_constructor_args {
};
}
+sub composed_response_class {
+ my $class = shift;
+ return $class->_composed_response_class if $class->_composed_response_class;
+
+ my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]});
+
+ my $trait_ns = 'TraitFor::Response';
+ my @normalized_traits = map {
+ Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+ } @traits;
+
+ if ($class->debug && scalar(@normalized_traits)) {
+ my $column_width = Catalyst::Utils::term_width() - 6;
+ my $t = Text::SimpleTable->new($column_width);
+ $t->row($_) for @normalized_traits;
+ $class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" );
+ }
+
+ return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits));
+}
+
has namespace => (is => 'rw');
sub depth { scalar @{ shift->stack || [] }; }
@@ -114,22 +164,47 @@ our $RECURSION = 1000;
our $DETACH = Catalyst::Exception::Detach->new;
our $GO = Catalyst::Exception::Go->new;
-#I imagine that very few of these really need to be class variables. if any.
+#I imagine that very few of these really
+#need to be class variables. if any.
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
engine_loader context_class request_class response_class stats_class
setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
- _data_handlers _encoding _encode_check/;
+ _data_handlers _encoding _encode_check finalized_default_middleware
+ request_class_traits response_class_traits stats_class_traits
+ _composed_request_class _composed_response_class _composed_stats_class/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
__PACKAGE__->stats_class('Catalyst::Stats');
+
+sub composed_stats_class {
+ my $class = shift;
+ return $class->_composed_stats_class if $class->_composed_stats_class;
+
+ my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]});
+
+ my $trait_ns = 'TraitFor::Stats';
+ my @normalized_traits = map {
+ Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+ } @traits;
+
+ if ($class->debug && scalar(@normalized_traits)) {
+ my $column_width = Catalyst::Utils::term_width() - 6;
+ my $t = Text::SimpleTable->new($column_width);
+ $t->row($_) for @normalized_traits;
+ $class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" );
+ }
+
+ return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits));
+}
+
__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90079_006';
+our $VERSION = '5.90112';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub import {
@@ -171,6 +246,11 @@ sub _application { $_[0] }
Catalyst - The Elegant MVC Web Application Framework
+=for html
+
+
+
=head1 SYNOPSIS
See the L distribution for comprehensive
@@ -514,6 +594,7 @@ t/middleware-stash.t in the distribution /t directory.
sub stash {
my $c = shift;
+ $c->log->error("You are requesting the stash but you don't have a context") unless blessed $c;
return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
}
@@ -549,13 +630,17 @@ sub error {
return $c->{error} || [];
}
-
=head2 $c->state
Contains the return value of the last executed action.
Note that << $c->state >> operates in a scalar context which means that all
values it returns are scalar.
+Please note that if an action throws an exception, the value of state
+should no longer be considered the return if the last action. It is generally
+going to be 0, which indicates an error state. Examine $c->error for error
+details.
+
=head2 $c->clear_errors
Clear errors. You probably don't want to clear the errors unless you are
@@ -583,22 +668,42 @@ sub has_errors { scalar(@{shift->error}) ? 1:0 }
=head2 $c->last_error
Returns the most recent error in the stack (the one most recently added...)
-or nothing if there are no errors.
+or nothing if there are no errors. This does not modify the contents of the
+error stack.
=cut
-sub last_error { my ($err, @errs) = @{shift->error}; return $err }
+sub last_error {
+ my (@errs) = @{shift->error};
+ return scalar(@errs) ? $errs[-1]: undef;
+}
=head2 shift_errors
-shifts the most recently added error off the error stack and returns if. Returns
+shifts the most recently added error off the error stack and returns it. Returns
nothing if there are no more errors.
=cut
sub shift_errors {
my ($self) = @_;
- my ($err, @errors) = @{$self->error};
+ my @errors = @{$self->error};
+ my $err = shift(@errors);
+ $self->{error} = \@errors;
+ return $err;
+}
+
+=head2 pop_errors
+
+pops the most recently added error off the error stack and returns it. Returns
+nothing if there are no more errors.
+
+=cut
+
+sub pop_errors {
+ my ($self) = @_;
+ my @errors = @{$self->error};
+ my $err = pop(@errors);
$self->{error} = \@errors;
return $err;
}
@@ -685,13 +790,20 @@ sub _comp_names {
}
# Filter a component before returning by calling ACCEPT_CONTEXT if available
+
sub _filter_component {
my ( $c, $comp, @args ) = @_;
+ if(ref $comp eq 'CODE') {
+ $comp = $comp->();
+ }
+
if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
- return $comp->ACCEPT_CONTEXT( $c, @args );
+ return $comp->ACCEPT_CONTEXT( $c, @args );
}
+ $c->log->warn("You called component '${\$comp->catalyst_component_name}' with arguments [@args], but this component does not ACCEPT_CONTEXT, so args are ignored.") if scalar(@args) && $c->debug;
+
return $comp;
}
@@ -723,6 +835,11 @@ sub controller {
my $comps = $c->components;
my $check = $appclass."::Controller::".$name;
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+ next unless $path =~ /.*::Controller/;
+ $check = $path."::".$name;
+ return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ }
}
my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -738,7 +855,8 @@ Gets a L instance by name.
$c->model('Foo')->do_stuff;
-Any extra arguments are directly passed to ACCEPT_CONTEXT.
+Any extra arguments are directly passed to ACCEPT_CONTEXT, if the model
+defines ACCEPT_CONTEXT. If it does not, the args are discarded.
If the name is omitted, it will look for
- a model object in $c->stash->{current_model_instance}, then
@@ -761,6 +879,11 @@ sub model {
my $comps = $c->components;
my $check = $appclass."::Model::".$name;
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+ next unless $path =~ /.*::Model/;
+ $check = $path."::".$name;
+ return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ }
}
my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -825,6 +948,11 @@ sub view {
else {
$c->log->warn( "Attempted to use view '$check', but does not exist" );
}
+ foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+ next unless $path =~ /.*::View/;
+ $check = $path."::".$name;
+ return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ }
}
my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -1342,6 +1470,7 @@ EOF
: $class->log->debug(q/Couldn't find home/);
my $column_width = Catalyst::Utils::term_width() - 8 - 9;
+
my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
for my $comp ( sort keys %{ $class->components } ) {
my $type = ref $class->components->{$comp} ? 'instance' : 'class';
@@ -1368,6 +1497,11 @@ EOF
$class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
}
+ # call these so we pre setup the composed classes
+ $class->composed_request_class;
+ $class->composed_response_class;
+ $class->composed_stats_class;
+
$class->setup_finalize;
# Flush the log for good measure (in case something turned off 'autoflush' early)
@@ -1398,11 +1532,11 @@ sub setup_finalize {
$class->setup_finished(1);
}
-=head2 $c->uri_for( $path?, @args?, \%query_values? )
+=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? )
-=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
+=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? )
-=head2 $c->uri_for( $action, [@captures, @args], \%query_values? )
+=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? )
Constructs an absolute L object based on the application root, the
provided path, and the additional arguments and query parameters provided.
@@ -1420,6 +1554,15 @@ relative to the application root (if it does). It is then merged with
C<< $c->request->base >>; any C<@args> are appended as additional path
components; and any C<%query_values> are appended as C parameters.
+B If you are using this 'stringy' first argument, we skip encoding and
+allow you to declare something like:
+
+ $c->uri_for('/foo/bar#baz')
+
+Where 'baz' is a URI fragment. We consider this first argument string to be
+'expert' mode where you are expected to create a valid URL and we for the most
+part just pass it through without a lot of internal effort to escape and encode.
+
If the first argument is a L it represents an action which
will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
optional C<\@captures> argument (an arrayref) allows passing the captured
@@ -1447,6 +1590,10 @@ In general the scheme of the generated URI object will follow the incoming reque
however if your targeted action or action chain has the Scheme attribute it will
use that instead.
+Also, if the targeted Action or Action chain declares Args/CaptureArgs that have
+type constraints, we will require that your proposed URL verify on those declared
+constraints.
+
=cut
sub uri_for {
@@ -1458,67 +1605,79 @@ sub uri_for {
$path .= '/';
}
- undef($path) if (defined $path && $path eq '');
+ my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
+
+ unless(blessed $path) {
+ if (defined($path) and $path =~ s/#(.+)$//) {
+ if(defined($1) and $fragment) {
+ carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'";
+ }
+ if(defined($1)) {
+ $fragment = $1;
+ }
+ }
+ }
my $params =
( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
- carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
+ undef($path) if (defined $path && $path eq '');
- my @encoded_args = ();
- foreach my $arg (@args) {
- if(ref($arg)||'' eq 'ARRAY') {
- push @encoded_args, [map {
- my $encoded = encode_utf8 $_;
- $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
- $encoded;
- } @$arg];
- } else {
- push @encoded_args, do {
- my $encoded = encode_utf8 $arg;
- $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
- $encoded;
- }
- }
- }
+ carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
if ( $path->$_isa('Catalyst::Action') ) { # action object
- s|/|%2F|g for @encoded_args;
+ s|/|%2F|g for @args;
my $captures = [ map { s|/|%2F|g; $_; }
- ( scalar @encoded_args && ref $encoded_args[0] eq 'ARRAY'
- ? @{ shift(@encoded_args) }
+ ( scalar @args && ref $args[0] eq 'ARRAY'
+ ? @{ shift(@args) }
: ()) ];
my $action = $path;
+ my $expanded_action = $c->dispatcher->expand_action( $action );
+ my $num_captures = $expanded_action->number_of_captures;
+
# ->uri_for( $action, \@captures_and_args, \%query_values? )
- if( !@encoded_args && $action->number_of_args ) {
- my $expanded_action = $c->dispatcher->expand_action( $action );
- my $num_captures = $expanded_action->number_of_captures;
- unshift @encoded_args, splice @$captures, $num_captures;
+ if( !@args && $action->number_of_args ) {
+ unshift @args, splice @$captures, $num_captures;
}
- $path = $c->dispatcher->uri_for_action($action, $captures);
+ if($num_captures) {
+ unless($expanded_action->match_captures_constraints($c, $captures)) {
+ carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'";
+ return;
+ }
+ }
+
+ $path = $c->dispatcher->uri_for_action($action, $captures);
if (not defined $path) {
$c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
if $c->debug;
return undef;
}
$path = '/' if $path eq '';
+
+ # At this point @encoded_args is the remaining Args (all captures removed).
+ if($expanded_action->has_args_constraints) {
+ unless($expanded_action->match_args($c,\@args)) {
+ carp "args [@args] do not match the type constraints in action '$expanded_action'";
+ return;
+ }
+ }
}
- unshift(@encoded_args, $path);
+ unshift(@args, $path);
unless (defined $path && $path =~ s!^/!!) { # in-place strip
my $namespace = $c->namespace;
if (defined $path) { # cheesy hack to handle path '../foo'
- $namespace =~ s{(?:^|/)[^/]+$}{} while $encoded_args[0] =~ s{^\.\./}{};
+ $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
}
- unshift(@encoded_args, $namespace || '');
+ unshift(@args, $namespace || '');
}
# join args with '/', or a blank string
- my $args = join('/', grep { defined($_) } @encoded_args);
+ my $args = join('/', grep { defined($_) } @args);
$args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
$args =~ s!^/+!!;
@@ -1542,7 +1701,6 @@ sub uri_for {
}
my $query = '';
-
if (my @keys = keys %$params) {
# somewhat lifted from URI::_query's query_form
$query = '?'.join('&', map {
@@ -1567,6 +1725,20 @@ sub uri_for {
} @keys);
}
+ $base = encode_utf8 $base;
+ $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
+ $args = encode_utf8 $args;
+ $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
+
+ if(defined $fragment) {
+ if(blessed $path) {
+ $fragment = encode_utf8(${$fragment});
+ $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
+ $fragment =~ s/ /+/g;
+ }
+ $query .= "#$fragment";
+ }
+
my $res = bless(\"${base}${args}${query}", $class);
$res;
}
@@ -1862,7 +2034,7 @@ via $c->error.
sub execute {
my ( $c, $class, $code ) = @_;
$class = $c->component($class) || $class;
- $c->state(0);
+ #$c->state(0);
if ( $c->depth >= $RECURSION ) {
my $action = $code->reverse();
@@ -1914,7 +2086,7 @@ sub execute {
}
$c->error($error);
}
- $c->state(0);
+ #$c->state(0);
}
return $c->state;
}
@@ -2154,9 +2326,10 @@ sub finalize_encoding {
# Set the charset if necessary. This might be a bit bonkers since encodable response
# is false when the set charset is not the same as the encoding mimetype (maybe
# confusing action at a distance here..
- # Don't try to set the charset if one already exists
+ # Don't try to set the charset if one already exists or if headers are already finalized
$c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
- unless($c->res->content_type_charset);
+ unless($c->res->content_type_charset ||
+ ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
}
}
@@ -2260,9 +2433,8 @@ sub prepare {
my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
$c->response->_context($c);
-
- #surely this is not the most efficient way to do things...
$c->stats($class->stats_class->new)->enable($c->use_stats);
+
if ( $c->debug || $c->config->{enable_catalyst_header} ) {
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
@@ -2294,9 +2466,6 @@ sub prepare {
# 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');
# Note we call finalize and then die here, which escapes
# finalize being called in the enclosing block..
# It in fact couldn't be called, as we don't return $c..
@@ -2304,8 +2473,20 @@ sub prepare {
# breaking compat for people doing crazy things (we should set
# the 400 and just return the ctx here IMO, letting finalize get called
# above...
- $c->finalize;
- die $_;
+ if ( $c->_handle_http_exception($_) ) {
+ foreach my $err (@{$c->error}) {
+ $c->log->error($err);
+ }
+ $c->clear_errors;
+ $c->log->_flush if $c->log->can('_flush');
+ $_->can('rethrow') ? $_->rethrow : croak $_;
+ } else {
+ $c->response->status(400);
+ $c->response->content_type('text/plain');
+ $c->response->body('Bad Request');
+ $c->finalize;
+ die $_;
+ }
};
$c->log_request;
@@ -2668,10 +2849,65 @@ sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
Returns or sets the request class. Defaults to L.
+=head2 $app->request_class_traits
+
+An arrayref of Ls which are applied to the request class. You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+ $MyApp::TraitFor::Request::$trait_suffix
+ Catalyst::TraitFor::Request::$trait_suffix
+
+So for example if you set:
+
+ MyApp->request_class_traits(['Foo']);
+
+We try each possible role in turn (and throw an error if none load)
+
+ Foo
+ MyApp::TraitFor::Request::Foo
+ Catalyst::TraitFor::Request::Foo
+
+The namespace part 'TraitFor::Request' was chosen to assist in backwards
+compatibility with L which previously provided
+these features in a stand alone package.
+
+=head2 $app->composed_request_class
+
+This is the request class which has been composed with any request_class_traits.
+
=head2 $c->response_class
Returns or sets the response class. Defaults to L.
+=head2 $app->response_class_traits
+
+An arrayref of Ls which are applied to the response class. You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+ $MyApp::TraitFor::Response::$trait_suffix
+ Catalyst::TraitFor::Response::$trait_suffix
+
+So for example if you set:
+
+ MyApp->response_class_traits(['Foo']);
+
+We try each possible role in turn (and throw an error if none load)
+
+ Foo
+ MyApp::TraitFor::Response::Foo
+ Catalyst::TraitFor::Responset::Foo
+
+The namespace part 'TraitFor::Response' was chosen to assist in backwards
+compatibility with L which previously provided
+these features in a stand alone package.
+
+
+=head2 $app->composed_response_class
+
+This is the request class which has been composed with any response_class_traits.
+
=head2 $c->read( [$maxlength] )
Reads a chunk of data from the request body. This method is designed to
@@ -2780,17 +3016,119 @@ sub setup_components {
}
for my $component (@comps) {
- my $instance = $class->components->{ $component } = $class->setup_component($component);
- my @expanded_components = $instance->can('expand_modules')
- ? $instance->expand_modules( $component, $config )
- : $class->expand_component_module( $component, $config );
- for my $component (@expanded_components) {
- next if $comps{$component};
- $class->components->{ $component } = $class->setup_component($component);
- }
+ my $instance = $class->components->{ $component } = $class->delayed_setup_component($component);
+ }
+
+ # Inject a component or wrap a stand alone class in an adaptor. This makes a list
+ # of named components in the configuration that are not actually existing (not a
+ # real file).
+
+ my @injected = $class->setup_injected_components;
+
+ # All components are registered, now we need to 'init' them.
+ foreach my $component_name (@comps, @injected) {
+ $class->components->{$component_name} = $class->components->{$component_name}->() if
+ (ref($class->components->{$component_name}) || '') eq 'CODE';
}
}
+=head2 $app->setup_injected_components
+
+Called by setup_compoents to setup components that are injected.
+
+=cut
+
+sub setup_injected_components {
+ my ($class) = @_;
+ my @injected_components = keys %{$class->config->{inject_components} ||+{}};
+
+ foreach my $injected_comp_name(@injected_components) {
+ $class->setup_injected_component(
+ $injected_comp_name,
+ $class->config->{inject_components}->{$injected_comp_name});
+ }
+
+ return map { $class ."::" . $_ }
+ @injected_components;
+}
+
+=head2 $app->setup_injected_component( $injected_component_name, $config )
+
+Setup a given injected component.
+
+=cut
+
+sub setup_injected_component {
+ my ($class, $injected_comp_name, $config) = @_;
+ if(my $component_class = $config->{from_component}) {
+ my @roles = @{$config->{roles} ||[]};
+ Catalyst::Utils::inject_component(
+ into => $class,
+ component => $component_class,
+ (scalar(@roles) ? (traits => \@roles) : ()),
+ as => $injected_comp_name);
+ }
+}
+
+=head2 $app->inject_component($MyApp_Component_name => \%args);
+
+Add a component that is injected at setup:
+
+ MyApp->inject_component( 'Model::Foo' => { from_component => 'Common::Foo' } );
+
+Must be called before ->setup. Expects a component name for your
+current application and \%args where
+
+=over 4
+
+=item from_component
+
+The target component being injected into your application
+
+=item roles
+
+An arrayref of Ls that are applied to your component.
+
+=back
+
+Example
+
+ MyApp->inject_component(
+ 'Model::Foo' => {
+ from_component => 'Common::Model::Foo',
+ roles => ['Role1', 'Role2'],
+ });
+
+=head2 $app->inject_components
+
+Inject a list of components:
+
+ MyApp->inject_components(
+ 'Model::FooOne' => {
+ from_component => 'Common::Model::Foo',
+ roles => ['Role1', 'Role2'],
+ },
+ 'Model::FooTwo' => {
+ from_component => 'Common::Model::Foo',
+ roles => ['Role1', 'Role2'],
+ });
+
+=cut
+
+sub inject_component {
+ my ($app, $name, $args) = @_;
+ die "Component $name exists" if
+ $app->config->{inject_components}->{$name};
+ $app->config->{inject_components}->{$name} = $args;
+}
+
+sub inject_components {
+ my $app = shift;
+ while(@_) {
+ $app->inject_component(shift, shift);
+ }
+}
+
=head2 $c->locate_components( $setup_component_config )
This method is meant to provide a list of component modules that should be
@@ -2808,7 +3146,7 @@ sub locate_components {
my $config = shift;
my @paths = qw( ::M ::Model ::V ::View ::C ::Controller );
- my $extra = delete $config->{ search_extra } || [];
+ my $extra = $config->{ search_extra } || [];
unshift @paths, @$extra;
@@ -2832,6 +3170,21 @@ sub expand_component_module {
return Devel::InnerPackage::list_packages( $module );
}
+=head2 $app->delayed_setup_component
+
+Returns a coderef that points to a setup_component instance. Used
+internally for when you want to delay setup until the first time
+the component is called.
+
+=cut
+
+sub delayed_setup_component {
+ my($class, $component, @more) = @_;
+ return sub {
+ return my $instance = $class->setup_component($component, @more);
+ };
+}
+
=head2 $c->setup_component
=cut
@@ -2843,21 +3196,21 @@ sub setup_component {
return $component;
}
- my $suffix = Catalyst::Utils::class2classsuffix( $component );
- my $config = $class->config->{ $suffix } || {};
+ my $config = $class->config_for($component);
# Stash catalyst_component_name in the config here, so that custom COMPONENT
# methods also pass it. local to avoid pointlessly shitting in config
# for the debug screen, as $component is already the key name.
local $config->{catalyst_component_name} = $component;
- my $instance = eval { $component->COMPONENT( $class, $config ); };
-
- if ( my $error = $@ ) {
- chomp $error;
- Catalyst::Exception->throw(
- message => qq/Couldn't instantiate component "$component", "$error"/
- );
- }
+ my $instance = eval {
+ $component->COMPONENT( $class, $config );
+ } || do {
+ my $error = $@;
+ chomp $error;
+ Catalyst::Exception->throw(
+ message => qq/Couldn't instantiate component "$component", "$error"/
+ );
+ };
unless (blessed $instance) {
my $metaclass = Moose::Util::find_meta($component);
@@ -2869,7 +3222,43 @@ sub setup_component {
qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
);
}
- return $instance;
+
+ my @expanded_components = $instance->can('expand_modules')
+ ? $instance->expand_modules( $component, $config )
+ : $class->expand_component_module( $component, $config );
+ for my $component (@expanded_components) {
+ next if $class->components->{ $component };
+ $class->components->{ $component } = $class->setup_component($component);
+ }
+
+ return $instance;
+}
+
+=head2 $app->config_for( $component_name )
+
+Return the application level configuration (which is not yet merged with any
+local component configuration, via $component_class->config) for the named
+component or component object. Example:
+
+ MyApp->config(
+ 'Model::Foo' => { a => 1, b => 2},
+ );
+
+ my $config = MyApp->config_for('MyApp::Model::Foo');
+
+In this case $config is the hashref C< {a=>1, b=>2} >.
+
+This is also handy for looking up configuration for a plugin, to make sure you follow
+existing L standards for where a plugin should put its configuration.
+
+=cut
+
+sub config_for {
+ my ($class, $component_name) = @_;
+ my $component_suffix = Catalyst::Utils::class2classsuffix($component_name);
+ my $config = $class->config->{ $component_suffix } || {};
+
+ return $config;
}
=head2 $c->setup_dispatcher
@@ -3182,15 +3571,44 @@ sub setup_encoding {
=head2 handle_unicode_encoding_exception
-Hook to let you customize how encoding errors are handled. By default
-we just throw an exception. Receives a hashref of debug information.
-Example:
+Hook to let you customize how encoding errors are handled. By default
+we just throw an exception and the default error page will pick it up.
+Receives a hashref of debug information. Example of call (from the
+Catalyst internals):
- $c->handle_unicode_encoding_exception({
+ my $decoded_after_fail = $c->handle_unicode_encoding_exception({
param_value => $value,
error_msg => $_,
- encoding_step => 'params',
- });
+ encoding_step => 'params',
+ });
+
+The calling code expects to receive a decoded string or an exception.
+
+You can override this for custom handling of unicode errors. By
+default we just die. If you want a custom response here, one approach
+is to throw an HTTP style exception, instead of returning a decoded
+string or throwing a generic exception.
+
+ sub handle_unicode_encoding_exception {
+ my ($c, $params) = @_;
+ HTTP::Exception::BAD_REQUEST->throw(status_message=>$params->{error_msg});
+ }
+
+Alternatively you can 'catch' the error, stash it and write handling code later
+in your application:
+
+ sub handle_unicode_encoding_exception {
+ my ($c, $params) = @_;
+ $c->stash(BAD_UNICODE_DATA=>$params);
+ # return a dummy string.
+ return 1;
+ }
+
+NOTE: Please keep in mind that once an error like this occurs,
+the request setup is still ongoing, which means the state of C<$c> and
+related context parts like the request and response may not be setup
+up correctly (since we haven't finished the setup yet). If you throw
+an exception the setup is aborted.
=cut
@@ -3231,15 +3649,20 @@ sub _handle_unicode_decoding {
}
sub _handle_param_unicode_decoding {
- my ( $self, $value ) = @_;
+ my ( $self, $value, $check ) = @_;
return unless defined $value; # not in love with just ignoring undefs - jnap
+ return $value if blessed($value); #don't decode when the value is an object.
my $enc = $self->encoding;
+
+ return $value unless $enc; # don't decode if no encoding is specified
+
+ $check ||= $self->_encode_check;
return try {
- $enc->decode( $value, $self->_encode_check );
+ $enc->decode( $value, $check);
}
catch {
- $self->handle_unicode_encoding_exception({
+ return $self->handle_unicode_encoding_exception({
param_value => $value,
error_msg => $_,
encoding_step => 'params',
@@ -3533,8 +3956,8 @@ sub setup_middleware {
@middleware_definitions = reverse(@_);
} else {
@middleware_definitions = reverse(@{$class->config->{'psgi_middleware'}||[]})
- unless $class->config->{__configured_from_psgi_middleware};
- $class->config->{__configured_from_psgi_middleware} = 1; # Only do this once, just in case some people call setup over and over...
+ unless $class->finalized_default_middleware;
+ $class->finalized_default_middleware(1); # Only do this once, just in case some people call setup over and over...
}
my @middleware = ();
@@ -3632,7 +4055,7 @@ sub default_data_handlers {
return eval {
local $/;
$slurped = $fh->getline;
- $parser->can("decode_json")->($slurped);
+ $parser->can("decode_json")->($slurped); # decode_json does utf8 decoding for us
} || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@);
},
};
@@ -3674,6 +4097,33 @@ by itself.
Returns or sets the stats (timing statistics) class. L is used by default.
+=head2 $app->stats_class_traits
+
+A arrayref of Ls that are applied to the stats_class before creating it.
+
+=head2 $app->composed_stats_class
+
+this is the stats_class composed with any 'stats_class_traits'. You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+ $MyApp::TraitFor::Stats::$trait_suffix
+ Catalyst::TraitFor::Stats::$trait_suffix
+
+So for example if you set:
+
+ MyApp->stats_class_traits(['Foo']);
+
+We try each possible role in turn (and throw an error if none load)
+
+ Foo
+ MyApp::TraitFor::Stats::Foo
+ Catalyst::TraitFor::Stats::Foo
+
+The namespace part 'TraitFor::Stats' was chosen to assist in backwards
+compatibility with L which previously provided
+these features in a stand alone package.
+
=head2 $c->use_stats
Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
@@ -3882,12 +4332,126 @@ backwardly compatible).
=item *
+C
+
+When creating body parameters from a POST, if we run into a multipart POST
+that does not contain uploads, but instead contains inlined complex data
+(very uncommon) we cannot reliably convert that into field => value pairs. So
+instead we create an instance of L. If this causes
+issue for you, you can disable this by setting C
+to true (default is false).
+
+=item *
+
+C
+
+Generally we decode incoming POST params based on your declared encoding (the
+default for this is to decode UTF-8). If this is causing you trouble and you
+do not wish to turn all encoding support off (with the C configuration
+parameter) you may disable this step atomically by setting this configuration
+parameter to true.
+
+=item *
+
+C
+
+If true, then do not try to character decode any wide characters in your
+request URL query or keywords. Most readings of the relevant specifications
+suggest these should be UTF-* encoded, which is the default that L
+will use, however if you are creating a lot of URLs manually or have external
+evil clients, this might cause you trouble. If you find the changes introduced
+in Catalyst version 5.90080+ break some of your query code, you may disable
+the UTF-8 decoding globally using this configuration.
+
+This setting takes precedence over C
+
+=item *
+
+C
+
+Catalyst versions 5.90080 - 5.90106 would decode query parts of an incoming
+request but would not raise an exception when the decoding failed due to
+incorrect unicode. It now does, but if this change is giving you trouble
+you may disable it by setting this configuration to true.
+
+=item *
+
+C
+
+By default we decode query and keywords in your request URL using UTF-8, which
+is our reading of the relevant specifications. This setting allows one to
+specify a fixed value for how to decode your query. You might need this if
+you are doing a lot of custom encoding of your URLs and not using UTF-8.
+
+=item *
+
+C
+
+In older versions of Catalyst, when more than one action matched the same path
+AND all those matching actions declared Args(0), we'd break the tie by choosing
+the first action defined. We now normalized how Args(0) works so that it
+follows the same rule as Args(N), which is to say when we need to break a tie
+we choose the LAST action defined. If this breaks your code and you don't
+have time to update to follow the new normalized approach, you may set this
+value to true and it will globally revert to the original chaining behavior.
+
+=item *
+
C - See L.
=item *
C - See L.
+=item *
+
+C
+
+An arrayref of Ls that get composed into your stats class.
+
+=item *
+
+C
+
+An arrayref of Ls that get composed into your request class.
+
+=item *
+
+C
+
+An arrayref of Ls that get composed into your response class.
+
+=item *
+
+C
+
+A Hashref of L subclasses that are 'injected' into configuration.
+For example:
+
+ MyApp->config({
+ inject_components => {
+ 'Controller::Err' => { from_component => 'Local::Controller::Errors' },
+ 'Model::Zoo' => { from_component => 'Local::Model::Foo' },
+ 'Model::Foo' => { from_component => 'Local::Model::Foo', roles => ['TestRole'] },
+ },
+ 'Controller::Err' => { a => 100, b=>200, namespace=>'error' },
+ 'Model::Zoo' => { a => 2 },
+ 'Model::Foo' => { a => 100 },
+ });
+
+Generally L looks for components in your Model/View or Controller directories.
+However for cases when you which to use an existing component and you don't need any
+customization (where for when you can apply a role to customize it) you may inject those
+components into your application. Please note any configuration should be done 'in the
+normal way', with a key under configuration named after the component affix, as in the
+above example.
+
+Using this type of injection allows you to construct significant amounts of your application
+with only configuration!. This may or may not lead to increased code understanding.
+
+Please not you may also call the ->inject_components application method as well, although
+you must do so BEFORE setup.
+
=back
=head1 EXCEPTIONS
@@ -4316,6 +4880,8 @@ acme: Leon Brocard
abraxxa: Alexander Hartmaier
+andrewalker: André Walker
+
Andrew Bramble
Andrew Ford EA.Ford@ford-mason.co.ukE
@@ -4332,6 +4898,8 @@ Caelum: Rafael Kitover
chansen: Christian Hansen
+Chase Venters C
+
chicks: Christopher Hicks
Chisel Wright C