use Time::HiRes qw/gettimeofday tv_interval/;
use URI;
use Scalar::Util qw/weaken/;
+use Tree::Simple qw/use_weak_refs/;
+use Tree::Simple::Visitor::FindByUID;
use attributes;
__PACKAGE__->mk_accessors(
{
no strict 'refs';
- @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
+ @plugins =
+ map { $_ . ' ' . ( $_->VERSION || '' ) }
+ grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
}
if (@plugins) {
<p>Welcome to the wonderful world of Catalyst.
This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
framework will make web development something you had
- never expected it to be: Fun, rewarding and quick.</p>
+ never expected it to be: Fun, rewarding, and quick.</p>
<h2>What to do now?</h2>
<p>That really depends on what <b>you</b> want to do.
We do, however, provide you with a few starting points.</p>
<h2>What to do next?</h2>
<p>Next it's time to write an actual application. Use the
helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
- <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
- <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
+ <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
+ <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
they can save you a lot of work.</p>
<pre><code>script/${prefix}_create.pl -help</code></pre>
<p>Also, be sure to check out the vast and growing
- collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
+ collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
you are likely to find what you need there.
</p>
$class = $c->components->{$class} || $class;
$c->state(0);
- my $callsub =
- ( caller(0) )[0]->isa('Catalyst::Action')
- ? ( caller(2) )[3]
- : ( caller(1) )[3];
-
- my $action = '';
if ( $c->debug ) {
- $action = "$code";
+ my $action = "$code";
$action = "/$action" unless $action =~ /\-\>/;
$c->counter->{"$code"}++;
$c->state(0);
return $c->state;
}
+
+ # determine if the call was the result of a forward
+ my $callsub_index = ( caller(0) )[0]->isa('Catalyst::Action') ? 2 : 1;
+ if ( ( caller($callsub_index) )[3] =~ /^NEXT/ ) {
+ # work around NEXT if execute was extended by a plugin
+ $callsub_index += 3;
+ }
+ my $callsub = ( caller($callsub_index) )[3];
$action = "-> $action" if $callsub =~ /forward$/;
+
+ my $node = Tree::Simple->new( {
+ action => $action,
+ elapsed => undef, # to be filled in later
+ } );
+ $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 );
+ }
+ }
+ else {
+ # root-level call
+ $c->{stats}->addChild( $node );
+ }
+ }
}
+
push( @{ $c->stack }, $code );
my $elapsed = 0;
my $start = 0;
unless ( ( $code->name =~ /^_.*/ )
&& ( !$c->config->{show_internal_actions} ) )
{
- push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
+ # 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 $last = ${ $c->stack }[-1];
pop( @{ $c->stack } );
if ( my $error = $@ ) {
-
if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
else {
unless ( ref $error ) {
# Always expect worst case!
my $status = -1;
eval {
- my @stats = ();
+ my $stats = ( $class->debug ) ? Tree::Simple->new : q{};
my $handler = sub {
my $c = $class->prepare(@arguments);
- $c->{stats} = \@stats;
+ $c->{stats} = $stats;
$c->dispatch;
return $c->finalize;
};
my $av = sprintf '%.3f',
( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
-
- for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
+
+ $stats->traverse( sub {
+ my $action = shift;
+ my $stat = $action->getNodeValue;
+ $t->row(
+ ( q{ } x $action->getDepth ) . $stat->{action},
+ $stat->{elapsed} || '??'
+ );
+ } );
+
$class->log->info(
"Request took ${elapsed}s ($av/s)\n" . $t->draw );
}
$engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
}
- if ( !$engine && $ENV{MOD_PERL} ) {
+ if ( $ENV{MOD_PERL} ) {
# create the apache method
{
if ( $software eq 'mod_perl' ) {
- 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';
- }
+ 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}/ );
+ }
- else {
- Catalyst::Exception->throw( message =>
- qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
}
# install the correct mod_perl handler
projects / catagits/Catalyst-Runtime.git / blobdiff