X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FObject%2FPluggable.pm;h=7734ab7360d4fab82ce7180b272e61cf9e64d521;hb=a5160cacc28215054c119481c6d4dcf1bf764be3;hp=437601b3b3cfbd037896f2d786e1d5b326ada6eb;hpb=e091956e1d9f0d4920288714bdf946d4d2570f71;p=gitmo%2FMooseX-Object-Pluggable.git diff --git a/lib/MooseX/Object/Pluggable.pm b/lib/MooseX/Object/Pluggable.pm index 437601b..7734ab7 100644 --- a/lib/MooseX/Object/Pluggable.pm +++ b/lib/MooseX/Object/Pluggable.pm @@ -2,10 +2,11 @@ package MooseX::Object::Pluggable; use Carp; use Moose::Role; -use Class::MOP; +use Class::Load 'load_class'; +use Scalar::Util 'blessed'; use Module::Pluggable::Object; -our $VERSION = '0.0007'; +our $VERSION = '0.0011'; =head1 NAME @@ -69,11 +70,6 @@ C<$self-Eblessed> and C will no longer return the name of your ob 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. @@ -84,23 +80,6 @@ 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 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. @@ -109,134 +88,104 @@ to determine which directories to look for plugins as well as which plugins 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 used to locate available plugins. +=head2 _original_class_name + +Because of the way roles apply C<$self-Eblessed> and C 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 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 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-Eblessed> and C 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 @@ -270,7 +219,7 @@ sub _role_from_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. @@ -278,17 +227,20 @@ 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 { 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; } @@ -388,6 +340,8 @@ L =item Stevan Little - EVERYTHING. Without him this would have never happened. +=item Shawn M Moore - bugfixes + =back =head1 COPYRIGHT