X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=9c8d588bcb50c0e0f26e3be412a97de122d21e8c;hp=dcf566d4f29ca7b02538af03de60d35c45580a14;hb=3640641e13deb51a427e7c0ecf13ade30bfa6db7;hpb=e6bfaa20d748bbc8553e70f25461748d13ce3719 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index dcf566d..9c8d588 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -4,7 +4,6 @@ use Moose; 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; @@ -27,11 +26,13 @@ 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/; +use Try::Tiny; -BEGIN { require 5.008001; } +BEGIN { require 5.008004; } has stack => (is => 'ro', default => sub { [] }); has stash => (is => 'rw', default => sub { {} }); @@ -71,20 +72,14 @@ __PACKAGE__->mk_classdata($_) setup_finished/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); -__PACKAGE__->engine_class('Catalyst::Engine::CGI'); +__PACKAGE__->engine_class('Catalyst::Engine'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80006'; - -{ - my $dev_version = $VERSION =~ /_\d{2}$/; - *_IS_DEVELOPMENT_VERSION = sub () { $dev_version }; -} - +our $VERSION = '5.80016'; $VERSION = eval $VERSION; sub import { @@ -97,18 +92,14 @@ 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); - #Moose->import({ into => $caller }); #do we want to do this? - unless ( $caller->isa('Catalyst') ) { my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); $meta->superclasses(@superclasses); } + # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp + $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); + unless( $meta->has_method('meta') ){ $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); } @@ -331,12 +322,14 @@ 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 forward implies an C<> around the call (actually -C does), thus de-fatalizing all 'dies' within the called -action. If you want C 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 to propagate you +need to do something like: $c->forward('foo'); die $c->error if $c->error; @@ -346,6 +339,21 @@ 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 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) } @@ -356,8 +364,8 @@ sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $ =head2 $c->detach() -The same as C, 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. @@ -369,23 +377,27 @@ sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) } =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] ) -Almost the same as C, but does a full dispatch, instead of just -calling the new C<$action> / C<$class-E$method>. This means that C, -C 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, C 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, C and -C return information for the visited action when they are invoked -within the visited action. This is different from the behavior of C -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, L and +L 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-Estash> is kept unchanged. +C<< $c->stash >> is kept unchanged. -In effect, C allows you to "wrap" another action, just as it -would have been called by dispatching from a URL, while the analogous -C 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 @@ -395,12 +407,15 @@ sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } =head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) -Almost the same as C, but does a full dispatch like C, -instead of just calling the new C<$action> / -C<$class-E$method>. This means that C, C and the -method you visit are called, just like a new request. - -C<$c-Estash> is kept unchanged. +The relationship between C 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, +C escapes the processing of the current request chain on completion, and +does not return to its caller. =cut @@ -480,6 +495,8 @@ sub error { =head2 $c->state 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 @@ -524,6 +541,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; @@ -541,7 +562,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 " . @@ -550,7 +572,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}/)"; } @@ -638,7 +660,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; @@ -651,14 +673,14 @@ 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/); 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.' ); @@ -692,6 +714,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; @@ -704,14 +727,14 @@ 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/); 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.' ); @@ -766,6 +789,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 { @@ -817,11 +846,11 @@ Returns or takes a hashref containing the application's configuration. __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } ); -You can also use a C, C or C config file -like myapp.conf in your applications home directory. See +You can also use a C, C or L config file +like C in your applications home directory. See L. -=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 @@ -917,7 +946,7 @@ Returns the engine instance. See L. Merges C<@path> with C<< $c->config->{home} >> and returns a L 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: @@ -1105,27 +1134,40 @@ EOF 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, - # which ensures that it gets an inlined constructor. This means that it - # works even if the user has added a plugin which contains a new method. - # Note however that we have to do the work on scope end, so that method - # modifiers work correctly in MyApp (as you have to call setup _before_ - # applying modifiers). B::Hooks::EndOfScope::on_scope_end { return if $@; my $meta = Class::MOP::get_metaclass_by_name($class); - if ( $meta->is_immutable && ! { $meta->immutable_options }->{inline_constructor} ) { + if ( + $meta->is_immutable + && ! { $meta->immutable_options }->{replace_constructor} + && ( + $class->isa('Class::Accessor::Fast') + || $class->isa('Class::Accessor') + ) + ) { warn "You made your application class ($class) immutable, " - . "but did not inline the constructor.\n" - . "This will break catalyst, please pass " - . "(replace_constructor => 1) when making your class immutable.\n"; + . "but did not inline the\nconstructor. " + . "This will break catalyst, as your app \@ISA " + . "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. } @@ -1153,40 +1195,63 @@ sub setup_finalize { $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 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 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 parameters. + +If the first argument is a L 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 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) { @@ -1204,6 +1269,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); @@ -1536,9 +1602,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}++; @@ -1566,9 +1632,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"}, @@ -1601,25 +1668,6 @@ sub _stats_finish_execute { $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. @@ -1734,7 +1782,7 @@ sub finalize_headers { } 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 ) ); } } @@ -1800,7 +1848,7 @@ sub handle_request { # Always expect worst case! my $status = -1; - eval { + try { if ($class->debug) { my $secs = time - $START || 1; my $av = sprintf '%.3f', $COUNT / $secs; @@ -1811,12 +1859,11 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; - }; - - if ( my $error = $@ ) { - chomp $error; - $class->log->error(qq/Caught exception in engine "$error"/); } + catch { + chomp(my $error = $_); + $class->log->error(qq/Caught exception in engine "$error"/); + }; $COUNT++; @@ -1853,28 +1900,38 @@ sub prepare { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } - #XXX reuse coderef from can - # Allow engine to direct the prepare flow (for POE) - if ( $c->engine->can('prepare') ) { - $c->engine->prepare( $c, @arguments ); - } - else { - $c->prepare_request(@arguments); - $c->prepare_connection; - $c->prepare_query_parameters; - $c->prepare_headers; - $c->prepare_cookies; - $c->prepare_path; - - # Prepare the body for reading, either by prepare_body - # or the user, if they are using $c->read - $c->prepare_read; - - # Parse the body unless the user wants it on-demand - unless ( $c->config->{parse_on_demand} ) { - $c->prepare_body; + try { + # Allow engine to direct the prepare flow (for POE) + if ( my $prepare = $c->engine->can('prepare') ) { + $c->engine->$prepare( $c, @arguments ); + } + else { + $c->prepare_request(@arguments); + $c->prepare_connection; + $c->prepare_query_parameters; + $c->prepare_headers; + $c->prepare_cookies; + $c->prepare_path; + + # Prepare the body for reading, either by prepare_body + # or the user, if they are using $c->read + $c->prepare_read; + + # Parse the body unless the user wants it on-demand + unless ( ref($c)->config->{parse_on_demand} ) { + $c->prepare_body; + } } } + # VERY ugly and probably shouldn't rely on ->finalize actually working + catch { + # failed prepare is always due to an invalid request, right? + $c->response->status(400); + $c->response->content_type('text/plain'); + $c->response->body('Bad Request'); + $c->finalize; + die $_; + }; my $method = $c->req->method || ''; my $path = $c->req->path; @@ -2085,7 +2142,7 @@ Reads a chunk of data from the request body. This method is designed to 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, @@ -2122,40 +2179,32 @@ sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) } =head2 $c->setup_components -Sets up components. Specify a C config option to pass -additional options directly to L. To add additional -search paths, specify a key named C 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 method, expands them to +package names with the L method, and then installs +each component into the application. -All components found will also have any -L loaded and set up as components. -Note, that modules which are B an I of the main -file namespace loaded will not be instantiated as components. +The C config option is passed to both of the above methods. + +Installation of each component is performed by the L 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 ) { @@ -2164,30 +2213,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. + +Specify a C config option to pass additional options directly +to L. To add additional search paths, specify a key named +C 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 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); @@ -2201,16 +2296,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 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 ); }; @@ -2268,72 +2359,7 @@ Sets up engine. =cut sub setup_engine { - my ( $class, $engine ) = @_; - - if ($engine) { - $engine = 'Catalyst::Engine::' . $engine; - } - - if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) { - $engine = 'Catalyst::Engine::' . $env; - } - - if ( $ENV{MOD_PERL} ) { - my $meta = Class::MOP::get_metaclass_by_name($class); - - # create the apache method - $meta->add_method('apache' => sub { shift->engine->apache }); - - my ( $software, $version ) = - $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; - - $version =~ s/_//g; - $version =~ s/(\.[^.]+)\./$1/g; - - if ( $software eq 'mod_perl' ) { - - if ( !$engine ) { - - if ( $version >= 1.99922 ) { - $engine = 'Catalyst::Engine::Apache2::MP20'; - } - - elsif ( $version >= 1.9901 ) { - $engine = 'Catalyst::Engine::Apache2::MP19'; - } - - elsif ( $version >= 1.24 ) { - $engine = 'Catalyst::Engine::Apache::MP13'; - } - - else { - Catalyst::Exception->throw( message => - qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); - } - - } - - # install the correct mod_perl handler - if ( $version >= 1.9901 ) { - *handler = sub : method { - shift->handle_request(@_); - }; - } - else { - *handler = sub ($$) { shift->handle_request(@_) }; - } - - } - - elsif ( $software eq 'Zeus-Perl' ) { - $engine = 'Catalyst::Engine::Zeus'; - } - - else { - Catalyst::Exception->throw( - message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ ); - } - } + my ($class, $engine) = @_; unless ($engine) { $engine = $class->engine_class; @@ -2494,7 +2520,8 @@ the plugin name does not begin with C. 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'; @@ -2585,23 +2612,79 @@ messages in template systems. 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 - 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 >> is called. See L<< /$c->view($name) >>. - MyApp->config->{show_internal_actions} = 1; +=item * -=head1 CASE SENSITIVITY +C - 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 will be returned. -By default Catalyst is not case sensitive, so C is -mapped to C. You can activate case sensitivity with a config -parameter. +=item * - MyApp->config->{case_sensitive} = 1; +C - 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 >>. -This causes C to map to C. +=item * + +C - See L + +=item * + +C - The name of the application in debug messages and the debug and +welcome screens + +=item * + +C - 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 + +=item * + +C - 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 - 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 - If true, causes internal actions such as C<< _DISPATCH >> +to be shown in hit debug tables in the test server. + +=item * + +C - See L. + +=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 @@ -2609,7 +2692,7 @@ The request body is usually parsed at the beginning of a request, 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 @@ -2630,6 +2713,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 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 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 @@ -2637,11 +2732,11 @@ frontend proxy server(s) on different machines, you will need to set a 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 @@ -2678,7 +2773,7 @@ Wiki: =head2 L - The Catalyst Manual -=head2 L, L - Base classes for components +=head2 L, L - Base classes for components =head2 L - Core engine @@ -2700,9 +2795,11 @@ abw: Andy Wardley acme: Leon Brocard +abraxxa: Alexander Hartmaier + Andrew Bramble -Andrew Ford +Andrew Ford EA.Ford@ford-mason.co.ukE Andrew Ruthven @@ -2718,8 +2815,18 @@ chansen: Christian Hansen chicks: Christopher Hicks +Chisel Wright C + +Danijel Milicevic C + +David Kamholz Edkamholz@cpan.orgE + +David Naughton, C + David E. Wheeler +dhoss: Devin Austin + dkubb: Dan Kubb Drew Taylor @@ -2730,16 +2837,26 @@ esskar: Sascha Kiefer fireartist: Carl Franks +frew: Arthur Axel "fREW" Schmidt + gabb: Danijel Milicevic Gary Ashton Jones +Gavin Henry C + Geoff Richards +groditi: Guillermo Roditi + +hobbs: Andrew Rodland + ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho +jester: Jesse Sheidlower C + jhannah: Jay Hannah Jody Belka @@ -2748,6 +2865,12 @@ Johan Lindstrom jon: Jon Schutz +Jonathan Rockway C<< >> + +Kieren Diment C + +konobi: Scott McWhirter + marcus: Marcus Ramberg miyagawa: Tatsuhiko Miyagawa @@ -2776,16 +2899,22 @@ rafl: Florian Ragwitz random: Roland Lammel -sky: Arthur Bergman +Robert Sedlacek C<< >> -the_jester: Jesse Sheidlower +sky: Arthur Bergman t0m: Tomas Doran Ulf Edvinsson +Viljo Marrandi C + +Will Hawes C + willert: Sebastian Willert +Yuval Kogman, C + =head1 LICENSE This library is free software. You can redistribute it and/or modify it under