X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=a2fb6accb188706c0c13b61b260ce82bef652306;hp=09372ea7083b0331fda71a25fe2fb11bdcda59ab;hb=547f880602b1b5f8b89839829763b2e36dbd29e7;hpb=fbfacafd303a7ca1410b45e83ace4635e8a69da4
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 09372ea..a2fb6ac 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -12,13 +12,13 @@ use Catalyst::Utils;
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;
@@ -59,7 +59,9 @@ __PACKAGE__->engine_class('Catalyst::Engine::CGI');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
-our $VERSION = '5.6902';
+# Remember to update this in Catalyst::Runtime as well!
+
+our $VERSION = '5.7006';
sub import {
my ( $class, @arguments ) = @_;
@@ -85,6 +87,7 @@ Catalyst - The Elegant MVC Web Application Framework
=head1 SYNOPSIS
+ # Install Catalyst::Devel for helpers and other development tools
# use the helper to create a new application
catalyst.pl MyApp
@@ -169,7 +172,10 @@ See L
Welcome to the wonderful world of Catalyst.
+ Welcome to the world of Catalyst.
This MVC
framework will make web development something you had
never expected it to be: Fun, rewarding, and quick. That really depends on what you want to do.
We do, however, provide you with a few starting points. If you want to jump right into web development with Catalyst
- you might want to check out the documentation.
+ you might want want to start with a tutorial.perldoc Catalyst::Manual::Intro
-perldoc Catalyst::Manual::Tutorial
-perldoc Catalyst::Manual
perldoc Catalyst::Manual::Tutorial ++
Afterwards you can go on to check out a more complete look at our features.
+
+perldoc Catalyst::Manual::Intro
+
+
Next it's time to write an actual application. Use the
helper scripts to generate controllers,
@@ -1126,7 +1157,7 @@ sub execute {
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);
@@ -1134,21 +1165,21 @@ sub execute {
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;
@@ -1164,13 +1195,14 @@ sub execute {
sub _stats_start_execute {
my ( $c, $code ) = @_;
- return unless $c->debug;
-
- my $action = "$code";
+ return if ( ( $code->name =~ /^_.*/ )
+ && ( !$c->config->{show_internal_actions} ) );
- $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
@@ -1196,73 +1228,42 @@ sub _stats_start_execute {
);
$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 );
@@ -1317,6 +1318,24 @@ sub finalize {
$c->finalize_body;
}
+
+ if ($c->debug) {
+ my $elapsed = sprintf '%f', tv_interval($c->stats->getNodeValue);
+ my $av = sprintf '%.3f', ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
+
+ my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
+ $c->stats->traverse(
+ sub {
+ my $action = shift;
+ my $stat = $action->getNodeValue;
+ $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
+ $stat->{elapsed} || '??' );
+ }
+ );
+
+ $c->log->info(
+ "Request took ${elapsed}s ($av/s)\n" . $t->draw . "\n" );
+ }
return $c->response->status;
}
@@ -1444,38 +1463,16 @@ sub handle_request {
# Always expect worst case!
my $status = -1;
eval {
- my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
-
- my $handler = sub {
- my $c = $class->prepare(@arguments);
- $c->stats($stats);
- $c->dispatch;
- return $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(
- sub {
- my $action = shift;
- my $stat = $action->getNodeValue;
- $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
- $stat->{elapsed} || '??' );
- }
- );
-
- $class->log->info(
- "Request took ${elapsed}s ($av/s)\n" . $t->draw );
+ if ($class->debug) {
+ my $secs = time - $START || 1;
+ my $av = sprintf '%.3f', $COUNT / $secs;
+ my $time = localtime time;
+ $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
}
- else { $status = &$handler }
+ my $c = $class->prepare(@arguments);
+ $c->dispatch;
+ $status = $c->finalize;
};
if ( my $error = $@ ) {
@@ -1529,20 +1526,17 @@ sub prepare {
}
);
+ if ( $c->debug ) {
+ $c->stats(Tree::Simple->new([gettimeofday]));
+ $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
+ }
+
# For on-demand data
$c->request->{_context} = $c;
$c->response->{_context} = $c;
weaken( $c->request->{_context} );
weaken( $c->response->{_context} );
- if ( $c->debug ) {
- my $secs = time - $START || 1;
- my $av = sprintf '%.3f', $COUNT / $secs;
- my $time = localtime time;
- $c->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
- $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
- }
-
# Allow engine to direct the prepare flow (for POE)
if ( $c->engine->can('prepare') ) {
$c->engine->prepare( $c, @arguments );
@@ -1801,23 +1795,30 @@ sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
=head2 $c->setup_components
-Sets up components.
+Sets up components. Specify a C