Tests, fix args as well as captureargs and be less violent - only encode /
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 7556e34..8d5113e 100644 (file)
@@ -27,11 +27,12 @@ use URI::https;
 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 { {} });
@@ -78,7 +79,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.80007';
+our $VERSION = '5.80013';
 
 {
     my $dev_version = $VERSION =~ /_\d{2}$/;
@@ -348,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
 
@@ -402,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
 
@@ -486,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
 
@@ -531,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;
@@ -548,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 " .
@@ -557,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}/)";
         }
@@ -645,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;
@@ -658,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/);
 
@@ -699,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;
@@ -711,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/);
 
@@ -773,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 {
@@ -1132,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;
@@ -1174,7 +1208,7 @@ When used as a string, provides a textual URI.
 
 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 
+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.
 
@@ -1186,13 +1220,13 @@ 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 
+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->uri_for($c->action, $c->req->captures,
       @{ $c->req->args }, $c->req->params);
 
   # For the Foo action in the Bar controller
@@ -1206,10 +1240,17 @@ path, use C<< $c->uri_for_action >> instead.
 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) {
@@ -1227,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);
 
@@ -1559,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}++;
@@ -1589,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"},
@@ -1875,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;
         }
     }
@@ -2126,40 +2169,32 @@ sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
 
 =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.
+
+The C<setup_components> config option is passed to both of the above methods.
 
-All components found will also have any
-L<inner packages|Devel::InnerPackage> 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.
+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 ) {
 
@@ -2168,30 +2203,76 @@ sub setup_components {
         # 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);
@@ -2205,20 +2286,12 @@ sub setup_component {
         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 _component_name in the config here, so that custom COMPONENT
+    # Stash catalyst_component_name in the config here, so that custom COMPONENT
     # methods also pass it. local to avoid pointlessly shitting in config
     # for the debug screen, as $component is already the key name.
-    local $config->{_component_name} = $component;
+    local $config->{catalyst_component_name} = $component;
 
     my $instance = eval { $component->COMPONENT( $class, $config ); };
 
@@ -2593,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>,
@@ -2638,6 +2782,18 @@ changes are made to the request.
     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
@@ -2708,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
 
@@ -2726,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>
@@ -2738,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>
 
@@ -2760,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>
@@ -2790,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