X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=7556e34f54841a753350709520e9b934cfc26778;hp=edd217eb54998e90b6a5e5fea2172bba5bb4a3df;hb=d2598ac82e8508f4d6da90ec60a1ed60840c2016;hpb=6ab73369947422004890abb05035c491b086283f diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index edd217e..7556e34 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,11 +1,14 @@ package Catalyst; use Moose; +use Moose::Meta::Class (); extends 'Catalyst::Component'; use Moose::Util qw/find_meta/; use bytes; -use Scope::Upper (); +use B::Hooks::EndOfScope (); use Catalyst::Exception; +use Catalyst::Exception::Detach; +use Catalyst::Exception::Go; use Catalyst::Log; use Catalyst::Request; use Catalyst::Request::Upload; @@ -57,8 +60,8 @@ sub finalize_output { shift->finalize_body(@_) }; our $COUNT = 1; our $START = time; our $RECURSION = 1000; -our $DETACH = "catalyst_detach\n"; -our $GO = "catalyst_go\n"; +our $DETACH = Catalyst::Exception::Detach->new; +our $GO = Catalyst::Exception::Go->new; #I imagine that very few of these really need to be class variables. if any. #maybe we should just make them attributes with a default? @@ -75,7 +78,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80003'; +our $VERSION = '5.80007'; { my $dev_version = $VERSION =~ /_\d{2}$/; @@ -100,12 +103,13 @@ sub import { } 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}") } ); } @@ -114,6 +118,8 @@ sub import { $caller->setup_home; } +sub _application { $_[0] } + =head1 NAME Catalyst - The Elegant MVC Web Application Framework @@ -329,9 +335,11 @@ call to forward. $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/); $c->forward('MyApp::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; @@ -351,8 +359,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. @@ -364,23 +372,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 @@ -390,12 +402,12 @@ 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, +Almost the same as L<< detach|/"$c->detach( $action [, \@arguments ] )" >>, but does a full dispatch like L, instead of just calling the new C<$action> / -C<$class-E$method>. This means that C, C and the +C<< $class->$method >>. This means that C, C and the method you visit are called, just like a new request. -C<$c-Estash> is kept unchanged. +C<< $c->stash >> is kept unchanged. =cut @@ -492,8 +504,13 @@ sub clear_errors { $c->error(0); } -# search components given a name and some prefixes sub _comp_search_prefixes { + my $c = shift; + return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); +} + +# search components given a name and some prefixes +sub _comp_names_search_prefixes { my ( $c, $name, @prefixes ) = @_; my $appclass = ref $c || $c; my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; @@ -509,18 +526,18 @@ sub _comp_search_prefixes { my $query = ref $name ? $name : qr/^$name$/i; my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; - return map { $c->components->{ $_ } } @result if @result; + return @result if @result; # if we were given a regexp to search against, we're done. return if ref $name; # regexp fallback $query = qr/$name/i; - @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible; + @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; # no results? try against full names if( !@result ) { - @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible; + @result = grep { m{$query} } keys %eligible; } # don't warn if we didn't find any results, it just might not exist @@ -557,7 +574,9 @@ sub _comp_names { my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes ); + my @names = map { s{$filter}{}; $_; } + $c->_comp_names_search_prefixes( undef, @prefixes ); + return @names; } @@ -646,7 +665,7 @@ sub model { 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.' ); @@ -699,7 +718,7 @@ sub view { 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.' ); @@ -805,11 +824,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 @@ -903,7 +922,9 @@ Returns the engine instance. See L. =head2 $c->path_to(@path) Merges C<@path> with C<< $c->config->{home} >> and returns a -L object. +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. For example: @@ -1094,21 +1115,26 @@ EOF $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). - Scope::Upper::reap(sub { + 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} ) { - die "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"; + 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\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; - }, Scope::Upper::SCOPE(1)); + $meta->make_immutable(replace_constructor => 1) + unless $meta->is_immutable; + }; $class->setup_finalize; } @@ -1138,30 +1164,42 @@ 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. - -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 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 @@ -1188,7 +1226,7 @@ sub uri_for { ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; - s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go for @args; + s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; unshift(@args, $path); @@ -1219,12 +1257,12 @@ sub uri_for { my $key = $_; $val = '' unless defined $val; (map { - $_ = "$_"; - utf8::encode( $_ ) if utf8::is_utf8($_); + my $param = "$_"; + utf8::encode( $param ) if utf8::is_utf8($param); # using the URI::Escape pattern here so utf8 chars survive - s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; - s/ /+/g; - "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val )); + $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + $param =~ s/ /+/g; + "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } @@ -1498,11 +1536,11 @@ sub execute { my $last = pop( @{ $c->stack } ); if ( my $error = $@ ) { - if ( !ref($error) and $error eq $DETACH ) { - die $DETACH if($c->depth > 1); + if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { + $error->rethrow if $c->depth > 1; } - elsif ( !ref($error) and $error eq $GO ) { - die $GO if($c->depth > 0); + elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) { + $error->rethrow if $c->depth > 0; } else { unless ( ref $error ) { @@ -1586,25 +1624,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. @@ -2070,7 +2089,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, @@ -2114,7 +2133,7 @@ reference. Items in the array beginning with C<::> will have the application class name prepended to them. All components found will also have any -L loaded and set up as components. +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. @@ -2174,7 +2193,7 @@ sub setup_components { sub _controller_init_base_classes { my ($app_class, $component) = @_; foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) { - Moose->init_meta( for_class => $class ) + Moose::Meta::Class->initialize( $class ) unless find_meta($class); } } @@ -2196,6 +2215,10 @@ sub setup_component { my $suffix = Catalyst::Utils::class2classsuffix( $component ); my $config = $class->config->{ $suffix } || {}; + # Stash _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; my $instance = eval { $component->COMPONENT( $class, $config ); }; @@ -2478,9 +2501,6 @@ the plugin name does not begin with C. my ( $proto, $plugin, $instant ) = @_; my $class = ref $proto || $proto; - # no ignore_loaded here, the plugin may already have been - # defined in memory and we don't want to error on "no file" if so - Class::MOP::load_class( $plugin ); $proto->_plugins->{$plugin} = 1; @@ -2501,14 +2521,26 @@ the plugin name does not begin with C. $class->_plugins( {} ) unless $class->_plugins; $plugins ||= []; - for my $plugin ( reverse @$plugins ) { - unless ( $plugin =~ s/\A\+// ) { - $plugin = "Catalyst::Plugin::$plugin"; - } + my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins); + + for my $plugin ( reverse @plugins ) { + Class::MOP::load_class($plugin); + my $meta = find_meta($plugin); + next if $meta && $meta->isa('Moose::Meta::Role'); $class->_register_plugin($plugin); } + + my @roles = + map { $_->name } + grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') } + map { find_meta($_) } + @plugins; + + Moose::Util::apply_all_roles( + $class => @roles + ) if @roles; } } @@ -2567,7 +2599,7 @@ 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; + MyApp->config(show_internal_actions => 1); =head1 CASE SENSITIVITY @@ -2575,7 +2607,7 @@ By default Catalyst is not case sensitive, so C is mapped to C. You can activate case sensitivity with a config parameter. - MyApp->config->{case_sensitive} = 1; + MyApp->config(case_sensitive => 1); This causes C to map to C. @@ -2585,7 +2617,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 @@ -2613,11 +2645,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 @@ -2654,7 +2686,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,6 +2732,8 @@ dkubb: Dan Kubb Drew Taylor +dwc: Daniel Westermann-Clark + esskar: Sascha Kiefer fireartist: Carl Franks @@ -2710,10 +2744,14 @@ Gary Ashton Jones Geoff Richards +hobbs: Andrew Rodland + ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho +jester: Jesse Sheidlower + jhannah: Jay Hannah Jody Belka @@ -2722,6 +2760,8 @@ Johan Lindstrom jon: Jon Schutz +konobi: Scott McWhirter + marcus: Marcus Ramberg miyagawa: Tatsuhiko Miyagawa @@ -2748,9 +2788,9 @@ phaylon: Robert Sedlacek rafl: Florian Ragwitz -sky: Arthur Bergman +random: Roland Lammel -the_jester: Jesse Sheidlower +sky: Arthur Bergman t0m: Tomas Doran @@ -2760,7 +2800,7 @@ willert: Sebastian Willert =head1 LICENSE -This library is free software, you can redistribute it and/or modify it under +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut