use Plack::Util;
use Class::Load 'load_class';
use Encode 2.21 'decode_utf8', 'encode_utf8';
+use Scalar::Util;
+use Ref::Util qw(is_plain_arrayref is_plain_coderef is_plain_hashref is_plain_scalarref is_regexpref);
BEGIN { require 5.008003; }
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,
);
\%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,
);
};
}
+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 || [] }; }
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.90114';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub import {
Catalyst - The Elegant MVC Web Application Framework
+=for html
+<a href="https://badge.fury.io/pl/Catalyst-Runtime"><img src="https://badge.fury.io/pl/Catalyst-Runtime.svg" alt="CPAN version" height="18"></a>
+<a href="https://travis-ci.org/perl-catalyst/catalyst-runtime/"><img src="https://api.travis-ci.org/perl-catalyst/catalyst-runtime.png" alt="Catalyst></a>
+<a href="http://cpants.cpanauthors.org/dist/Catalyst-Runtime"><img src="http://cpants.cpanauthors.org/dist/Catalyst-Runtime.png" alt='Kwalitee Score' /></a>
+
=head1 SYNOPSIS
See the L<Catalyst::Manual> distribution for comprehensive
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)->(@_);
}
sub error {
my $c = shift;
if ( $_[0] ) {
- my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
+ my $error = is_plain_arrayref($_[0]) ? $_[0] : [@_];
croak @$error unless ref $c;
push @{ $c->{error} }, @$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
=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
-nothing if there are nomore errors.
+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;
}
# undef for a name will return all
return keys %eligible if !defined $name;
- my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
+ my $query = is_regexpref($name) ? $name : qr/^$name$/i;
my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
return @result if @result;
# if we were given a regexp to search against, we're done.
- return if $name->$_isa('Regexp');
+ return if is_regexpref($name);
# skip regexp fallback if configured
return
}
# Filter a component before returning by calling ACCEPT_CONTEXT if available
+
sub _filter_component {
my ( $c, $comp, @args ) = @_;
+ if(is_plain_coderef($comp)) {
+ $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;
}
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
+ unless ( is_regexpref($name) ) { # Direct component hash lookup to avoid costly regexps
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;
$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
my ( $c, $name, @args ) = @_;
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
+ unless ( is_regexpref($name) ) { # Direct component hash lookup to avoid costly regexps
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;
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
+ unless ( is_regexpref($name) ) { # Direct component hash lookup to avoid costly regexps
my $comps = $c->components;
my $check = $appclass."::View::".$name;
if( exists $comps->{$check} ) {
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;
=head2 encoding
-Sets or gets the application encoding.
+Sets or gets the application encoding. Setting encoding takes either an
+Encoding object or a string that we try to resolve via L<Encode::find_encoding>.
+
+You would expect to get the encoding object back if you attempt to set it. If
+there is a failure you will get undef returned and an error message in the log.
=cut
if(blessed $c) {
$c->encoding(undef);
} else {
- $c->debug->error("You can't clear encoding on the application");
+ $c->log->error("You can't clear encoding on the application");
}
}
my $encoding;
if ( scalar @_ ) {
+
+ # Don't let one change this once we are too far into the response
+ if(blessed $c && $c->res->finalized_headers) {
+ Carp::croak("You may not change the encoding once the headers are finalized");
+ return;
+ }
+
# Let it be set to undef
if (my $wanted = shift) {
$encoding = Encode::find_encoding($wanted)
}
my @middleware = map {
- ref $_ eq 'CODE' ?
+ is_plain_coderef($_) ?
"Inline Coderef" :
(ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
|| '') } $class->registered_middlewares;
: $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';
$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)
$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<URI> object based on the application root, the
provided path, and the additional arguments and query parameters provided.
C<< $c->request->base >>; any C<@args> are appended as additional path
components; and any C<%query_values> are appended as C<?foo=bar> parameters.
+B<NOTE> 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<Catalyst::Action> 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
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 {
$path .= '/';
}
- undef($path) if (defined $path && $path eq '');
+ my $fragment = ((scalar(@args) && is_plain_scalarref($args[-1])) ? pop @args : undef );
- my $params =
- ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
-
- carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
-
- 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;
+ 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 && is_plain_hashref($args[$#args]) ? pop @args : {} );
+
+ undef($path) if (defined $path && $path eq '');
+
+ 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 && is_plain_arrayref($args[0])
+ ? @{ 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;
+ }
+
+ 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);
+ $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!^/+!!;
}
my $query = '';
-
if (my @keys = keys %$params) {
# somewhat lifted from URI::_query's query_form
$query = '?'.join('&', map {
$key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
$key =~ s/ /+/g;
- "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
+ "${key}=$param"; } ( is_plain_arrayref($val) ? @$val : $val ));
} @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;
}
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();
}
$c->error($error);
}
- $c->state(0);
+ #$c->state(0);
}
return $c->state;
}
=head2 $c->finalize_encoding
Make sure your body is encoded properly IF you set an encoding. By
-default the encoding is UTF-8 but you can disable it by explictly setting the
+default the encoding is UTF-8 but you can disable it by explicitly setting the
encoding configuration value to undef.
We can only encode when the body is a scalar. Methods for encoding via the
if(
($res->encodable_response) and
(defined($res->body)) and
- (ref(\$res->body) eq 'SCALAR')
+ (is_plain_scalarref(\$res->body))
) {
$c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
# 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));
}
}
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 );
}
# 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..
# 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;
+ $c->{stash} = $c->stash;
+ Scalar::Util::weaken($c->{stash});
return $c;
}
for my $key ( sort keys %$params ) {
my $param = $params->{$key};
my $value = defined($param) ? $param : '';
- $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
+ $t->row( $key, is_plain_arrayref($value) ? ( join ', ', @$value ) : $value );
}
$c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
}
);
for my $key ( sort keys %$uploads ) {
my $upload = $uploads->{$key};
- for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
+ for my $u ( is_plain_arrayref($upload) ? @{$upload} : ($upload) ) {
$t->row( $key, $u->filename, $u->type, $u->size );
}
}
Returns or sets the request class. Defaults to L<Catalyst::Request>.
+=head2 $app->request_class_traits
+
+An arrayref of L<Moose::Role>s 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<CatalystX::RoleApplicator> 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<Catalyst::Response>.
+=head2 $app->response_class_traits
+
+An arrayref of L<Moose::Role>s 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<CatalystX::RoleApplicator> 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
}
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
+ is_plain_coderef($class->components->{$component_name});
}
}
+=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 L<Moose::Role>s 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
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;
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
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);
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<Catalyst> 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
Please B<NOTE> that if you do use C<using_frontend_proxy> the middleware is now
adding via C<registered_middleware> rather than this method.
-If you are using Lighttp or IIS6 you may wish to apply these middlewares. In
+If you are using Lighttpd or IIS6 you may wish to apply these middlewares. In
general this is no longer a common case but we have this here for backward
compatibility.
not attempt to return a valid L<PSGI> application using any existing C<${myapp}.psgi>
scripts in your $HOME directory.
-B<NOTE> C<apply_default_middlewares> was orginally created when the first PSGI
+B<NOTE> C<apply_default_middlewares> was originally created when the first PSGI
port was done for v5.90000. These are middlewares that are added to achieve
backward compatibility with older applications. If you start your application
using one of the supplied server scripts (generated with L<Catalyst::Devel> and
=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;
+ }
+
+<B>NOTE:</b> 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
return unless defined $value;
## I think this mess is to support the old nested
- if ( ref $value eq 'ARRAY' ) {
+ if ( is_plain_arrayref($value) ) {
foreach ( @$value ) {
$_ = $self->_handle_unicode_decoding($_);
}
return $value;
}
- elsif ( ref $value eq 'HASH' ) {
+ elsif ( is_plain_hashref($value) ) {
foreach (keys %$value) {
my $encoded_key = $self->_handle_param_unicode_decoding($_);
$value->{$encoded_key} = $self->_handle_unicode_decoding($value->{$_});
}
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',
@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 = ();
if(ref $next) {
if(Scalar::Util::blessed $next && $next->can('wrap')) {
push @middleware, $next;
- } elsif(ref $next eq 'CODE') {
+ } elsif(is_plain_coderef($next)) {
push @middleware, $next;
- } elsif(ref $next eq 'HASH') {
+ } elsif(is_plain_hashref($next)) {
my $namespace = shift @middleware_definitions;
my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
push @middleware, $mw;
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') ,$@);
},
};
Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
+=head2 $app->stats_class_traits
+
+A arrayref of L<Moose::Role>s 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<CatalystX::RoleApplicator> which previously provided
+these features in a stand alone package.
+
=head2 $c->use_stats
Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
=item *
+C<skip_complex_post_part_handling>
+
+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<Catalyst::Request::PartData>. If this causes
+issue for you, you can disable this by setting C<skip_complex_post_part_handling>
+to true (default is false).
+
+=item *
+
+C<skip_body_param_unicode_decoding>
+
+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<encoding> configuration
+parameter) you may disable this step atomically by setting this configuration
+parameter to true.
+
+=item *
+
+C<do_not_decode_query>
+
+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<Catalyst>
+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<default_query_encoding>
+
+=item *
+
+C<do_not_check_query_encoding>
+
+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<default_query_encoding>
+
+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<use_chained_args_0_special_case>
+
+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<psgi_middleware> - See L<PSGI MIDDLEWARE>.
=item *
C<data_handlers> - See L<DATA HANDLERS>.
+=item *
+
+C<stats_class_traits>
+
+An arrayref of L<Moose::Role>s that get composed into your stats class.
+
+=item *
+
+C<request_class_traits>
+
+An arrayref of L<Moose::Role>s that get composed into your request class.
+
+=item *
+
+C<response_class_traits>
+
+An arrayref of L<Moose::Role>s that get composed into your response class.
+
+=item *
+
+C<inject_components>
+
+A Hashref of L<Catalyst::Component> 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<Catalyst> 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
=head1 ENCODING
-On request, decodes all params from encoding into a sequence of
-logical characters. On response, encodes body into encoding.
+Starting in L<Catalyst> version 5.90080 encoding is automatically enabled
+and set to encode all body responses to UTF8 when possible and applicable.
+Following is documentation on this process. If you are using an older
+version of L<Catalyst> you should review documentation for that version since
+a lot has changed.
By default encoding is now 'UTF-8'. You may turn it off by setting
the encoding configuration to undef.
+ MyApp->config(encoding => undef);
+
+This is recommended for temporary backwards compatibility only.
+
Encoding is automatically applied when the content-type is set to
a type that can be encoded. Currently we encode when the content type
matches the following regular expression:
so that you can override it on a request basis.
Be default we don't automatically encode 'application/json' since the most
-popular JSON encoders (such as L<JSON::MaybeXS> which is the library that
-L<Catalyst> can make use of) will do the UTF8 encoding and decoding automatically.
-Having it on in Catalyst could result in double encoding.
+common approaches to generating this type of response (Either via L<Catalyst::View::JSON>
+or L<Catalyst::Action::REST>) will do so already and we want to avoid double
+encoding issues.
If you are producing JSON response in an unconventional manner (such
as via a template or manual strings) you should perform the UTF8 encoding
NOTE: We also examine the value of $c->response->content_encoding. If
you set this (like for example 'gzip', and manually gzipping the body)
-we assume that you have done all the neccessary encoding yourself, since
+we assume that you have done all the necessary encoding yourself, since
we cannot encode the gzipped contents. If you use a plugin like
-L<Catalyst::Plugin::Compress> we will be updating that plugin to work
-with the new UTF8 encoding code, or you can use L<Plack::Middleware::Deflater>
-or (probably best) do your compression on a front end proxy.
+L<Catalyst::Plugin::Compress> you need to update to a modern version in order
+to have this function correctly with the new UTF8 encoding code, or you
+can use L<Plack::Middleware::Deflater> or (probably best) do your compression on
+a front end proxy.
=head2 Methods
abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
+andrewalker: André Walker <andre@cpan.org>
+
Andrew Bramble
Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
chansen: Christian Hansen
+Chase Venters C<chase.venters@gmail.com>
+
chicks: Christopher Hicks
Chisel Wright C<pause@herlpacker.co.uk>