X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=3c7dd25f71744dc0f321af2b60e0c411cdc90133;hp=9e74bee39acab3e1d9801775209a27ba731c9603;hb=025d09f99a573f9efde3e001190bb584116ccb32;hpb=cc8a4eb9a08483f5fe80f674d19c612acc12a94d diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 9e74bee..3c7dd25 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -78,12 +78,8 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80014_02'; - -{ - my $dev_version = $VERSION =~ /_\d{2}$/; - *_IS_DEVELOPMENT_VERSION = sub () { $dev_version }; -} +our $VERSION = '5.80021'; +our $PRETTY_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -97,11 +93,6 @@ sub import { my $caller = caller(); return if $caller eq 'main'; - # Kill Adopt::NEXT warnings if we're a non-RC version - unless (_IS_DEVELOPMENT_VERSION()) { - Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/); - } - my $meta = Moose::Meta::Class->initialize($caller); unless ( $caller->isa('Catalyst') ) { my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); @@ -254,6 +245,9 @@ environment with CATALYST_DEBUG or _DEBUG. The environment settings override the application, with _DEBUG having the highest priority. +This sets the log level to 'debug' and enables full debug output on the +error screen. If you only want the latter, see L<< $c->debug >>. + =head2 -Engine Forces Catalyst to use a specific engine. Omit the @@ -273,6 +267,14 @@ is replaced with the uppercased name of your application, any "::" in the name will be replaced with underscores, e.g. MyApp::Web should use MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used. +If none of these are set, Catalyst will attempt to automatically detect the +home directory. If you are working in a development envirnoment, Catalyst +will try and find the directory containing either Makefile.PL, Build.PL or +dist.ini. If the application has been installed into the system (i.e. +you have done C), then Catalyst will use the path to your +application module, without the .pm extension (ie, /foo/MyApp if your +application was installed at /foo/MyApp.pm) + =head2 -Log use Catalyst '-Log=warn,fatal,error'; @@ -332,8 +334,8 @@ call to forward. my $foodata = $c->forward('/foo'); $c->forward('index'); - $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/); - $c->forward('MyApp::View::TT'); + $c->forward(qw/Model::DBIC::Foo do_stuff/); + $c->forward('View::TT'); Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies an C<< eval { } >> around the call (actually @@ -342,22 +344,22 @@ all 'dies' within the called action. If you want C to propagate you need to do something like: $c->forward('foo'); - die $c->error if $c->error; + die join "\n", @{ $c->error } if @{ $c->error }; Or make sure to always return true values from your actions and write 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, + +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, +If you need to return an array then return a reference to it, or stash it like so: $c->stash->{array} = \@array; @@ -417,9 +419,9 @@ sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } =head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) -The relationship between C and +The relationship between C and L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as -the relationship between +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, @@ -504,7 +506,7 @@ sub error { =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. @@ -802,7 +804,7 @@ 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 @@ -934,6 +936,8 @@ You can enable debug mode in several ways: =back +The first three also set the log level to 'debug'. + Calling C<< $c->debug(1) >> has no effect. =cut @@ -1142,7 +1146,7 @@ EOF if ( $class->debug ) { my $name = $class->config->{name} || 'Application'; - $class->log->info("$name powered by Catalyst $Catalyst::VERSION"); + $class->log->info("$name powered by Catalyst $Catalyst::PRETTY_VERSION"); } # Make sure that the application class becomes immutable at this point, @@ -1180,23 +1184,20 @@ EOF return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE. } - =head2 $app->setup_finalize -A hook to attach modifiers to. -Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup. -Also better than C< setup_finished(); >, as that is a getter method. - - sub setup_finalize { +A hook to attach modifiers to. This method does not do anything except set the +C accessor. - my $app = shift; - - ## do stuff, i.e., determine a primary key column for sessions stored in a DB +Applying method modifiers to the C method doesn't work, because of quirky thingsdone for plugin setup. - $app->next::method(@_); +Example: + after setup_finalize => sub { + my $app = shift; - } + ## do stuff here.. + }; =cut @@ -1215,7 +1216,7 @@ 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 ) >>. +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 @@ -1257,11 +1258,31 @@ sub uri_for { $path .= '/'; } + undef($path) if (defined $path && $path eq ''); + + my $params = + ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); + + carp "uri_for called with undef argument" if grep { ! defined $_ } @args; + foreach my $arg (@args) { + utf8::encode($arg) if utf8::is_utf8($arg); + } + s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; + if (blessed $path) { # Action object only. + s|/|%2F|g for @args; + } + if ( blessed($path) ) { # action object - my $captures = [ map { s|/|%2F|; $_; } + my $captures = [ map { s|/|%2F|g; $_; } ( scalar @args && ref $args[0] eq 'ARRAY' ? @{ shift(@args) } : ()) ]; + + foreach my $capture (@$captures) { + utf8::encode($capture) if utf8::is_utf8($capture); + $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + } + my $action = $path; $path = $c->dispatcher->uri_for_action($action, $captures); if (not defined $path) { @@ -1274,13 +1295,6 @@ sub uri_for { undef($path) if (defined $path && $path eq ''); - my $params = - ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); - - 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); unless (defined $path && $path =~ s!^/!!) { # in-place strip @@ -1340,6 +1354,20 @@ $c->uri_for >>. You can also pass in a Catalyst::Action object, in which case it is passed to C<< $c->uri_for >>. +Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action. + +For example, if the action looks like: + + package MyApp::Controller::Users; + + sub lst : Path('the-list') {} + +You can use: + + $c->uri_for_action('/users/lst') + +and it will create the URI /users/the-list. + =back =cut @@ -1715,7 +1743,7 @@ sub finalize { $c->finalize_body; } - $c->log_response; + $c->log_response; if ($c->use_stats) { my $elapsed = sprintf '%f', $c->stats->elapsed; @@ -2056,84 +2084,6 @@ sub prepare_query_parameters { $c->engine->prepare_query_parameters( $c, @_ ); } -=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 - } - } - } - return $filtered_params; -} - -# turn debug filters into a list of CodeRef's -sub _normalize_debug_filters { - my $c = shift; - - my @filters = ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] } : grep { defined $_ } @_; - - my @normalized = map { _make_filter_callback($_) } @filters; - - return @normalized; -} - -sub _make_filter_callback { - my $filter = shift; - - 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: @@ -2142,9 +2092,11 @@ Writes information about the request to the debug logs. This includes: =item * Request method, path, and remote IP address +=item * Request headers (see L) + =item * Query keywords (see L) -=item * Request parameters (see L) +=item * Request parameters =item * File uploads @@ -2157,19 +2109,24 @@ sub log_request { return unless $c->debug; - my ( $method, $path, $address ) = ( $c->req->method, $c->req->path, $c->req->address ); + my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; + my $request = $dump->[1]; + + my ( $method, $path, $address ) = ( $request->method, $request->path, $request->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_headers('request', $request->headers); + + if ( my $keywords = $request->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_parameters( query => $request->query_parameters, body => $request->body_parameters ); - $c->log_request_uploads; + $c->log_request_uploads($request); } =head2 $c->log_response @@ -2184,171 +2141,45 @@ Writes information about the response to the debug logs. This includes: =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 log_response { my $c = shift; - return unless $c->debug && $c->config->{Debug}->{log_response}; + return unless $c->debug; - $c->log->debug('Response Status: ' . $c->response->status); - $c->log_headers('response', $c->response->headers); + my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; + my $response = $dump->[1]; + + $c->log->debug( + sprintf( + 'Response Code: %s; Content-Type: %s; Content-Length: %s', + $response->status || 'unknown', + $response->headers->header('Content-Type') || 'unknown', + $response->headers->header('Content-Length') || 'unknown' + ) + ); } =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\./ } ); - - # 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 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 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 = @_; + return unless $c->debug; + 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 $params = $all_params{$type}; + next if ! keys %$params; my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); - for my $key ( sort keys %$filtered_params ) { - my $param = $filtered_params->{$key}; + 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 ); } @@ -2366,7 +2197,9 @@ the debug logs. sub log_request_uploads { my $c = shift; - my $uploads = $c->req->uploads; + my $request = shift; + return unless $c->debug; + my $uploads = $request->uploads; if ( keys %$uploads ) { my $t = Text::SimpleTable->new( [ 12, 'Parameter' ], @@ -2386,28 +2219,7 @@ sub log_request_uploads { =head2 $c->log_headers($type => $headers) -Writes HTTP::Headers to debug logs, applying filters as configured. - -Similarly to how L 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. 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; - }, - } - ); +Logs L (either request or response) to the debug logs. =cut @@ -2416,10 +2228,10 @@ sub log_headers { my $type = shift; my $headers = shift; # an HTTP::Headers instance - my $filtered = $c->_apply_header_debug_filters( $type, $headers ); + return unless $c->debug; my $t = Text::SimpleTable->new( [ 35, 'Header Name' ], [ 40, 'Value' ] ); - $filtered->scan( + $headers->scan( sub { my ( $name, $value ) = @_; $t->row( $name, $value ); @@ -2428,33 +2240,6 @@ sub log_headers { $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 @@ -2584,8 +2369,11 @@ sub setup_components { } for my $component (@comps) { - $class->components->{ $component } = $class->setup_component($component); - for my $component ($class->expand_component_module( $component, $config )) { + 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->_controller_init_base_classes($component); # Also cover inner packages $class->components->{ $component } = $class->setup_component($component); @@ -3049,12 +2837,11 @@ There are a number of 'base' config variables which can be set: =item * -C - The default model picked if you say C<< $c->model >>. See Lmodel($name)>. +C - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>. =item * -C - The default view to be rendered or returned when C<< $c->view >>. See Lview($name)>. -is called. +C - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>. =item * @@ -3319,6 +3106,8 @@ numa: Dan Sully obra: Jesse Vincent +Octavian Rasnita + omega: Andreas Marienborg Oleg Kostyuk