File Coverage

blib/lib/Catalyst/Plugin/PluginLoader.pm

Criterion	Covered	Total	%
statement	66	74	89.1
branch	11	20	55.0
condition	4	8	50.0
subroutine	11	11	100.0
pod	0	1	0.0
total	92	114	80.7

package Catalyst::Plugin::PluginLoader;

use strict;
use warnings;
use MRO::Compat ();
use Catalyst::Utils ();
use Scalar::Util 'reftype';
use Moose::Util qw/find_meta apply_all_roles/;

use namespace::clean -except => 'meta';

our $VERSION = '0.04';

=head1 NAME

Catalyst::Plugin::PluginLoader - Load Catalyst Plugins from Config

=head1 SYNOPSIS

  <Plugin::PluginLoader>
      plugins Session
      plugins Session::Store::FastMmap
      plugins Session::State::Cookie
  </Plugin::PluginLoader>

  use Catalyst qw/ConfigLoader PluginLoader/;

=head1 DESCRIPTION

Allows you to load L<Catalyst> plugins from your app config file.

Plugin order is the same as if you put the plugins after PluginLoader in the
C<use Catalyst> line.

Roles will be loaded as well, however C<around 'setup'> will not work yet.

This is a B<COLOSSAL HACK>, use at your own risk.

Please report bugs at L<http://rt.cpan.org/>.

=cut

sub setup {
  my $class = shift;

  if (my $plugins = $class->config->{'Plugin::PluginLoader'}{plugins}) {
    my %old_plugins = %{ $class->_plugins };

    $plugins = [ $plugins ] unless ref $plugins;

    Catalyst::Exception->throw(
      'plugins must be an arrayref'
    ) if reftype $plugins ne 'ARRAY';

    $plugins = [ map {
        s/\A\+// ? $_ : "Catalyst::Plugin::$_"
    } grep { !exists $old_plugins{$_} } @$plugins ];

    my $isa = do { no strict 'refs'; \@{$class.'::ISA'}};

    my $isa_idx = 0;
    $isa_idx++ while $isa->[$isa_idx] ne __PACKAGE__;

    for my $plugin (@$plugins) {
      Catalyst::Utils::ensure_class_loaded($plugin);
      $class->_plugins->{$plugin} = 1;

      my $meta = find_meta($plugin);

      if ($meta && blessed $meta && $meta->isa('Moose::Meta::Role')) {
        apply_all_roles($class => $plugin);
      } else {
        splice @$isa, ++$isa_idx, 0, $plugin;
      }
    }

    unshift @$isa, shift @$isa; # necessary to tell perl that @ISA changed
    mro::invalidate_all_method_caches();

    if ($class->debug) {
      my @plugins = map { "$_  " . ( $_->VERSION || '' ) } @$plugins;

      if (@plugins) {
        my $t = Text::SimpleTable->new(74);
        $t->row($_) for @plugins;
        $class->log->debug( "Loaded plugins from config:\n" . $t->draw . "\n" );
      }
    }

    {
# ->next::method won't work anymore, we have to do it ourselves
      my @precedence_list = $class->meta->class_precedence_list;

      1 while shift @precedence_list ne __PACKAGE__;

      my $old_next_method = \&maybe::next::method;

      my $next_method = sub {
        if ((caller(1))[3] !~ /::setup\z/) {
          goto &$old_next_method;
        }

        my $code;
        while (my $next_class = shift @precedence_list) {
          $code = $next_class->can('setup');
          last if $code;
        }
        return unless $code;

        goto &$code;
      };

      no warnings 'redefine';
      local *next::method           = $next_method;
      local *maybe::next::method    = $next_method;

      return $class->next::method(@_);
    }
  }

  return $class->next::method(@_);
}

=head1 SEE ALSO

L<Catalyst>, L<Catalyst::Plugin::ConfigLoader>,
L<Catalyst::Manual::ExtendingCatalyst>

=head1 TODO

Better tests.

=head1 AUTHOR

Ash Berlin, C<ash at cpan.org>

Rafael Kitover, C<rkitover at cpan.org>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
# vim:sw=2 sts=2: