__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
-our $VERSION = '5.64';
+our $VERSION = '5.66';
sub import {
my ( $class, @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:
Contains the return value of the last executed action.
+=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 ( eval { $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
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);
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 : {});
+ my $params =
+ ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
# join args with '/', or a blank string
my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
=cut
-sub setup_plugins {
- my ( $class, $plugins ) = @_;
+=head2 $c->registered_plugins
- $plugins ||= [];
- for my $plugin ( reverse @$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); >>.
- $plugin = "Catalyst::Plugin::$plugin";
+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
+
+{
+ my %PLUGINS;
+
+ sub registered_plugins {
+ my $proto = shift;
+ return sort keys %PLUGINS unless @_;
+ my $plugin = shift;
+ return 1 if exists $PLUGINS{$plugin};
+ return exists $PLUGINS{"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/ );
}
- {
+ $PLUGINS{$plugin} = 1;
+ unless ($instant) {
no strict 'refs';
unshift @{"$class\::ISA"}, $plugin;
}
+ return $class;
+ }
+
+ sub setup_plugins {
+ my ( $class, $plugins ) = @_;
+
+ $plugins ||= [];
+ for my $plugin ( reverse @$plugins ) {
+
+ unless ( $plugin =~ s/\A\+// ) {
+ $plugin = "Catalyst::Plugin::$plugin";
+ }
+
+ $class->_register_plugin($plugin);
+ }
}
}