X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FObject%2FPluggable.pm;h=51b5fdd0beb888bbb9021d0ae866944f85ed189c;hb=8a6fd40d5f5df6a1627ca7078ee6b9e83e181e63;hp=6df5a5ac26593a04d8a1914e9edd645cac4a9b96;hpb=421e9f8d52cf41796d09266414e4164a488dfb2d;p=gitmo%2FMooseX-Object-Pluggable.git diff --git a/lib/MooseX/Object/Pluggable.pm b/lib/MooseX/Object/Pluggable.pm index 6df5a5a..51b5fdd 100644 --- a/lib/MooseX/Object/Pluggable.pm +++ b/lib/MooseX/Object/Pluggable.pm @@ -1,13 +1,11 @@ package MooseX::Object::Pluggable; use Carp; -use strict; -use warnings; use Moose::Role; -use Class::Inspector; +use Class::MOP; +use Module::Pluggable::Object; - -our $VERSION = '0.0002'; +our $VERSION = '0.0009'; =head1 NAME @@ -17,7 +15,7 @@ our $VERSION = '0.0002'; package MyApp; use Moose; - + with 'MooseX::Object::Pluggable'; ... @@ -38,7 +36,7 @@ our $VERSION = '0.0002'; =head1 DESCRIPTION This module is meant to be loaded as a role from Moose-based classes -it will add five methods and five attributes to assist you with the loading +it will add five methods and four attributes to assist you with the loading and handling of plugins and extensions for plugins. I understand that this may pollute your namespace, however I took great care in using the least ambiguous names possible. @@ -53,32 +51,27 @@ Plugin methods are allowed to C, C, C their consuming classes, so it is important to watch for load order as plugins can and will overload each other. You may also add attributes through has. -Even thouch C will work in basic cases, I STRONGLY discourage it's use +Please note that when you load at runtime you lose the ability to wrap C +and roles using C will not go through compile time checks like C +and . + +Even though C will work , I STRONGLY discourage it's use and a warning will be thrown if you try to use it. -This is closely linked to the way multiple roles being applies is handles and is not +This is closely linked to the way multiple roles being applied is handled and is not likely to change. C bevavior is closely linked to inheritance and thus will likely not work as you expect it in multiple inheritance situations. Point being, save yourself the headache. =head1 How plugins are loaded -You don't really need to understand anything except for the first paragraph. - -The first time you load a plugin a new anonymous L will be -created. This class will inherit from your pluggable object and then your object -will be reblessed to an instance of this anonymous class. This means that +When roles are applied at runtime an anonymous class will wrap your class and C<$self-Eblessed> and C will no longer return the name of your object, -they will instead return the name of the anonymous class created at runtime. Your -original class name can be located at C<($self-Emeta-Esuperclasses)[0]> +they will instead return the name of the anonymous class created at runtime. +See C<_original_class_name>. -Once the anonymous subclass exists all plugin roles will be Ced to this class -directly. This "subclass" though is in fact now C<$self> and it C. - If this is confusing.. it should be, thats why you let me handle it. Just know that it -has to be done this way in order for plugins to override core functionality. +=head1 Usage -=head1 - -For a simple example see the tests for this distribution. +For a simple example see the tests included in this distribution. =head1 Attributes @@ -86,149 +79,127 @@ For a simple example see the tests for 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 - -String. The namespace plugin extensions have. Defaults to 'ExtensionFor'. +=head2 _plugin_app_ns -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::*". +ArrayRef, Accessor automatically dereferences into array on a read call. +By default will be filled with the class name and it's prescedents, it is used +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. -=head2 _plugin_loaded - -HashRef. Keeps an inventory of what plugins are loaded and what the actual -module name is to avoid multiple loading. +=cut -=head2 __plugin_subclass +=head2 _plugin_locator -Object. This holds the subclass of our pluggable object in the form of an -anonymous L instance. All roles are actually applied to -this instance instead of the original class instance in order to not lose -the original object name as roles are applied. The anonymous class will be -automatically generated upon first use. +An automatically built instance of L used to locate +available plugins. =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_subclass => ( is => 'rw', required => 0, isa => 'Object', ); +has _plugin_ns => + ( + is => 'rw', + required => 1, + isa => 'Str', + default => sub{ 'Plugin' }, + ); + +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_plugins @plugins + =head2 load_plugin $plugin -This is the only method you should be using. -Load the apropriate role for C<$plugin> as well as any -extensions it provides if extensions are enabled. +Load the apropriate role for C<$plugin>. =cut -sub load_plugin{ - my ($self, $plugin) = @_; - die("You must provide a plugin name") unless $plugin; +sub load_plugins { + my ($self, @plugins) = @_; + die("You must provide a plugin name") unless @plugins; my $loaded = $self->_plugin_loaded; - return 1 if exists $loaded->{$plugin}; - - my $role = $self->_role_from_plugin($plugin); + my @load = grep { not exists $loaded->{$_} } @plugins; + my @roles = map { $self->_role_from_plugin($_) } @load; - $loaded->{$plugin} = $role if $self->_load_and_apply_role($role); - $self->load_plugin_ext($plugin) if $self->_plugin_ext; + return if @roles == 0; - return exists $loaded->{$plugin}; -} - - -=head2 _load_plugin_ext - -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. - -=cut - -sub load_plugin_ext{ - my ($self, $plugin) = @_; - die("You must provide a plugin name") unless $plugin; - my $role = $self->_role_from_plugin($plugin); - - # $p for plugin, $r for role - while( my($p,$r) = each %{ $self->_plugin_loaded }){ - my $ext = join "::", $role, $self->_plugin_ext_ns, $p; - - $self->_load_and_apply_role( $ext ) - if Class::Inspector->installed($ext); - - #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; } } -=head1 Private Methods -There's nothing stopping you from using these, but if you are using them -you are probably doing something wrong. +sub load_plugin { + my $self = shift; + $self->load_plugins(@_); +} -=head2 _plugin_subclass +=head2 _original_class_name -Creates, if needed and returns the anonymous instance of the consuming objects -subclass to which roles will be applied to. +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 _plugin_subclass{ +sub _original_class_name{ my $self = shift; - my $anon_class = $self->__plugin_subclass; - - #initialize if we havnt been initialized already. - unless(ref $anon_class && $self->meta->is_anon_class){ - - #create an anon class that inherits from $self that plugins can be - #applied to safely and store it within the $self instance. - $anon_class = Moose::Meta::Class-> - create_anon_class(superclasses => [$self->meta->name]); - $self->__plugin_subclass( $anon_class ); - - #rebless $self as the anon class which now inherits from ourselves - #this allows the anon class to override methods in the consuming - #class while keeping a stable name and set of superclasses - bless $self => $anon_class->name - unless $self->meta->name eq $anon_class->name; - } - - return $anon_class; + return (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list)[0]; } + +=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. + =head2 _role_from_plugin $plugin -Creates a role name from a plugin name. If the plugin name is prepended +Creates a role name from a plugin name. If the plugin name is prepended with a C<+> it will be treated as a full name returned as is. Otherwise -a string consisting of C<$plugin> prepended with the application name -and C<_plugin_ns> will be returned. Example - - #assuming appname MyApp and C<_plugin_ns> 'Plugin' +a string consisting of C<$plugin> prepended with the C<_plugin_ns> +and the first valid value from C<_plugin_app_ns> will be returned. Example + + #assuming appname MyApp and C<_plugin_ns> 'Plugin' $self->_role_from_plugin("MyPlugin"); # MyApp::Plugin::MyPlugin =cut @@ -236,43 +207,83 @@ and C<_plugin_ns> will be returned. Example sub _role_from_plugin{ my ($self, $plugin) = @_; - my $name = $self->meta->is_anon_class ? - ($self->meta->superclasses)[0] : $self->blessed; + return $1 if( $plugin =~ /^\+(.*)/ ); + + my $o = join '::', $self->_plugin_ns, $plugin; + #Father, please forgive me for I have sinned. + my @roles = grep{ /${o}$/ } $self->_plugin_locator->plugins; + + croak("Unable to locate plugin '$plugin'") unless @roles; + return $roles[0] if @roles == 1; + + my $i = 0; + my %presedence_list = map{ $i++; "${_}::${o}", $i } $self->_plugin_app_ns; - $plugin =~ /^\+(.*)/ ? $1 : join '::', $name, $self->_plugin_ns, $plugin; + @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles; + + 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 to -C<_plugin_subclass>. This is the meat of this module. +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; - #Throw exception if plugin is not installed - die("$role is not available on this system") - unless Class::Inspector->installed($role); + foreach my $role ( @roles ) { + eval { Class::MOP::load_class($role) }; + confess("Failed to load role: ${role} $@") if $@; - #don't re-require... - unless( Class::Inspector->loaded($role) ){ - eval "require $role" || die("Failed to load role: $role"); + 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 }; } - 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 }; - - #apply the plugin to the anon subclass - die("Failed to apply plugin: $role") - unless $role->meta->apply( $self->_plugin_subclass ); + Moose::Util::apply_all_roles( $self, @roles ); return 1; } +=head2 _build_plugin_app_ns + +Automatically builds the _plugin_app_ns attribute with the classes in the +class presedence list that are not part of Moose. + +=cut + +sub _build_plugin_app_ns{ + my $self = shift; + my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list); + return \@names; +} + +=head2 _build_plugin_locator + +Automatically creates a L instance with the correct +search_path. + +=cut + +sub _build_plugin_locator{ + my $self = shift; + + my $locator = Module::Pluggable::Object->new + ( search_path => + [ map { join '::', ($_, $self->_plugin_ns) } $self->_plugin_app_ns ] + ); + return $locator; +} + +=head2 meta + +Keep tests happy. See L + +=cut 1; @@ -280,7 +291,7 @@ __END__; =head1 SEE ALSO -L, L +L, L, L =head1 AUTHOR @@ -334,6 +345,8 @@ L =item Stevan Little - EVERYTHING. Without him this would have never happened. +=item Shawn M Moore - bugfixes + =back =head1 COPYRIGHT