use Moose::Meta::Class ();
extends 'Catalyst::Component';
use Moose::Util qw/find_meta/;
- use bytes;
use B::Hooks::EndOfScope ();
use Catalyst::Exception;
use Catalyst::Exception::Detach;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
use Class::C3::Adopt::NEXT;
+ use List::MoreUtils qw/uniq/;
use attributes;
use utf8;
use Carp qw/croak carp shortmess/;
- BEGIN { require 5.008001; }
+ BEGIN { require 5.008004; }
has stack => (is => 'ro', default => sub { [] });
has stash => (is => 'rw', default => sub { {} });
# Remember to update this in Catalyst::Runtime as well!
- our $VERSION = '5.80007';
+ our $VERSION = '5.80014_02';
{
my $dev_version = $VERSION =~ /_\d{2}$/;
$c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
$c->forward('MyApp::View::TT');
- Note that forward implies an C<<eval { }>> around the call (actually
- C<execute> does), thus de-fatalizing all 'dies' within the called
- action. If you want C<die> to propagate you need to do something like:
+ Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
+ an C<< eval { } >> around the call (actually
+ L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
+ all 'dies' within the called action. If you want C<die> to propagate you
+ need to do something like:
$c->forward('foo');
die $c->error if $c->error;
your code like this:
$c->forward('foo') || return;
+
+ Another note is that C<< $c->forward >> always returns a scalar because it
+ actually returns $c->state which operates in a scalar context.
+ Thus, something like:
+
+ return @array;
+
+ in an action that is forwarded to is going to return a scalar,
+ i.e. how many items are in that array, which is probably not what you want.
+ If you need to return an array then return a reference to it,
+ or stash it like so:
+
+ $c->stash->{array} = \@array;
+
+ and access it from the stash.
=cut
=head2 $c->detach()
- The same as C<forward>, but doesn't return to the previous action when
- processing is finished.
+ The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
+ doesn't return to the previous action when processing is finished.
When called with no arguments it escapes the processing chain entirely.
=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
- Almost the same as C<forward>, but does a full dispatch, instead of just
- calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
- C<auto> and the method you go to are called, just like a new request.
+ Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
+ but does a full dispatch, instead of just calling the new C<$action> /
+ C<< $class->$method >>. This means that C<begin>, C<auto> and the method
+ you go to are called, just like a new request.
In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
- This means, for example, that $c->action methods such as C<name>, C<class> and
- C<reverse> return information for the visited action when they are invoked
- within the visited action. This is different from the behavior of C<forward>
- which continues to use the $c->action object from the caller action even when
+ This means, for example, that C<< $c->action >> methods such as
+ L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
+ L<reverse|Catalyst::Action/reverse> return information for the visited action
+ when they are invoked within the visited action. This is different from the
+ behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
+ continues to use the $c->action object from the caller action even when
invoked from the callee.
- C<$c-E<gt>stash> is kept unchanged.
+ C<< $c->stash >> is kept unchanged.
- In effect, C<visit> allows you to "wrap" another action, just as it
- would have been called by dispatching from a URL, while the analogous
- C<go> allows you to transfer control to another action as if it had
- been reached directly from a URL.
+ In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
+ allows you to "wrap" another action, just as it would have been called by
+ dispatching from a URL, while the analogous
+ L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
+ transfer control to another action as if it had been reached directly from a URL.
=cut
=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
- Almost the same as C<detach>, but does a full dispatch like C<visit>,
- instead of just calling the new C<$action> /
- C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
- method you visit are called, just like a new request.
-
- C<$c-E<gt>stash> is kept unchanged.
+ The relationship between C<go> and
+ L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
+ the relationship between
+ L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
+ L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
+ C<< $c->go >> will perform a full dispatch on the specified action or method,
+ with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
+ C<go> escapes the processing of the current request chain on completion, and
+ does not return to its caller.
=cut
=head2 $c->state
- Contains the return value of the last executed action.
+ 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.
=head2 $c->clear_errors
# if we were given a regexp to search against, we're done.
return if ref $name;
+ # skip regexp fallback if configured
+ return
+ if $appclass->config->{disable_component_resolution_regex_fallback};
+
# regexp fallback
$query = qr/$name/i;
@result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
(join '", "', @result) . "'. Relying on regexp fallback behavior for " .
"component resolution is unreliable and unsafe.";
my $short = $result[0];
- $short =~ s/.*?Model:://;
+ # remove the component namespace prefix
+ $short =~ s/.*?(Model|Controller|View):://;
my $shortmess = Carp::shortmess('');
if ($shortmess =~ m#Catalyst/Plugin#) {
$msg .= " You probably need to set '$short' instead of '${name}' in this " .
$msg .= " You probably need to set '$short' instead of '${name}' in this " .
"component's config";
} else {
- $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
+ $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
"but if you really wanted to search, pass in a regexp as the argument " .
"like so: \$c->${warn_for}(qr/${name}/)";
}
sub model {
my ( $c, $name, @args ) = @_;
-
+ my $appclass = ref($c) || $c;
if( $name ) {
my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
return $c->model( $c->stash->{current_model} )
if $c->stash->{current_model};
}
- return $c->model( $c->config->{default_model} )
- if $c->config->{default_model};
+ return $c->model( $appclass->config->{default_model} )
+ if $appclass->config->{default_model};
my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
if( $rest ) {
$c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
- $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
+ $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
$c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
$c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
$c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
sub view {
my ( $c, $name, @args ) = @_;
+ my $appclass = ref($c) || $c;
if( $name ) {
my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
return $c->view( $c->stash->{current_view} )
if $c->stash->{current_view};
}
- return $c->view( $c->config->{default_view} )
- if $c->config->{default_view};
+ return $c->view( $appclass->config->{default_view} )
+ if $appclass->config->{default_view};
my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
if( $rest ) {
$c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
- $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
+ $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
$c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
$c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
$c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
If C<$name> is a regexp, a list of components matched against the full
component name will be returned.
+ If Catalyst can't find a component by name, it will fallback to regex
+ matching by default. To disable this behaviour set
+ disable_component_resolution_regex_fallback to a true value.
+
+ __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
+
=cut
sub component {
__PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
- You can also use a C<YAML>, C<XML> or C<Config::General> config file
- like myapp.conf in your applications home directory. See
+ You can also use a C<YAML>, C<XML> or L<Config::General> config file
+ like C<myapp.conf> in your applications home directory. See
L<Catalyst::Plugin::ConfigLoader>.
- =head3 Cascading configuration.
+ =head3 Cascading configuration
The config method is present on all Catalyst components, and configuration
will be merged when an application is started. Configuration loaded with
Merges C<@path> with C<< $c->config->{home} >> and returns a
L<Path::Class::Dir> object. Note you can usually use this object as
a filename, but sometimes you will have to explicitly stringify it
- yourself by calling the C<<->stringify>> method.
+ yourself by calling the C<< ->stringify >> method.
For example:
my $name = $class->config->{name} || 'Application';
$class->log->info("$name powered by Catalyst $Catalyst::VERSION");
}
- $class->log->_flush() if $class->log->can('_flush');
# Make sure that the application class becomes immutable at this point,
B::Hooks::EndOfScope::on_scope_end {
. "Class::Accessor(::Fast)?\nPlease pass "
. "(replace_constructor => 1)\nwhen making your class immutable.\n";
}
- $meta->make_immutable(replace_constructor => 1)
- unless $meta->is_immutable;
+ $meta->make_immutable(
+ replace_constructor => 1,
+ ) unless $meta->is_immutable;
};
+ if ($class->config->{case_sensitive}) {
+ $class->log->warn($class . "->config->{case_sensitive} is set.");
+ $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
+ }
+
$class->setup_finalize;
+ # Should be the last thing we do so that user things hooking
+ # setup_finalize can log..
+ $class->log->_flush() if $class->log->can('_flush');
+ return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
}
$class->setup_finished(1);
}
- =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
-
- =head2 $c->uri_for( $path, @args?, \%query_values? )
-
- =over
-
- =item $action
-
- A Catalyst::Action object representing the Catalyst action you want to
- create a URI for. To get one for an action in the current controller,
- use C<< $c->action('someactionname') >>. To get one from different
- controller, fetch the controller using C<< $c->controller() >>, then
- call C<action_for> on it.
+ =head2 $c->uri_for( $path?, @args?, \%query_values? )
- You can maintain the arguments captured by an action (e.g.: Regex, Chained)
- using C<< $c->req->captures >>.
+ =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
- # For the current action
- $c->uri_for($c->action, $c->req->captures);
+ 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.
+
+ If no arguments are provided, the URI for the current action is returned.
+ To return the current action and also provide @args, use
+ C<< $c->uri_for( $c->action, @args ) >>.
+
+ If the first argument is a string, it is taken as a public URI path relative
+ to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
+ 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<?foo=bar> parameters.
+
+ 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
+ variables that are needed to fill in the paths of Chained and Regex actions;
+ once the path is resolved, C<uri_for> continues as though a path was
+ provided, appending any arguments or parameters and creating an absolute
+ URI.
+
+ The captures for the current request can be found in
+ C<< $c->request->captures >>, and actions can be resolved using
+ C<< Catalyst::Controller->action_for($name) >>. If you have a private action
+ path, use C<< $c->uri_for_action >> instead.
+
+ # Equivalent to $c->req->uri
+ $c->uri_for($c->action, $c->req->captures,
+ @{ $c->req->args }, $c->req->params);
# For the Foo action in the Bar controller
- $c->uri_for($c->controller('Bar')->action_for('Foo'), $c->req->captures);
+ $c->uri_for($c->controller('Bar')->action_for('Foo'));
- =back
+ # Path to a static resource
+ $c->uri_for('/static/images/logo.png');
=cut
sub uri_for {
my ( $c, $path, @args ) = @_;
+ if (blessed($path) && $path->isa('Catalyst::Controller')) {
+ $path = $path->path_prefix;
+ $path =~ s{/+\z}{};
+ $path .= '/';
+ }
+
if ( blessed($path) ) { # action object
- my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
- ? shift(@args)
- : [] );
+ my $captures = [ map { s|/|%2F|; $_; }
+ ( scalar @args && ref $args[0] eq 'ARRAY'
+ ? @{ shift(@args) }
+ : ()) ];
my $action = $path;
$path = $c->dispatcher->uri_for_action($action, $captures);
if (not defined $path) {
carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
+ s|/|%2F| for @args;
unshift(@args, $path);
sub _stats_start_execute {
my ( $c, $code ) = @_;
-
+ my $appclass = ref($c) || $c;
return if ( ( $code->name =~ /^_.*/ )
- && ( !$c->config->{show_internal_actions} ) );
+ && ( !$appclass->config->{show_internal_actions} ) );
my $action_name = $code->reverse();
$c->counter->{$action_name}++;
# is this a root-level call or a forwarded call?
if ( $callsub =~ /forward$/ ) {
+ my $parent = $c->stack->[-1];
# forward, locate the caller
- if ( my $parent = $c->stack->[-1] ) {
+ if ( exists $c->counter->{"$parent"} ) {
$c->stats->profile(
begin => $action,
parent => "$parent" . $c->counter->{"$parent"},
$c->stats->profile( end => $info );
}
- =head2 $c->_localize_fields( sub { }, \%keys );
-
- =cut
-
- #Why does this exist? This is no longer safe and WILL NOT WORK.
- # it doesnt seem to be used anywhere. can we remove it?
- sub _localize_fields {
- my ( $c, $localized, $code ) = ( @_ );
-
- my $request = delete $localized->{request} || {};
- my $response = delete $localized->{response} || {};
-
- local @{ $c }{ keys %$localized } = values %$localized;
- local @{ $c->request }{ keys %$request } = values %$request;
- local @{ $c->response }{ keys %$response } = values %$response;
-
- $code->();
- }
-
=head2 $c->finalize
Finalizes the request.
$c->finalize_body;
}
+ $c->log_response;
+
if ($c->use_stats) {
my $elapsed = sprintf '%f', $c->stats->elapsed;
my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
}
else {
# everything should be bytes at this point, but just in case
- $response->content_length( bytes::length( $response->body ) );
+ $response->content_length( length( $response->body ) );
}
}
$c->prepare_read;
# Parse the body unless the user wants it on-demand
- unless ( $c->config->{parse_on_demand} ) {
+ unless ( ref($c)->config->{parse_on_demand} ) {
$c->prepare_body;
}
}
$path = '/' unless length $path;
my $address = $c->req->address || '';
- $c->log->debug(qq/"$method" request for "$path" from "$address"/)
- if $c->debug;
+ $c->log_request;
$c->prepare_action;
$c->engine->prepare_body( $c, @_ );
$c->prepare_parameters;
$c->prepare_uploads;
-
- if ( $c->debug && keys %{ $c->req->body_parameters } ) {
- my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
- for my $key ( sort keys %{ $c->req->body_parameters } ) {
- my $param = $c->req->body_parameters->{$key};
- my $value = defined($param) ? $param : '';
- $t->row( $key,
- ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
- }
- $c->log->debug( "Body Parameters are:\n" . $t->draw );
- }
}
=head2 $c->prepare_body_chunk( $chunk )
my $c = shift;
$c->engine->prepare_query_parameters( $c, @_ );
+}
- if ( $c->debug && keys %{ $c->request->query_parameters } ) {
- my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
- for my $key ( sort keys %{ $c->req->query_parameters } ) {
- my $param = $c->req->query_parameters->{$key};
- my $value = defined($param) ? $param : '';
- $t->row( $key,
- ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
+=head2 $c->apply_parameter_debug_filters($params)
+
+=cut
+
+sub _apply_parameter_debug_filters {
+ my $c = shift;
+ my $type = shift;
+ my $params = shift;
+
+ # take a copy since we don't want to modify the original
+ my $filtered_params = {%$params};
+
+ my @filters;
+
+ my $filter_param_config = $c->config->{Debug}->{param_filters};
+ if ( ref($filter_param_config) eq 'HASH' ) {
+
+ # filters broken out by parameter type (i.e. body, query, all)
+ my $type_filters = $filter_param_config->{$type} || [];
+ $type_filters = [$type_filters] if ref $type_filters ne 'ARRAY';
+
+ my $all_filters = $filter_param_config->{'all'} || [];
+ $all_filters = [$all_filters] if ref $all_filters ne 'ARRAY';
+
+ @filters = $c->_normalize_debug_filters( [ @$type_filters, @$all_filters ] );
+ } elsif ($filter_param_config) {
+ @filters = $c->_normalize_debug_filters($filter_param_config);
+ }
+
+ # allow callback to modify each parameter
+ foreach my $k ( keys %$filtered_params ) {
+
+ # apply filters to each param
+ foreach my $f (@filters) {
+
+ # take a copy of the key to avoid the callback inadvertantly
+ # modifying things
+ my $copy_key = $k;
+
+ my $returned = $f->( $copy_key => $filtered_params->{$k} );
+
+ if ( defined $returned ) {
+
+ # if no value is returned, we assume the filter chose not to modify anything
+ # otherwise, the returned value is the logged value
+ $filtered_params->{$k} = $returned;
+
+ last; # skip the rest of the filters since this one matched
+ }
}
- $c->log->debug( "Query Parameters are:\n" . $t->draw );
}
+ return $filtered_params;
}
-=head2 $c->prepare_read
+# turn debug filters into a list of CodeRef's
+sub _normalize_debug_filters {
+ my $c = shift;
-Prepares the input for reading.
+ my @filters = ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] } : grep { defined $_ } @_;
-=cut
+ my @normalized = map { _make_filter_callback($_) } @filters;
-sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
+ return @normalized;
+}
-=head2 $c->prepare_request
+sub _make_filter_callback {
+ my $filter = shift;
-Prepares the engine request.
+ my $filter_str = '[FILTERED]';
+ if ( ref($filter) eq 'Regexp' ) {
+ return sub { return $_[0] =~ $filter ? $filter_str : undef };
+ } elsif ( ref($filter) eq 'CODE' ) {
+ return $filter;
+ } else {
+ return sub { return $_[0] eq $filter ? $filter_str : undef };
+ }
+}
+
+=head2 $c->log_request
+
+Writes information about the request to the debug logs. This includes:
+
+=over 4
+
+=item * Request method, path, and remote IP address
+
+=item * Query keywords (see L<Catalyst::Request/query_keywords>)
+
+=item * Request parameters (see L</log_request_parameters>)
+
+=item * File uploads
+
+=back
=cut
-sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
+sub log_request {
+ my $c = shift;
-=head2 $c->prepare_uploads
+ return unless $c->debug;
-Prepares uploads.
+ my ( $method, $path, $address ) = ( $c->req->method, $c->req->path, $c->req->address );
+ $method ||= '';
+ $path = '/' unless length $path;
+ $address ||= '';
+ $c->log->debug(qq/"$method" request for "$path" from "$address"/);
+
+ if ( my $keywords = $c->req->query_keywords ) {
+ $c->log->debug("Query keywords are: $keywords");
+ }
+
+ $c->log_request_parameters( query => $c->req->query_parameters, body => $c->req->body_parameters );
+
+ $c->log_request_uploads;
+}
+
+=head2 $c->log_response
+
+Writes information about the response to the debug logs. This includes:
+
+=over 4
+
+=item * Response status code
+
+=item * Response headers (see L</log_headers>)
+
+=back
+
+This logging is not enabled by default. To enable it, you must set a flag in your Catalyst config:
+
+ __PACKAGE__->config( Debug => { log_response => 1 } );
=cut
-sub prepare_uploads {
+sub log_response {
my $c = shift;
- $c->engine->prepare_uploads( $c, @_ );
+ return unless $c->debug && $c->config->{Debug}->{log_response};
+
+ $c->log->debug('Response Status: ' . $c->response->status);
+ $c->log_headers('response', $c->response->headers);
+}
+
+=head2 $c->log_request_parameters( query => {}, body => {} )
+
+Logs request parameters to debug logs
+
+If you have sensitive data that you do not want written to the Catalyst
+debug logs, you can set options in your config to filter those values out.
+There are a few different ways you can set these up depending on what
+exactly you need to filter.
+
+=head3 Filtering parameters by name
+
+The most basic means of filtering is to add an entry into your config
+as shown below. You can have a simple scalar to just filter a
+single parameter or an ARRAY ref to filter out multiple params.
+
+ # filters a single param
+ __PACKAGE__->config( Debug => { param_filters => 'param_name' } );
+
+ # filters multiple params
+ __PACKAGE__->config( Debug => { param_filters => [qw(param1 param2)] } );
+
+When the debug logs are generated for a given request, any parameters
+(query or body) that exactly match the specified value(s) will have
+their values replaced with '[FILTERED]'. For instance:
+
+ [debug] Query Parameters are:
+ .-------------------------------------+--------------------------------------.
+ | Parameter | Value |
+ +-------------------------------------+--------------------------------------+
+ | password | [FILTERED] |
+ .-------------------------------------+--------------------------------------.
+
+=head3 Filtering parameters by regular expression
+
+If you have a set of parameters you need to filter, you can specify a
+regular expression that will be used to match against parameter names.
+
+ # filters parameters starting with "private."
+ __PACKAGE__->config( Debug => { param_filters => qr/^private\./ } );
- if ( $c->debug && keys %{ $c->request->uploads } ) {
+ # filters parameters named "param1" or starting with "private." or "secret."
+ __PACKAGE__->config( Debug => { param_filters => [ 'param1', qr/^private\./, qr/^secret\./ ] } );
+
+Notice on the second example, the arrayref contains a string as well
+as two regular expressions. This should DWIM and filter parameters that
+match any of the filters specified.
+
+=head3 Filtering parameters by callback
+
+If you want even more flexible filtering, you can specify an anonymous
+subroutine. The subroutine is given the parameter name and value and
+is expected to return the new value that will be shown in the debug log.
+An C<undef> return value indicates that no change should be made to
+the value.
+
+ # transform any "password" param to "********"
+ __PACKAGE__->config(
+ Debug => {
+ param_filters => sub { my ( $k, $v ) = @_; return unless $k eq 'password'; return '*' x 8; }
+ }
+ );
+
+ # combine several param filtering methods
+ __PACKAGE__->config(
+ Debug => {
+ param_filters => [
+ 'simple_param_name',
+ qr/^private\./,
+ sub { my ( $k, $v ) = @_; return unless $k eq 'password'; return '*' x 8; },
+ ]
+ }
+ );
+
+An example of the debug log for a request with
+C<password=secret&some_other_param=some_other_value> would be:
+
+ [debug] Body Parameters are:
+ .-------------------------------------+--------------------------------------.
+ | Parameter | Value |
+ +-------------------------------------+--------------------------------------+
+ | some_other_param | some_other_value |
+ | password | ******** |
+ .-------------------------------------+--------------------------------------.
+
+=head3 Filtering by parameter location
+
+If you have different filters that depend on whether a param was passed
+as a query or body param (or as either), you can specify a hashref with
+different sets of filters:
+
+ # filters all body parameters
+ __PACKAGE__->config( Debug => { param_filters => { body => qr// } } );
+
+ # filters query parameters starting with 'private'.
+ __PACKAGE__->config( Debug => { param_filters => { query => qr/^private\./ } } );
+
+ # filters all parameters (query or body) through the specified callback
+ __PACKAGE__->config(
+ Debug => {
+ param_filters => {
+ all => sub { return unless $_[0] eq 'fizzbuzz'; return 'FIZZBUZZ FILTER' }
+ }
+ }
+ );
+
+Of course, you can use any of the above filtering methods with these
+"location-specific" filters:
+
+ # body parameter filters
+ __PACKAGE__->config(
+ Debug => {
+ param_filters => {
+ body => [
+ 'some_param',
+ qr/^private\./,
+ sub { return 'XXX' if shift eq 'other_param' }
+ ]
+ }
+ }
+ );
+
+ # query parameter filters
+ __PACKAGE__->config(
+ Debug => {
+ param_filters => {
+ body => [
+ 'some_param',
+ qr/^private\./,
+ sub { return 'XXX' if shift eq 'other_param' }
+ ]
+ }
+ }
+ );
+
+ # query parameter filters
+ __PACKAGE__->config( Debug => { param_filters => { all => [qw(foo bar)] } } );
+
+=cut
+
+sub log_request_parameters {
+ my $c = shift;
+ my %all_params = @_;
+
+ my $column_width = Catalyst::Utils::term_width() - 44;
+ foreach my $type (qw(query body)) {
+ my $filtered_params = $c->_apply_parameter_debug_filters( $type, $all_params{$type} || {} );
+ next unless keys %$filtered_params;
+ my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
+ for my $key ( sort keys %$filtered_params ) {
+ my $param = $filtered_params->{$key};
+ my $value = defined($param) ? $param : '';
+ $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
+ }
+ $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
+ }
+}
+
+=head2 $c->log_request_uploads
+
+Logs file uploads included in the request to the debug logs.
+The parameter name, filename, file type, and file size are all included in
+the debug logs.
+
+=cut
+
+sub log_request_uploads {
+ my $c = shift;
+ my $uploads = $c->req->uploads;
+ if ( keys %$uploads ) {
my $t = Text::SimpleTable->new(
[ 12, 'Parameter' ],
[ 26, 'Filename' ],
[ 18, 'Type' ],
[ 9, 'Size' ]
);
- for my $key ( sort keys %{ $c->request->uploads } ) {
- my $upload = $c->request->uploads->{$key};
+ for my $key ( sort keys %$uploads ) {
+ my $upload = $uploads->{$key};
for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
$t->row( $key, $u->filename, $u->type, $u->size );
}
}
}
+=head2 $c->log_headers($type => $headers)
+
+Writes HTTP::Headers to debug logs, applying filters as configured.
+
+Similarly to how L</log_request_parameters> is configured, you can
+configure Catalyst to filter response header values to avoid writing
+sensitive data to your logs (e.g. cookie values, etc.). The configuration
+works in virtually the same way as the examples in
+L</log_request_parameters>. Here are a few specific examples:
+
+ # filters all "Set-Cookie" headers from response logging
+ __PACKAGE__->config(Debug => { response_header_filters => 'Set-Cookie' } );
+
+ # filters only the value of the cookie (and leaves the name, path, expiration)
+ __PACKAGE__->config(
+ Debug => {
+ response_header_filters => sub {
+ my ( $n, $v ) = @_;
+ return unless $n eq 'Set-Cookie';
+ $v =~ s/^.*?;//;
+ return $v;
+ },
+ }
+ );
+
+=cut
+
+sub log_headers {
+ my $c = shift;
+ my $type = shift;
+ my $headers = shift; # an HTTP::Headers instance
+
+ my $filtered = $c->_apply_header_debug_filters( $type, $headers );
+
+ my $t = Text::SimpleTable->new( [ 35, 'Header Name' ], [ 40, 'Value' ] );
+ $filtered->scan(
+ sub {
+ my ( $name, $value ) = @_;
+ $t->row( $name, $value );
+ }
+ );
+ $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
+}
+
+# Applies debug filters to $headers and returns a new HTTP::Headers object which has (potentially) filtered values.
+sub _apply_header_debug_filters {
+ my $c = shift;
+ my $type = shift;
+ my $headers = shift;
+
+ my @header_filters = $c->_normalize_debug_filters( $c->config->{Debug}->{ $type . '_header_filters' } );
+ my $filtered_headers = HTTP::Headers->new();
+ foreach my $name ( $headers->header_field_names ) {
+ my @values = $headers->header($name);
+
+ # headers can be multi-valued
+ foreach my $value (@values) {
+ foreach my $f (@header_filters) {
+ my $new_value = $f->( $name, $value );
+
+ # if a defined value is returned, we use that
+ if ( defined $new_value ) {
+ $value = $new_value;
+ last; # skip the rest of the filters
+ }
+ }
+ $filtered_headers->push_header( $name, $value );
+ }
+ }
+ return $filtered_headers;
+}
+
+=head2 $c->prepare_read
+
+Prepares the input for reading.
+
+=cut
+
+sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
+
+=head2 $c->prepare_request
+
+Prepares the engine request.
+
+=cut
+
+sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
+
+=head2 $c->prepare_uploads
+
+Prepares uploads.
+
+=cut
+
+sub prepare_uploads {
+ my $c = shift;
+
+ $c->engine->prepare_uploads( $c, @_ );
+}
+
=head2 $c->prepare_write
Prepares the output for writing.
be used in a while loop, reading C<$maxlength> bytes on every call.
C<$maxlength> defaults to the size of the request if not specified.
- You have to set C<< MyApp->config->{parse_on_demand} >> to use this
+ You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
directly.
Warning: If you use read(), Catalyst will not process the body,
=head2 $c->setup_components
- Sets up components. Specify a C<setup_components> config option to pass
- additional options directly to L<Module::Pluggable>. To add additional
- search paths, specify a key named C<search_extra> as an array
- reference. Items in the array beginning with C<::> will have the
- application class name prepended to them.
+ This method is called internally to set up the application's components.
+
+ It finds modules by calling the L<locate_components> method, expands them to
+ package names with the L<expand_component_module> method, and then installs
+ each component into the application.
- All components found will also have any
- L<Devel::InnerPackage|inner packages> loaded and set up as components.
- Note, that modules which are B<not> an I<inner package> of the main
- file namespace loaded will not be instantiated as components.
+ The C<setup_components> config option is passed to both of the above methods.
+
+ Installation of each component is performed by the L<setup_component> method,
+ below.
=cut
sub setup_components {
my $class = shift;
- my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
my $config = $class->config->{ setup_components };
- my $extra = delete $config->{ search_extra } || [];
-
- push @paths, @$extra;
-
- my $locator = Module::Pluggable::Object->new(
- search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
- %$config
- );
- my @comps = sort { length $a <=> length $b } $locator->plugins;
+ my @comps = sort { length $a <=> length $b }
+ $class->locate_components($config);
my %comps = map { $_ => 1 } @comps;
- my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
+ my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
$class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
- ) if $deprecated_component_names;
+ ) if $deprecatedcatalyst_component_names;
for my $component ( @comps ) {
# we know M::P::O found a file on disk so this is safe
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
- #Class::MOP::load_class($component);
-
- my $module = $class->setup_component( $component );
- my %modules = (
- $component => $module,
- map {
- $_ => $class->setup_component( $_ )
- } grep {
- not exists $comps{$_}
- } Devel::InnerPackage::list_packages( $component )
- );
- for my $key ( keys %modules ) {
- $class->components->{ $key } = $modules{ $key };
+ # Needs to be done as soon as the component is loaded, as loading a sub-component
+ # (next time round the loop) can cause us to get the wrong metaclass..
+ $class->_controller_init_base_classes($component);
+ }
+
+ for my $component (@comps) {
+ $class->components->{ $component } = $class->setup_component($component);
+ for my $component ($class->expand_component_module( $component, $config )) {
+ next if $comps{$component};
+ $class->_controller_init_base_classes($component); # Also cover inner packages
+ $class->components->{ $component } = $class->setup_component($component);
}
}
}
+ =head2 $c->locate_components( $setup_component_config )
+
+ This method is meant to provide a list of component modules that should be
+ setup for the application. By default, it will use L<Module::Pluggable>.
+
+ Specify a C<setup_components> config option to pass additional options directly
+ to L<Module::Pluggable>. To add additional search paths, specify a key named
+ C<search_extra> as an array reference. Items in the array beginning with C<::>
+ will have the application class name prepended to them.
+
+ =cut
+
+ sub locate_components {
+ my $class = shift;
+ my $config = shift;
+
+ my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
+ my $extra = delete $config->{ search_extra } || [];
+
+ push @paths, @$extra;
+
+ my $locator = Module::Pluggable::Object->new(
+ search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
+ %$config
+ );
+
+ my @comps = $locator->plugins;
+
+ return @comps;
+ }
+
+ =head2 $c->expand_component_module( $component, $setup_component_config )
+
+ Components found by C<locate_components> will be passed to this method, which
+ is expected to return a list of component (package) names to be set up.
+
+ =cut
+
+ sub expand_component_module {
+ my ($class, $module) = @_;
+ return Devel::InnerPackage::list_packages( $module );
+ }
+
=head2 $c->setup_component
=cut
+ # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
+ # nearest to Catalyst::Controller first, no matter what order stuff happens
+ # to be loaded. There are TODO tests in Moose for this, see
+ # f2391d17574eff81d911b97be15ea51080500003
sub _controller_init_base_classes {
my ($app_class, $component) = @_;
+ return unless $component->isa('Catalyst::Controller');
foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
Moose::Meta::Class->initialize( $class )
unless find_meta($class);
return $component;
}
- # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
- # nearest to Catalyst::Controller first, no matter what order stuff happens
- # to be loaded. There are TODO tests in Moose for this, see
- # f2391d17574eff81d911b97be15ea51080500003
- if ($component->isa('Catalyst::Controller')) {
- $class->_controller_init_base_classes($component);
- }
-
my $suffix = Catalyst::Utils::class2classsuffix( $component );
my $config = $class->config->{ $suffix } || {};
+ # 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 ); };
my $class = ref $proto || $proto;
Class::MOP::load_class( $plugin );
-
+ $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is decated and will not work in 5.81" )
+ if $plugin->isa( 'Catalyst::Component' );
$proto->_plugins->{$plugin} = 1;
unless ($instant) {
no strict 'refs';
sub version { return $Catalyst::VERSION }
- =head1 INTERNAL ACTIONS
+ =head1 CONFIGURATION
- Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
- C<_ACTION>, and C<_END>. These are by default not shown in the private
- action table, but you can make them visible with a config parameter.
+ There are a number of 'base' config variables which can be set:
+
+ =over
+
+ =item *
+
+ C<default_model> - The default model picked if you say C<< $c->model >>. See L</$c->model($name)>.
+
+ =item *
+
+ C<default_view> - The default view to be rendered or returned when C<< $c->view >>. See L</$c->view($name)>.
+ is called.
+
+ =item *
+
+ C<disable_component_resolution_regex_fallback> - Turns
+ off the deprecated component resolution functionality so
+ that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
+ are called then regex search will not be attempted on string values and
+ instead C<undef> will be returned.
+
+ =item *
+
+ C<home> - The application home directory. In an uninstalled application,
+ this is the top level application directory. In an installed application,
+ this will be the directory containing C<< MyApp.pm >>.
+
+ =item *
+
+ C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
+
+ =item *
+
+ C<name> - The name of the application in debug messages and the debug and
+ welcome screens
+
+ =item *
+
+ C<parse_on_demand> - The request body (for example file uploads) will not be parsed
+ until it is accessed. This allows you to (for example) check authentication (and reject
+ the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
+
+ =item *
+
+ C<root> - The root directory for templates. Usually this is just a
+ subdirectory of the home directory, but you can set it to change the
+ templates to a different directory.
+
+ =item *
- MyApp->config->{show_internal_actions} = 1;
+ C<search_extra> - Array reference passed to Module::Pluggable to for additional
+ namespaces from which components will be loaded (and constructed and stored in
+ C<< $c->components >>).
- =head1 CASE SENSITIVITY
+ =item *
- By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
- mapped to C</foo/bar>. You can activate case sensitivity with a config
- parameter.
+ C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
+ to be shown in hit debug tables in the test server.
- MyApp->config->{case_sensitive} = 1;
+ =item *
- This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
+ C<using_frontend_proxy> - See L</PROXY SUPPORT>.
+
+ =back
+
+ =head1 INTERNAL ACTIONS
+
+ Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
+ C<_ACTION>, and C<_END>. These are by default not shown in the private
+ action table, but you can make them visible with a config parameter.
+
+ MyApp->config(show_internal_actions => 1);
=head1 ON-DEMAND PARSER
but if you want to handle input yourself, you can enable on-demand
parsing with a config parameter.
- MyApp->config->{parse_on_demand} = 1;
+ MyApp->config(parse_on_demand => 1);
=head1 PROXY SUPPORT
The host value for $c->req->base and $c->req->uri is set to the real
host, as read from the HTTP X-Forwarded-Host header.
+ Additionally, you may be running your backend application on an insecure
+ connection (port 80) while your frontend proxy is running under SSL. If there
+ is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
+ tell Catalyst what port the frontend listens on. This will allow all URIs to
+ be created properly.
+
+ In the case of passing in:
+
+ X-Forwarded-Port: 443
+
+ All calls to C<uri_for> will result in an https link, as is expected.
+
Obviously, your web server must support these headers for this to work.
In a more complex server farm environment where you may have your
configuration option to tell Catalyst to read the proxied data from the
headers.
- MyApp->config->{using_frontend_proxy} = 1;
+ MyApp->config(using_frontend_proxy => 1);
If you do not wish to use the proxy support at all, you may set:
- MyApp->config->{ignore_frontend_proxy} = 1;
+ MyApp->config(ignore_frontend_proxy => 1);
=head1 THREAD SAFETY
=head2 L<Catalyst::Manual> - The Catalyst Manual
- =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
+ =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
=head2 L<Catalyst::Engine> - Core engine
acme: Leon Brocard <leon@astray.com>
+ abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
+
Andrew Bramble
- Andrew Ford
+ Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
Andrew Ruthven
chicks: Christopher Hicks
+ Chisel Wright C<pause@herlpacker.co.uk>
+
+ Danijel Milicevic C<me@danijel.de>
+
+ David Kamholz E<lt>dkamholz@cpan.orgE<gt>
+
+ David Naughton, C<naughton@umn.edu>
+
David E. Wheeler
+ dhoss: Devin Austin <dhoss@cpan.org>
+
dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
Drew Taylor
fireartist: Carl Franks <cfranks@cpan.org>
+ frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
+
gabb: Danijel Milicevic
Gary Ashton Jones
+ Gavin Henry C<ghenry@perl.me.uk>
+
Geoff Richards
+ groditi: Guillermo Roditi <groditi@gmail.com>
+
+ hobbs: Andrew Rodland <andrew@cleverdomain.org>
+
ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
jcamacho: Juan Camacho
+ jester: Jesse Sheidlower C<jester@panix.com>
+
jhannah: Jay Hannah <jay@jays.net>
Jody Belka
jon: Jon Schutz <jjschutz@cpan.org>
+ Jonathan Rockway C<< <jrockway@cpan.org> >>
+
+ Kieren Diment C<kd@totaldatasolution.com>
+
+ konobi: Scott McWhirter <konobi@cpan.org>
+
marcus: Marcus Ramberg <mramberg@cpan.org>
miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
random: Roland Lammel <lammel@cpan.org>
- sky: Arthur Bergman
+ Robert Sedlacek C<< <rs@474.at> >>
- the_jester: Jesse Sheidlower
+ sky: Arthur Bergman
t0m: Tomas Doran <bobtfish@bobtfish.net>
Ulf Edvinsson
+ Viljo Marrandi C<vilts@yahoo.com>
+
+ Will Hawes C<info@whawes.co.uk>
+
willert: Sebastian Willert <willert@cpan.org>
+ Yuval Kogman, C<nothingmuch@woobling.org>
+
=head1 LICENSE
This library is free software. You can redistribute it and/or modify it under
projects / catagits/Catalyst-Runtime.git / commitdiff