use Carp;
use Moose::Role;
use Class::MOP;
+use Scalar::Util 'blessed';
use Module::Pluggable::Object;
-our $VERSION = '0.0007';
+our $VERSION = '0.0011';
=head1 NAME
they will instead return the name of the anonymous class created at runtime.
See C<_original_class_name>.
-=head1 Notice regarding extensions.
-
-Because I have been able to identify a real-world use case for the extension mechanism
-I have decided to deprecate it and remove it in the next major release.
-
=head1 Usage
For a simple example see the tests included in this distribution.
String. The prefix to use for plugin names provided. MyApp::Plugin is sensible.
-=head2 _plugin_ext
-
-Boolean. Indicates whether we should attempt to load plugin extensions.
-Defaults to true;
-
-=head2 _plugin_ext_ns
-
-B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
-this, please email me, but I am fairly sure that nobody uses this at
-all and it's just adding bloat and making things kind of ugly.
-
-String. The namespace plugin extensions have. Defaults to 'ExtensionFor'.
-
-This means that is _plugin_ns is "MyApp::Plugin" and _plugin_ext_ns is
-"ExtensionFor" loading plugin "Bar" would search for extensions in
-"MyApp::Plugin::Bar::ExtensionFor::*".
-
=head2 _plugin_app_ns
ArrayRef, Accessor automatically dereferences into array on a read call.
take presedence upon namespace collitions. This allows you to subclass a pluggable
class and still use it's plugins while using yours first if they are available.
-=cut
-
=head2 _plugin_locator
An automatically built instance of L<Module::Pluggable::Object> used to locate
available plugins.
+=head2 _original_class_name
+
+Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
+no longer return what you expect. Instead, upon instantiation, the name of the
+class instantiated will be stored in this attribute if you need to access the
+name the class held before any runtime roles were applied.
+
=cut
#--------#---------#---------#---------#---------#---------#---------#---------#
-has _plugin_ns => (is => 'rw', required => 1, isa => 'Str',
- default => 'Plugin');
-has _plugin_ext => (is => 'rw', required => 1, isa => 'Bool',
- default => 1);
-has _plugin_ext_ns => (is => 'rw', required => 1, isa => 'Str',
- default => 'ExtensionFor');
-has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
- default => sub{ {} });
-has _plugin_app_ns => (is => 'rw', required => 1, isa => 'ArrayRef', lazy => 1,
- auto_deref => 1,
- default => sub{ shift->_build_plugin_app_ns },
- trigger => sub{ $_[0]->_clear_plugin_locator
- if $_[0]->_has_plugin_locator; },
- );
-has _plugin_locator => (is => 'rw', required => 1, lazy => 1,
- isa => 'Module::Pluggable::Object',
- clearer => '_clear_plugin_locator',
- predicate => '_has_plugin_locator',
- default => sub{ shift->_build_plugin_locator });
+has _plugin_ns => (
+ is => 'rw',
+ required => 1,
+ isa => 'Str',
+ default => sub{ 'Plugin' },
+);
+
+has _original_class_name => (
+ is => 'ro',
+ required => 1,
+ isa => 'Str',
+ default => sub{ blessed($_[0]) },
+);
+
+has _plugin_loaded => (
+ is => 'rw',
+ required => 1,
+ isa => 'HashRef',
+ default => sub{ {} }
+);
+
+has _plugin_app_ns => (
+ is => 'rw',
+ required => 1,
+ isa => 'ArrayRef',
+ lazy => 1,
+ auto_deref => 1,
+ builder => '_build_plugin_app_ns',
+ trigger => sub{ $_[0]->_clear_plugin_locator if $_[0]->_has_plugin_locator; },
+);
+
+has _plugin_locator => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ isa => 'Module::Pluggable::Object',
+ clearer => '_clear_plugin_locator',
+ predicate => '_has_plugin_locator',
+ builder => '_build_plugin_locator'
+);
#--------#---------#---------#---------#---------#---------#---------#---------#
=head1 Public Methods
-=head2 load_plugin $plugin
-
-Load the apropriate role for C<$plugin> as well as any extensions it provides
-if extensions are enabled.
-
-=cut
-
-sub load_plugin{
- my ($self, $plugin) = @_;
- die("You must provide a plugin name") unless $plugin;
-
- my $loaded = $self->_plugin_loaded;
- return 1 if exists $loaded->{$plugin};
-
- my $role = $self->_role_from_plugin($plugin);
-
- $loaded->{$plugin} = $role if $self->_load_and_apply_role($role);
- $self->load_plugin_ext($plugin) if $self->_plugin_ext;
-
- return exists $loaded->{$plugin};
-}
-
=head2 load_plugins @plugins
-Load all C<@plugins>.
+=head2 load_plugin $plugin
+
+Load the apropriate role for C<$plugin>.
=cut
-
sub load_plugins {
- my $self = shift;
- $self->load_plugin($_) for @_;
-}
-
-
-=head2 load_plugin_ext
+ my ($self, @plugins) = @_;
+ die("You must provide a plugin name") unless @plugins;
-B<THIS FUNCTIONALITY HAS BEEN DEPRECATED AND WILL GO AWAY.> If you use
-this, please email me, but I am fairly sure that nobody uses this at
-all and it's just adding bloat and making things kind of ugly.
-
-Will load any extensions for a particular plugin. This should be called
-automatically by C<load_plugin> so you don't need to worry about it.
-It basically attempts to load any extension that exists for a plugin
-that is already loaded. The only reason for using this is if you want to
-keep _plugin_ext as false and only load extensions manually, which I don't
-recommend.
+ my $loaded = $self->_plugin_loaded;
+ my @load = grep { not exists $loaded->{$_} } @plugins;
+ my @roles = map { $self->_role_from_plugin($_) } @load;
-=cut
+ return if @roles == 0;
-sub load_plugin_ext{
- my ($self, $plugin) = @_;
- die("You must provide a plugin name") unless $plugin;
- my $role = $self->_plugin_loaded->{$plugin};
-
- # $p for plugin, $r for role
- while( my($p,$r) = each %{ $self->_plugin_loaded }){
-
- my $ext = join "::", $role, $self->_plugin_ext_ns, $p;
- if( $plugin =~ /^\+(.*)/ ){
- eval{ $self->_load_and_apply_role( $ext ) };
- } else{
- $self->_load_and_apply_role( $ext ) if
- grep{ /^${ext}$/ } $self->_plugin_locator->plugins;
- }
-
- #go back to prev loaded modules and load extensions for current module?
- #my $ext2 = join "::", $r, $self->_plugin_ext_ns, $plugin;
- #$self->_load_and_apply_role( $ext2 )
- # if Class::Inspector->installed($ext2);
+ if ( $self->_load_and_apply_role(@roles) ) {
+ @{ $loaded }{@load} = @roles;
+ return 1;
+ } else {
+ return;
}
}
-=head2 _original_class_name
-
-Because of the way roles apply C<$self-E<gt>blessed> and C<ref $self> will
-no longer return what you expect. Instead use this class to get your original
-class name.
-
-=cut
-sub _original_class_name{
- my $self = shift;
- return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0];
+sub load_plugin {
+ my $self = shift;
+ $self->load_plugins(@_);
}
-
=head1 Private Methods
There's nothing stopping you from using these, but if you are using them
for anything thats not really complicated you are probably doing
-something wrong. Some of these may be inlined in the future if performance
-becomes an issue (which I doubt).
+something wrong.
=head2 _role_from_plugin $plugin
return shift @roles;
}
-=head2 _load_and_apply_role $role
+=head2 _load_and_apply_role @roles
Require C<$role> if it is not already loaded and apply it. This is
the meat of this module.
=cut
sub _load_and_apply_role{
- my ($self, $role) = @_;
- die("You must provide a role name") unless $role;
+ my ($self, @roles) = @_;
+ die("You must provide a role name") unless @roles;
- eval { Class::MOP::load_class($role) };
- confess("Failed to load role: ${role} $@") if $@;
+ foreach my $role ( @roles ) {
+ eval { Class::MOP::load_class($role) };
+ confess("Failed to load role: ${role} $@") if $@;
- carp("Using 'override' is strongly discouraged and may not behave ".
- "as you expect it to. Please use 'around'")
+ carp("Using 'override' is strongly discouraged and may not behave ".
+ "as you expect it to. Please use 'around'")
if scalar keys %{ $role->meta->get_override_method_modifiers_map };
+ }
+
+ Moose::Util::apply_all_roles( $self, @roles );
- $role->meta->apply( $self );
return 1;
}
=item Stevan Little - EVERYTHING. Without him this would have never happened.
+=item Shawn M Moore - bugfixes
+
=back
=head1 COPYRIGHT