X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=508aadb5ab0c19a9d044ad60f205b6cdd71d15bc;hp=54ff1875d602e7f921d14b04b8c8ba636f3ff5a6;hb=a738ab683457ec903b7becf4bd384f1bf1d539c2;hpb=0756fe3bdd265109d7dcba43f1bef6430b9bfa02 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 54ff187..508aadb 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -14,10 +14,11 @@ use Catalyst::Controller; use File::stat; use NEXT; use Text::SimpleTable; -use Path::Class; +use Path::Class::Dir; +use Path::Class::File; use Time::HiRes qw/gettimeofday tv_interval/; use URI; -use Scalar::Util qw/weaken/; +use Scalar::Util qw/weaken blessed/; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use attributes; @@ -219,7 +220,7 @@ Specifies log level. =head1 METHODS -=head2 Information about the current request +=head2 INFORMATION ABOUT THE CURRENT REQUEST =head2 $c->action @@ -241,7 +242,7 @@ corresponding to the controller of the current action. For example: Returns the current L object. See L. -=head2 Processing and response to the current request +=head2 PROCESSING AND RESPONSE TO THE CURRENT REQUEST =head2 $c->forward( $action [, \@arguments ] ) @@ -258,7 +259,7 @@ call to forward. my $foodata = $c->forward('/foo'); $c->forward('index'); - $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/); + $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/); $c->forward('MyApp::View::TT'); =cut @@ -291,11 +292,6 @@ Add a new error. $c->error('Something bad happened'); -Clear errors. You probably don't want to clear the errors unless you are -implementing a custom error screen. - - $c->error(0); - =cut sub error { @@ -308,6 +304,22 @@ sub error { return $c->{error} || []; } +=head2 $c->clear_errors + +Clear errors. You probably don't want to clear the errors unless you are +implementing a custom error screen. + +This is equivalent to running + + $c->error(0); + +=cut + +sub clear_errors { + my $c = shift; + $c->error(0); +} + =head2 $c->response =head2 $c->res @@ -399,7 +411,18 @@ sub _comp_prefixes { return $comp; } -=head2 Component Accessors +# Return a component if only one matches. +sub _comp_singular { + my ($c, @prefixes) = @_; + + my $appclass = ref $c || $c; + + my ($comp,$rest) = map { $c->_comp_search("^${appclass}::${_}::") } + @prefixes; + return $comp unless $rest; +} + +=head2 COMPONENT ACCESSORS =head2 $c->comp($name) @@ -443,11 +466,15 @@ Gets a L instance by name. $c->controller('Foo')->do_stuff; +If name is omitted, will return the controller for the dispatched action. + =cut sub controller { my ( $c, $name ) = @_; - return $c->_comp_prefixes($name, qw/Controller C/); + return $c->_comp_prefixes($name, qw/Controller C/) + if ($name); + return $c->component($c->action->class); } =head2 $c->model($name) @@ -456,11 +483,19 @@ Gets a L instance by name. $c->model('Foo')->do_stuff; +If the name is omitted, it will look for a config setting 'default_model', +or check if there is only one model, and forward to it if that's the case. + =cut sub model { my ( $c, $name ) = @_; - return $c->_comp_prefixes($name, qw/Model M/); + return $c->_comp_prefixes($name, qw/Model M/) + if $name; + return $c->comp($c->config->{default_model}) + if $c->config->{default_model}; + return $c->_comp_singular(qw/Model M/); + } =head2 $c->view($name) @@ -469,11 +504,18 @@ Gets a L instance by name. $c->view('Foo')->do_stuff; +If the name is omitted, it will look for a config setting 'default_view', +or check if there is only one view, and forward to it if that's the case. + =cut sub view { my ( $c, $name ) = @_; - return $c->_comp_prefixes($name, qw/View V/); + return $c->_comp_prefixes($name, qw/View V/) + if $name; + return $c->comp($c->config->{default_view}) + if $c->config->{default_view}; + return $c->_comp_singular(qw/View V/); } =head2 Class data and helper classes @@ -538,7 +580,7 @@ L man page. =cut -=head2 Utility methods +=head2 UTILITY METHODS =head2 $c->path_to(@path) @@ -553,9 +595,9 @@ For example: sub path_to { my ( $c, @path ) = @_; - my $path = dir( $c->config->{home}, @path ); + my $path = Path::Class::Dir->new( $c->config->{home}, @path ); if ( -d $path ) { return $path } - else { return file( $c->config->{home}, @path ) } + else { return Path::Class::File->new( $c->config->{home}, @path ) } } =head2 $c->plugin( $name, $class, @args ) @@ -971,19 +1013,22 @@ sub execute { $class = $c->component($class) || $class; $c->state(0); + if ($c->depth >= $RECURSION) { + my $action = "$code"; + $action = "/$action" unless $action =~ /\-\>/; + my $error = qq/Deep recursion detected calling "$action"/; + $c->log->error($error); + $c->error($error); + $c->state(0); + return $c->state; + } + + if ( $c->debug ) { my $action = "$code"; $action = "/$action" unless $action =~ /\-\>/; $c->counter->{"$code"}++; - if ( $c->counter->{"$code"} > $RECURSION ) { - my $error = qq/Deep recursion detected in "$action"/; - $c->log->error($error); - $c->error($error); - $c->state(0); - return $c->state; - } - # determine if the call was the result of a forward # this is done by walking up the call stack and looking for a calling # sub of Catalyst::forward before the eval @@ -1165,7 +1210,7 @@ sub finalize_headers { if ( $c->response->body && !$c->response->content_length ) { # get the length from a filehandle - if ( ref $c->response->body && $c->response->body->can('read') ) { + if ( blessed($c->response->body) && $c->response->body->can('read') ) { if ( my $stat = stat $c->response->body ) { $c->response->content_length( $stat->size ); } @@ -1229,7 +1274,7 @@ namespaces. sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } -=head2 handle_request( $class, @arguments ) +=head2 $c->handle_request( $class, @arguments ) Called to handle each HTTP request. @@ -1839,7 +1884,7 @@ sub setup_home { if ($home) { $class->config->{home} ||= $home; - $class->config->{root} ||= dir($home)->subdir('root'); + $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root'); } } @@ -1892,14 +1937,13 @@ the plugin name does not begin with C. =cut { - my %PLUGINS; sub registered_plugins { my $proto = shift; - return sort keys %PLUGINS unless @_; + return sort keys %{$proto->_plugins} unless @_; my $plugin = shift; - return 1 if exists $PLUGINS{$plugin}; - return exists $PLUGINS{"Catalyst::Plugin::$plugin"}; + return 1 if exists $proto->_plugins->{$plugin}; + return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"}; } sub _register_plugin { @@ -1914,7 +1958,7 @@ the plugin name does not begin with C. message => qq/Couldn't load ${type}plugin "$plugin", $error/ ); } - $PLUGINS{$plugin} = 1; + $proto->_plugins->{$plugin} = 1; unless ($instant) { no strict 'refs'; unshift @{"$class\::ISA"}, $plugin; @@ -1925,6 +1969,7 @@ the plugin name does not begin with C. sub setup_plugins { my ( $class, $plugins ) = @_; + $class->_plugins( {} ) unless $class->_plugins; $plugins ||= []; for my $plugin ( reverse @$plugins ) { @@ -1939,7 +1984,8 @@ the plugin name does not begin with C. =head2 $c->stack -Returns the stack. +Returns an arrayref of the internal execution stack (actions that are currently +executing). =head2 $c->write( $data ) @@ -2092,6 +2138,8 @@ Autrijus Tang Brian Cassidy +Carl Franks + Christian Hansen Christopher Hicks