Changelog
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 9e74bee..3c7dd25 100644 (file)
@@ -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 <MYAPP>_DEBUG. The environment
 settings override the application, with <MYAPP>_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<make install>), 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<die> 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<go> and 
+The relationship between C<go> 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<setup_finished> 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<setup> 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</log_headers>)
+
 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
 
-=item * Request parameters (see L</log_request_parameters>)
+=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<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 = @_;
 
+    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</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;
-            },
-        }
-    );
+Logs L<HTTP::Headers> (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<default_model> - The default model picked if you say C<< $c->model >>. See L</$c->model($name)>.
+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.
+C<default_view> - 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 <daniel@cpan.org>
 
 obra: Jesse Vincent
 
+Octavian Rasnita
+
 omega: Andreas Marienborg
 
 Oleg Kostyuk <cub.uanic@gmail.com>