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 Path::Class;
use Time::HiRes qw/gettimeofday tv_interval/;
use URI;
-use Scalar::Util qw/weaken/;
+use Scalar::Util qw/weaken blessed/;
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/
require Module::Pluggable::Fast;
# Helper script generation
-our $CATALYST_SCRIPT_GEN = 25;
+our $CATALYST_SCRIPT_GEN = 27;
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
- engine_class context_class request_class response_class/;
+ engine_class context_class request_class response_class setup_finished/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
__PACKAGE__->engine_class('Catalyst::Engine::CGI');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
-our $VERSION = '5.62';
+our $VERSION = '5.66';
sub import {
my ( $class, @arguments ) = @_;
unless ( $caller->isa('Catalyst') ) {
no strict 'refs';
- push @{"$caller\::ISA"}, $class;
+ push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
}
$caller->arguments( [@arguments] );
use Catalyst qw/My::Module/;
+If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
+fully qualify the name by using a unary plus:
+
+ use Catalyst qw/
+ My::Module
+ +Fully::Qualified::Plugin::Name
+ /;
+
Special flags like C<-Debug> and C<-Engine> can also be specified as
arguments when Catalyst is loaded:
=head1 METHODS
-=head2 Information about the current request
+=head2 INFORMATION ABOUT THE CURRENT REQUEST
=head2 $c->action
Returns the current L<Catalyst::Request> object. See
L<Catalyst::Request>.
-=head2 Processing and response to the current request
+=head2 PROCESSING AND RESPONSE TO THE CURRENT REQUEST
=head2 $c->forward( $action [, \@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');
Contains the return value of the last executed action.
-=head2 Component Accessors
+=cut
+
+# search via regex
+sub _comp_search {
+ my ($c, @names) = @_;
+
+ foreach my $name (@names) {
+ foreach my $component ( keys %{ $c->components } ) {
+ my $comp = $c->components->{$component} if $component =~ /$name/i;
+ if ($comp) {
+ if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
+ }
+ }
+ }
+
+ return undef;
+}
+
+# try explicit component names
+sub _comp_explicit {
+ my ($c, @names) = @_;
+
+ foreach my $try (@names) {
+ if ( exists $c->components->{$try} ) {
+ my $comp = $c->components->{$try};
+ if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
+ }
+ }
+
+ return undef;
+}
+
+# like component, but try just these prefixes before regex searching,
+# and do not try to return "sort keys %{ $c->components }"
+sub _comp_prefixes {
+ my ($c, $name, @prefixes) = @_;
+
+ my $appclass = ref $c || $c;
+
+ my @names = map { "${appclass}::${_}::${name}" } @prefixes;
+
+ my $comp = $c->_comp_explicit(@names);
+ return $comp if defined($comp);
+ $comp = $c->_comp_search($name);
+ return $comp;
+}
+
+=head2 COMPONENT ACCESSORS
=head2 $c->comp($name)
qw/Model M Controller C View V/
);
- foreach my $try (@names) {
-
- if ( exists $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 } ) {
- 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 }
- }
- }
+ my $comp = $c->_comp_explicit(@names);
+ return $comp if defined($comp);
+ $comp = $c->_comp_search($name);
+ return $comp if defined($comp);
}
return sort keys %{ $c->components };
sub controller {
my ( $c, $name ) = @_;
- my $controller = $c->comp("Controller::$name");
- return $controller if defined $controller;
- return $c->comp("C::$name");
+ return $c->_comp_prefixes($name, qw/Controller C/);
}
=head2 $c->model($name)
sub model {
my ( $c, $name ) = @_;
- my $model = $c->comp("Model::$name");
- return $model if defined $model;
- return $c->comp("M::$name");
+ return $c->_comp_prefixes($name, qw/Model M/);
}
=head2 $c->view($name)
sub view {
my ( $c, $name ) = @_;
- my $view = $c->comp("View::$name");
- return $view if defined $view;
- return $c->comp("V::$name");
+ return $c->_comp_prefixes($name, qw/View V/);
}
=head2 Class data and helper classes
Returns or takes a hashref containing the application's configuration.
- __PACKAGE__->config({ db => 'dsn:SQLite:foo.db' });
+ __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
+
+=cut
+
+sub config {
+ my $c = shift;
+
+ $c->log->warn("Setting config after setup has been run is not a good idea.")
+ if ( @_ and $c->setup_finished );
+
+ $c->NEXT::config(@_);
+}
=head2 $c->debug
=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
=cut
-=head2 Utility methods
+=head2 UTILITY METHODS
=head2 $c->path_to(@path)
sub plugin {
my ( $class, $name, $plugin, @args ) = @_;
- $plugin->require;
-
- if ( my $error = $UNIVERSAL::require::ERROR ) {
- Catalyst::Exception->throw(
- message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
- }
+ $class->_register_plugin( $plugin, 1 );
eval { $plugin->import };
$class->mk_classdata($name);
$class->setup_home( delete $flags->{home} );
- # YAML config support
- my $conffile = $class->config->{file}
- || ( Catalyst::Utils::appprefix( ref $class || $class ) . '.yml' );
- my $confpath = $class->path_to($conffile);
- 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->log->info("$name powered by Catalyst $Catalyst::VERSION");
}
$class->log->_flush() if $class->log->can('_flush');
+
+ $class->setup_finished(1);
}
=head2 $c->uri_for( $path, [ @args ] )
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.
+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.
=cut
$namespace = '' if $path =~ /^\//;
$path =~ s/^\///;
+ my $params =
+ ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
+
# join args with '/', or a blank string
my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
$args =~ s/^\/// unless $path;
my $res =
URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base )
->canonical;
+ $res->query_form(%$params);
$res;
}
<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);
+ if ($c->depth >= $RECURSION) {
+ my $action = "$code";
+ $action = "/$action" unless $action =~ /\-\>/;
+ my $error = qq/Deep recursion detected calling "$action"/;
+ $c->log->error($error);
+ $c->error($error);
+ $c->state(0);
+ return $c->state;
+ }
+
+
if ( $c->debug ) {
my $action = "$code";
$action = "/$action" unless $action =~ /\-\>/;
$c->counter->{"$code"}++;
- if ( $c->counter->{"$code"} > $RECURSION ) {
- my $error = qq/Deep recursion detected in "$action"/;
- $c->log->error($error);
- $c->error($error);
- $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;
+ # 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 $callsub = ( caller($callsub_index) )[3];
-
- $action = "-> $action" if $callsub =~ /forward$/;
my $node = Tree::Simple->new(
{
if ( $c->response->body && !$c->response->content_length ) {
# get the length from a filehandle
- if ( ref $c->response->body && $c->response->body->can('read') ) {
+ if ( blessed($c->response->body) && $c->response->body->can('read') ) {
if ( my $stat = stat $c->response->body ) {
$c->response->content_length( $stat->size );
}
sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
-=head2 handle_request( $class, @arguments )
+=head2 $c->handle_request( $class, @arguments )
Called to handle each HTTP request.
my $callback = sub {
my ( $component, $context ) = @_;
- unless ( $component->isa('Catalyst::Component') ) {
+ unless ( $component->can('COMPONENT') ) {
return $component;
}
}
Catalyst::Exception->throw( message =>
-qq/Couldn't instantiate component "$component", "new() didn't return a object"/
+qq/Couldn't instantiate component "$component", "COMPONENT() didn't return a object"/
)
unless ref $instance;
return $instance;
=cut
-sub setup_plugins {
- my ( $class, $plugins ) = @_;
+=head2 $c->registered_plugins
+
+Returns a sorted list of the plugins which have either been stated in the
+import list or which have been added via C<< MyApp->plugin(@args); >>.
+
+If passed a given plugin name, it will report a boolean value indicating
+whether or not that plugin is loaded. A fully qualified name is required if
+the plugin name does not begin with C<Catalyst::Plugin::>.
+
+ if ($c->registered_plugins('Some::Plugin')) {
+ ...
+ }
+
+=cut
+
+{
- $plugins ||= [];
- for my $plugin ( reverse @$plugins ) {
+ sub registered_plugins {
+ my $proto = shift;
+ return sort keys %{$proto->_plugins} unless @_;
+ my $plugin = shift;
+ return 1 if exists $proto->_plugins->{$plugin};
+ return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
+ }
- $plugin = "Catalyst::Plugin::$plugin";
+ sub _register_plugin {
+ my ( $proto, $plugin, $instant ) = @_;
+ my $class = ref $proto || $proto;
$plugin->require;
- if ($@) {
+ if ( my $error = $@ ) {
+ my $type = $instant ? "instant " : '';
Catalyst::Exception->throw(
- message => qq/Couldn't load plugin "$plugin", "$@"/ );
+ message => qq/Couldn't load ${type}plugin "$plugin", $error/ );
}
- {
+ $proto->_plugins->{$plugin} = 1;
+ unless ($instant) {
no strict 'refs';
unshift @{"$class\::ISA"}, $plugin;
}
+ return $class;
+ }
+
+ sub setup_plugins {
+ my ( $class, $plugins ) = @_;
+
+ $class->_plugins( {} ) unless $class->_plugins;
+ $plugins ||= [];
+ for my $plugin ( reverse @$plugins ) {
+
+ unless ( $plugin =~ s/\A\+// ) {
+ $plugin = "Catalyst::Plugin::$plugin";
+ }
+
+ $class->_register_plugin($plugin);
+ }
}
}
=head2 $c->stack
-Returns the stack.
+Returns an arrayref of the internal execution stack (actions that are currently
+executing).
=head2 $c->write( $data )
Brian Cassidy
+Carl Franks
+
Christian Hansen
Christopher Hicks
projects / catagits/Catalyst-Runtime.git / blobdiff