use Catalyst::Controller;
use Devel::InnerPackage ();
use File::stat;
-use Module::Pluggable::Object;
+use Module::Pluggable::Object ();
use NEXT;
-use Text::SimpleTable;
-use Path::Class::Dir;
-use Path::Class::File;
+use Text::SimpleTable ();
+use Path::Class::Dir ();
+use Path::Class::File ();
use Time::HiRes qw/gettimeofday tv_interval/;
-use URI;
+use URI ();
use Scalar::Util qw/weaken blessed/;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.70_01';
+our $VERSION = '5.7003';
sub import {
my ( $class, @arguments ) = @_;
=head1 SYNOPSIS
+ # Install Catalyst::Devel for helpers and other development tools
# use the helper to create a new application
catalyst.pl MyApp
=head1 DESCRIPTION
-Catalyst is a modern framework for making web applications without the pain usually associated with this process. This document is a reference to the main Catalyst application. If you are a new user, we suggest you start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>
+Catalyst is a modern framework for making web applications without the
+pain usually associated with this process. This document is a reference
+to the main Catalyst application. If you are a new user, we suggest you
+start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
See L<Catalyst::Manual> for more documentation.
use Catalyst qw/-Debug My::Module/;
The position of plugins and flags in the chain is important, because
-they are loaded in exactly the order in which they appear.
+they are loaded in the order in which they appear.
The following flags are supported:
=head2 -Debug
Enables debug output. You can also force this setting from the system
-environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment settings
-override the app, with <MYAPP>_DEBUG having highest priority.
+environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
+settings override the application, with <MYAPP>_DEBUG having the highest
+priority.
=head2 -Engine
Forces Catalyst to use a specific home directory, e.g.:
- use Catalyst qw[-Home=/usr/sri];
+ use Catalyst qw[-Home=/usr/mst];
=head2 -Log
=head2 $c->namespace
-Returns the namespace of the current action, i.e., the uri prefix
+Returns the namespace of the current action, i.e., the URI prefix
corresponding to the controller of the current action. For example:
# in Controller::Foo::Bar
=head2 $c->req
-Returns the current L<Catalyst::Request> object. See
-L<Catalyst::Request>.
+Returns the current L<Catalyst::Request> object, giving access to
+information about the current client request (including parameters,
+cookies, HTTP headers, etc.). See L<Catalyst::Request>.
=head2 REQUEST FLOW HANDLING
=head2 $c->forward( $class, $method, [, \@arguments ] )
-Forwards processing to another action, by it's private name. If you give a
+Forwards processing to another action, by its private name. If you give a
class name but no method, C<process()> is called. You may also optionally
pass arguments in an arrayref. The action will receive the arguments in
C<@_> and C<$c-E<gt>req-E<gt>args>. Upon returning from the function,
$c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
$c->forward('MyApp::View::TT');
-Note that forward implies an C<<eval { }>> around the call (well, actually
-C<execute> does), thus de-fatalizing all 'dies' within the called action. If
-you want C<die> to propagate you need to do something like:
+Note that forward implies an C<<eval { }>> around the call (actually
+C<execute> does), thus de-fatalizing all 'dies' within the called
+action. If you want C<die> to propagate you need to do something like:
$c->forward('foo');
die $c->error if $c->error;
-Or make sure to always return true values from your actions and write your code
-like this:
+Or make sure to always return true values from your actions and write
+your code like this:
$c->forward('foo') || return;
=head2 $c->detach( $class, $method, [, \@arguments ] )
+=head2 $c->detach()
+
The same as C<forward>, but doesn't return to the previous action when
processing is finished.
+When called with no arguments it escapes the processing chain entirely.
+
=cut
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
=head2 $c->res
-Returns the current L<Catalyst::Response> object.
+Returns the current L<Catalyst::Response> object, q.v.
=head2 $c->stash
it between components during a request. You can also set hash keys by
passing arguments. The stash is automatically sent to the view. The
stash is cleared at the end of a request; it cannot be used for
-persistent storage.
+persistent storage (for this you must use a session; see
+L<Catalyst::Plugin::Session> for a complete system integrated with
+Catalyst).
$c->stash->{foo} = $bar;
$c->stash( { moose => 'majestic', qux => 0 } );
}
-
-
# search via regex
sub _comp_search {
my ( $c, @names ) = @_;
$c->controller('Foo')->do_stuff;
-If name is omitted, will return the controller for the dispatched action.
+If the name is omitted, will return the controller for the dispatched
+action.
=cut
$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 view, and return it if that's the case.
+If the name is omitted, it will look for
+ - a model object in $c->stash{current_model_instance}, then
+ - a model name in $c->stash->{current_model}, then
+ - a config setting 'default_model', or
+ - check if there is only one model, and return it if that's the case.
=cut
return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
@args )
if $name;
- return $c->component( $c->config->{default_model} )
- if $c->config->{default_model};
+ if (ref $c) {
+ return $c->stash->{current_model_instance}
+ if $c->stash->{current_model_instance};
+ 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->_filter_component( $c->_comp_singular(qw/Model M/), @args );
}
$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.
+If the name is omitted, it will look for
+ - a view object in $c->stash{current_view_instance}, then
+ - a view name in $c->stash->{current_view}, then
+ - a config setting 'default_view', or
+ - check if there is only one view, and return it if that's the case.
=cut
return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
@args )
if $name;
- return $c->component( $c->config->{default_view} )
- if $c->config->{default_view};
+ if (ref $c) {
+ return $c->stash->{current_view_instance}
+ if $c->stash->{current_view_instance};
+ 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->_filter_component( $c->_comp_singular(qw/View V/) );
}
=head2 $c->log
-Returns the logging object instance. Unless it is already set, Catalyst sets
-this up with a L<Catalyst::Log> object. To use your own log class, set the
-logger with the C<< __PACKAGE__->log >> method prior to calling
+Returns the logging object instance. Unless it is already set, Catalyst
+sets this up with a L<Catalyst::Log> object. To use your own log class,
+set the logger with the C<< __PACKAGE__->log >> method prior to calling
C<< __PACKAGE__->setup >>.
__PACKAGE__->log( MyLogger->new );
$c->log->info( 'Now logging with my own logger!' );
-Your log class should implement the methods described in the
-L<Catalyst::Log> man page.
+Your log class should implement the methods described in
+L<Catalyst::Log>.
=head2 $c->debug
}
if ( $class->debug ) {
-
- my @plugins = ();
-
- {
- no strict 'refs';
- @plugins =
- map { $_ . ' ' . ( $_->VERSION || '' ) }
- grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
- }
+ my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
if (@plugins) {
my $t = Text::SimpleTable->new(74);
=head2 $c->uri_for( $path, @args?, \%query_values? )
-Merges path with C<$c-E<gt>request-E<gt>base> for absolute uri's and
-with C<$c-E<gt>namespace> for relative uri's, then returns a
-normalized L<URI> object. If any args are passed, they are added at the
-end of the path. If the last argument to uri_for is a hash reference,
-it is assumed to contain GET parameter key/value pairs, which will be
-appended to the URI in standard fashion.
+Merges path with C<< $c->request->base >> for absolute URIs and with
+C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
+object. If any args are passed, they are added at the end of the path.
+If the last argument to C<uri_for> is a hash reference, it is assumed to
+contain GET parameter key/value pairs, which will be appended to the URI
+in standard fashion.
-Instead of $path, you can also optionally pass a $action object which will
-be resolved to a path using $c->dispatcher->uri_for_action; if the first
-element of @args is an arrayref it is treated as a list of captures to be
-passed to uri_for_action.
+Instead of C<$path>, you can also optionally pass a C<$action> object
+which will be resolved to a path using
+C<< $c->dispatcher->uri_for_action >>; if the first element of
+C<@args> is an arrayref it is treated as a list of captures to be passed
+to C<uri_for_action>.
=cut
: [] );
$path = $c->dispatcher->uri_for_action($path, $captures);
return undef unless defined($path);
+ $path = '/' if $path eq '';
}
# massage namespace, empty if absolute path
my $params =
( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
- for my $value ( values %$params ) {\r
- my $isa_ref = ref $value;\r
- if( $isa_ref and $isa_ref ne 'ARRAY' ) {\r
- croak( "Non-array reference ($isa_ref) passed to uri_for()" );\r
- }\r
- utf8::encode( $_ ) for grep { defined } $isa_ref ? @$value : $value;\r
+ for my $value ( values %$params ) {
+ for ( ref $value eq 'ARRAY' ? @$value : $value ) {
+ $_ = "$_";
+ utf8::encode( $_ );
+ }
};
# join args with '/', or a blank string
if ( $c->depth >= $RECURSION ) {
my $action = "$code";
- $action = "/$action" unless $action =~ /\-\>/;
+ $action = "/$action" unless $action =~ /->/;
my $error = qq/Deep recursion detected calling "$action"/;
$c->log->error($error);
$c->error($error);
return $c->state;
}
- my $stats_info = $c->_stats_start_execute( $code );
+ my $stats_info = $c->_stats_start_execute( $code ) if $c->debug;
push( @{ $c->stack }, $code );
eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
- $c->_stats_finish_execute( $stats_info );
+ $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info;
- my $last = ${ $c->stack }[-1];
- pop( @{ $c->stack } );
+ my $last = pop( @{ $c->stack } );
if ( my $error = $@ ) {
- if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
+ if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
else {
unless ( ref $error ) {
+ no warnings 'uninitialized';
chomp $error;
my $class = $last->class;
my $name = $last->name;
sub _stats_start_execute {
my ( $c, $code ) = @_;
- return unless $c->debug;
+ return if ( ( $code->name =~ /^_.*/ )
+ && ( !$c->config->{show_internal_actions} ) );
- my $action = "$code";
-
- $action = "/$action" unless $action =~ /\-\>/;
$c->counter->{"$code"}++;
+ my $action = "$code";
+ $action = "/$action" unless $action =~ /->/;
+
# 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
);
$node->setUID( "$code" . $c->counter->{"$code"} );
- unless ( ( $code->name =~ /^_.*/ )
- && ( !$c->config->{show_internal_actions} ) )
- {
- # is this a root-level call or a forwarded call?
- if ( $callsub =~ /forward$/ ) {
-
- # forward, locate the caller
- if ( my $parent = $c->stack->[-1] ) {
- my $visitor = Tree::Simple::Visitor::FindByUID->new;
- $visitor->searchForUID(
- "$parent" . $c->counter->{"$parent"} );
- $c->stats->accept($visitor);
- if ( my $result = $visitor->getResult ) {
- $result->addChild($node);
- }
- }
- else {
-
- # forward with no caller may come from a plugin
- $c->stats->addChild($node);
+ # is this a root-level call or a forwarded call?
+ if ( $callsub =~ /forward$/ ) {
+
+ # forward, locate the caller
+ if ( my $parent = $c->stack->[-1] ) {
+ my $visitor = Tree::Simple::Visitor::FindByUID->new;
+ $visitor->searchForUID(
+ "$parent" . $c->counter->{"$parent"} );
+ $c->stats->accept($visitor);
+ if ( my $result = $visitor->getResult ) {
+ $result->addChild($node);
}
}
else {
- # root-level call
+ # forward with no caller may come from a plugin
$c->stats->addChild($node);
}
}
+ else {
- my $start = [gettimeofday];
- my $elapsed = tv_interval($start);
+ # root-level call
+ $c->stats->addChild($node);
+ }
return {
- code => $code,
- elapsed => $elapsed,
- start => $start,
+ start => [gettimeofday],
node => $node,
- }
+ };
}
sub _stats_finish_execute {
my ( $c, $info ) = @_;
-
- return unless $c->debug;
-
- my ( $code, $start, $elapsed ) = @{ $info }{qw/code start elapsed/};
-
- unless ( ( $code->name =~ /^_.*/ )
- && ( !$c->config->{show_internal_actions} ) )
- {
-
- # FindByUID uses an internal die, so we save the existing error
- my $error = $@;
-
- # locate the node in the tree and update the elapsed time
- my $visitor = Tree::Simple::Visitor::FindByUID->new;
- $visitor->searchForUID( "$code" . $c->counter->{"$code"} );
- $c->stats->accept($visitor);
- if ( my $result = $visitor->getResult ) {
- my $value = $result->getNodeValue;
- $value->{elapsed} = sprintf( '%fs', $elapsed );
- $result->setNodeValue($value);
- }
-
- # restore error
- $@ = $error || undef;
- }
+ my $elapsed = tv_interval $info->{start};
+ my $value = $info->{node}->getNodeValue;
+ $value->{elapsed} = sprintf( '%fs', $elapsed );
}
=head2 $c->_localize_fields( sub { }, \%keys );
# Always expect worst case!
my $status = -1;
eval {
- my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
-
- my $handler = sub {
+ if ($class->debug) {
+ my $start = [gettimeofday];
my $c = $class->prepare(@arguments);
- $c->stats($stats);
+ $c->stats(Tree::Simple->new);
$c->dispatch;
- return $c->finalize;
- };
+ $status = $c->finalize;
- if ( $class->debug ) {
- my $start = [gettimeofday];
- $status = &$handler;
my $elapsed = tv_interval $start;
$elapsed = sprintf '%f', $elapsed;
my $av = sprintf '%.3f',
( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
- $stats->traverse(
+ $c->stats->traverse(
sub {
my $action = shift;
my $stat = $action->getNodeValue;
$class->log->info(
"Request took ${elapsed}s ($av/s)\n" . $t->draw );
}
- else { $status = &$handler }
-
+ else {
+ my $c = $class->prepare(@arguments);
+ $c->dispatch;
+ $status = $c->finalize;
+ }
};
if ( my $error = $@ ) {
=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
+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.
=cut
);
for my $component ( sort { length $a <=> length $b } $locator->plugins ) {
- Catalyst::Utils::ensure_class_loaded( $component );
+ Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
my $module = $class->setup_component( $component );
my %modules = (
=head2 $c->stack
-Returns an arrayref of the internal execution stack (actions that are currently
-executing).
+Returns an arrayref of the internal execution stack (actions that are
+currently executing).
=head2 $c->write( $data )
=head1 THREAD SAFETY
-Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
-and the standalone forking HTTP server on Windows. We believe the Catalyst
-core to be thread-safe.
+Catalyst has been tested under Apache 2's threading C<mpm_worker>,
+C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
+believe the Catalyst core to be thread-safe.
If you plan to operate in a threaded environment, remember that all other
modules you are using must also be thread-safe. Some modules, most notably