package Catalyst;
use strict;
-use base 'Catalyst::Base';
+use base 'Catalyst::Component';
use bytes;
use UNIVERSAL::require;
use Catalyst::Exception;
use Catalyst::Request::Upload;
use Catalyst::Response;
use Catalyst::Utils;
+use Catalyst::Controller;
use File::stat;
use NEXT;
use Text::SimpleTable;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
use attributes;
+use YAML ();
__PACKAGE__->mk_accessors(
qw/counter request response state action stack namespace/
unless ( $caller->isa('Catalyst') ) {
no strict 'refs';
- push @{"$caller\::ISA"}, $class;
+ push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
}
$caller->arguments( [@arguments] );
C<$c-E<gt>req-E<gt>args>. Upon returning from the function,
C<$c-E<gt>req-E<gt>args> will be restored to the previous values.
- $c->forward('/foo');
+Any data C<return>ed from the action forwarded to, will be returned by the
+call to forward.
+
+ my $foodata = $c->forward('/foo');
$c->forward('index');
$c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
$c->forward('MyApp::View::TT');
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 }
+ }
}
}
__PACKAGE__->config({ db => 'dsn:SQLite:foo.db' });
+You can also use a L<YAML> config file like myapp.yml in your
+applications home directory.
+
+ ---
+ db: dsn:SQLite:foo.db
+
=head2 $c->debug
Overload to enable debug messages (same as -Debug option).
=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:
+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 );
+ __PACKAGE__->setup;
+
+And later:
- $c->log( MyLogger->new );
$c->log->info( 'Now logging with my own logger!' );
Your log class should implement the methods described in the
}
}
+ $class->setup_home( delete $flags->{home} );
+
+ # YAML config support
+ my $confpath = $class->config->{file}
+ || $class->path_to(
+ ( Catalyst::Utils::appprefix( ref $class || $class ) . '.yml' ) );
+ my $conf = {};
+ $conf = YAML::LoadFile($confpath) if -f $confpath;
+ my $oldconf = $class->config;
+ $class->config( { %$oldconf, %$conf } );
+
$class->setup_log( delete $flags->{log} );
$class->setup_plugins( delete $flags->{plugins} );
$class->setup_dispatcher( delete $flags->{dispatcher} );
$class->setup_engine( delete $flags->{engine} );
- $class->setup_home( delete $flags->{home} );
for my $flag ( sort keys %{$flags} ) {
{
no strict 'refs';
- @plugins =
- map { $_ . ' ' . ( $_->VERSION || '' ) }
- grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
+ @plugins =
+ map { $_ . ' ' . ( $_->VERSION || '' ) }
+ grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
}
if (@plugins) {
<p>If you want to jump right into web development with Catalyst
you might want to check out the documentation.</p>
<pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
+perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
<h2>What to do next?</h2>
<p>Next it's time to write an actual application. Use the
sub execute {
my ( $c, $class, $code ) = @_;
- $class = $c->components->{$class} || $class;
+ $class = $c->component($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;
}
- $action = "-> $action" if $callsub =~ /forward$/;
+ # 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
+ my $callsub = q{};
+ for my $index ( 1 .. 10 ) {
+ last
+ if ( ( caller($index) )[0] eq 'Catalyst'
+ && ( caller($index) )[3] eq '(eval)' );
+
+ if ( ( caller($index) )[3] =~ /forward$/ ) {
+ $callsub = ( caller($index) )[3];
+ $action = "-> $action";
+ last;
+ }
+ }
- my $node = Tree::Simple->new( {
- action => $action,
- elapsed => undef, # to be filled in later
- } );
+ 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(
+ $visitor->searchForUID(
"$parent" . $c->counter->{"$parent"} );
- $c->{stats}->accept( $visitor );
+ $c->{stats}->accept($visitor);
if ( my $result = $visitor->getResult ) {
- $result->addChild( $node );
+ $result->addChild($node);
}
}
else {
+
# forward with no caller may come from a plugin
- $c->{stats}->addChild( $node );
+ $c->{stats}->addChild($node);
}
}
else {
+
# root-level call
- $c->{stats}->addChild( $node );
+ $c->{stats}->addChild($node);
}
}
}
-
+
push( @{ $c->stack }, $code );
my $elapsed = 0;
my $start = 0;
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 );
+ $c->{stats}->accept($visitor);
if ( my $result = $visitor->getResult ) {
my $value = $result->getNodeValue;
$value->{elapsed} = sprintf( '%fs', $elapsed );
- $result->setNodeValue( $value );
+ $result->setNodeValue($value);
}
-
+
# restore error
$@ = $error || undef;
}
# Always expect worst case!
my $status = -1;
eval {
- my $stats = ( $class->debug ) ? Tree::Simple->new : q{};
+ my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
my $handler = sub {
my $c = $class->prepare(@arguments);
my $av = sprintf '%.3f',
( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
-
- $stats->traverse( sub {
- my $action = shift;
- my $stat = $action->getNodeValue;
- $t->row(
- ( q{ } x $action->getDepth ) . $stat->{action},
- $stat->{elapsed} || '??'
- );
- } );
-
+
+ $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 $callback = sub {
my ( $component, $context ) = @_;
- unless ( $component->isa('Catalyst::Component') ) {
+ unless ( $component->can('COMPONENT') ) {
return $component;
}
my $instance;
- eval { $instance = $component->new( $context, $config ); };
+ eval { $instance = $component->COMPONENT( $context, $config ); };
if ( my $error = $@ ) {
if ( $software eq 'mod_perl' ) {
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}/ );
projects / catagits/Catalyst-Runtime.git / blobdiff