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(
if ( exists $c->components->{$try} ) {
- return $c->components->{$try};
+ my $comp = $c->components->{$try};
+ if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
}
}
foreach my $component ( keys %{ $c->components } ) {
-
- return $c->components->{$component} if $component =~ /$name/i;
+ my $comp;
+ $comp = $c->components->{$component} if $component =~ /$name/i;
+ if ($comp) {
+ if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
+ }
}
}
{
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"}++;
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 ) {
chomp $error;
- $error = qq/Caught exception "$error"/;
+ my $class = $last->class;
+ my $name = $last->name;
+ $error = qq/Caught exception in $class->$name "$error"/;
}
$c->error($error);
$c->state(0);
# 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;
};
( $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 );
}
my $instance;
- eval { $instance = $component->new( $context, $config ); };
+ eval { $instance = $component->COMPONENT( $context, $config ); };
if ( my $error = $@ ) {
$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';
- }
+ if ( !$engine ) {
- elsif ( $version >= 1.9901 ) {
- $engine = 'Catalyst::Engine::Apache2::MP19';
- }
+ if ( $version >= 1.99922 ) {
+ $engine = 'Catalyst::Engine::Apache2::MP20';
+ }
- elsif ( $version >= 1.24 ) {
- $engine = 'Catalyst::Engine::Apache::MP13';
- }
+ 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