Tests, fix args as well as captureargs and be less violent - only encode /
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 60ccc33..8d5113e 100644 (file)
@@ -32,7 +32,7 @@ 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 { {} });
@@ -79,7 +79,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.80011';
+our $VERSION = '5.80013';
 
 {
     my $dev_version = $VERSION =~ /_\d{2}$/;
@@ -349,6 +349,21 @@ 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, 
+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
 
@@ -403,12 +418,15 @@ sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 
 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 
-Almost the same as L<< detach|/"$c->detach( $action [, \@arguments ] )" >>, but does a full dispatch like L</visit>,
-instead of just calling the new C<$action> /
-C<< $class->$method >>. This means that C<begin>, C<auto> and the
-method you visit are called, just like a new request.
-
-C<< $c->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
 
@@ -487,7 +505,9 @@ 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.
 
 =head2 $c->clear_errors
 
@@ -532,6 +552,10 @@ sub _comp_names_search_prefixes {
     # 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;
@@ -549,7 +573,8 @@ sub _comp_names_search_prefixes {
            (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 " .
@@ -558,7 +583,7 @@ sub _comp_names_search_prefixes {
            $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}/)";
         }
@@ -646,7 +671,7 @@ If you want to search for models, pass in a regexp as the argument.
 
 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;
@@ -659,8 +684,8 @@ sub model {
         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/);
 
@@ -700,6 +725,7 @@ If you want to search for views, pass in a regexp as the argument.
 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;
@@ -712,8 +738,8 @@ sub view {
         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/);
 
@@ -774,6 +800,12 @@ should be used instead.
 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 {
@@ -1133,8 +1165,9 @@ EOF
                 . "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;
     };
 
     $class->setup_finalize;
@@ -1214,9 +1247,10 @@ sub uri_for {
     }
 
     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) {
@@ -1234,6 +1268,7 @@ sub uri_for {
 
     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);
 
@@ -1566,9 +1601,9 @@ sub execute {
 
 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}++;
@@ -1596,9 +1631,10 @@ sub _stats_start_execute {
 
     # 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"},
@@ -1882,7 +1918,7 @@ sub prepare {
         $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;
         }
     }
@@ -2153,6 +2189,7 @@ sub setup_components {
 
     my @comps = sort { length $a <=> length $b }
                 $class->locate_components($config);
+    my %comps = map { $_ => 1 } @comps;
 
     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
@@ -2175,6 +2212,7 @@ sub setup_components {
     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);
         }
@@ -2221,7 +2259,7 @@ is expected to return a list of component (package) names to be set up.
 
 sub expand_component_module {
     my ($class, $module) = @_;
-    Devel::InnerPackage::list_packages( $module );
+    return Devel::InnerPackage::list_packages( $module );
 }
 
 =head2 $c->setup_component
@@ -2628,6 +2666,77 @@ messages in template systems.
 
 sub version { return $Catalyst::VERSION }
 
+=head1 CONFIGURATION
+
+There are a number of 'base' config variables which can be set:
+
+=over
+
+=item *
+
+C<case_sensitive> - Makes private paths case sensitive. See L</CASE SENSITIVITY>.
+
+=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 *
+
+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 >>).
+
+=item *
+
+C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
+to be shown in hit debug tables in the test server.
+
+=item *
+
+C<using_frontend_proxy> - See L</PROXY SUPPORT>.
+
+=back
+
 =head1 INTERNAL ACTIONS
 
 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
@@ -2755,9 +2864,11 @@ abw: Andy Wardley
 
 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
 
@@ -2773,6 +2884,14 @@ chansen: Christian Hansen
 
 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
 
 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
@@ -2785,19 +2904,25 @@ esskar: Sascha Kiefer
 
 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
+jester: Jesse Sheidlower C<jester@panix.com>
 
 jhannah: Jay Hannah <jay@jays.net>
 
@@ -2807,6 +2932,10 @@ Johan Lindstrom
 
 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>
@@ -2837,14 +2966,22 @@ rafl: Florian Ragwitz <rafl@debian.org>
 
 random: Roland Lammel <lammel@cpan.org>
 
+Robert Sedlacek C<< <rs@474.at> >>
+
 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