improve the unabel to locate error message to croak and to also give the requested...
[gitmo/MooseX-Object-Pluggable.git] / lib / MooseX / Object / Pluggable.pm
index 0347b3d..437601b 100644 (file)
@@ -1,12 +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.0004';
+our $VERSION = '0.0007';
 
 =head1 NAME
 
@@ -16,7 +15,7 @@ our $VERSION = '0.0004';
 
     package MyApp;
     use Moose;
-    
+
     with 'MooseX::Object::Pluggable';
 
     ...
@@ -53,12 +52,12 @@ their consuming classes, so it is important to watch for load order as plugins c
 and will overload each other. You may also add attributes through has.
 
 Please note that when you load at runtime you lose the ability to wrap C<BUILD>
-and roles using C<has> will not go through comile time checks like C<required>
+and roles using C<has> will not go through compile time checks like C<required>
 and <default>.
 
-Even though C<override> will work , I STRONGLY discourage it's use 
+Even though C<override> 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<override> 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.
@@ -70,6 +69,11 @@ C<$self-E<gt>blessed> and C<ref $self> 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.
@@ -87,30 +91,54 @@ 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::*". 
+"MyApp::Plugin::Bar::ExtensionFor::*".
 
-=head2 _plugin_loaded
+=head2 _plugin_app_ns
 
-HashRef. Keeps an inventory of what plugins are loaded and what the actual
-module name is to avoid multiple loading.
+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.
 
 =cut
 
-#--------#---------#---------#---------#---------#---------#---------#---------#
+=head2 _plugin_locator
 
-has _plugin_ns     => (is => 'rw', required => 1, isa => 'Str', 
-                       default => 'Plugin');
+An automatically built instance of L<Module::Pluggable::Object> used to locate
+available plugins.
 
-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{ {} });
+=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 });
 
 #--------#---------#---------#---------#---------#---------#---------#---------#
 
@@ -118,8 +146,8 @@ has _plugin_loaded => (is => 'rw', required => 1, isa => 'HashRef',
 
 =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> as well as any extensions it provides
+if extensions are enabled.
 
 =cut
 
@@ -129,7 +157,7 @@ sub load_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);
@@ -138,12 +166,28 @@ sub load_plugin{
     return exists $loaded->{$plugin};
 }
 
+=head2 load_plugins @plugins
+
+Load all C<@plugins>.
+
+=cut
+
+
+sub load_plugins {
+  my $self = shift;
+  $self->load_plugin($_) for @_;
+}
+
 
 =head2 load_plugin_ext
 
-Will load any extensions for a particular plugin. This should be called 
+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 
+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.
@@ -153,19 +197,23 @@ recommend.
 sub load_plugin_ext{
     my ($self, $plugin) = @_;
     die("You must provide a plugin name") unless $plugin;
-    my $role = $self->_role_from_plugin($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;  
 
-       $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);
+        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);
     }
 }
 
@@ -185,19 +233,19 @@ sub _original_class_name{
 
 =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 
+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).
 
 =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
@@ -205,10 +253,21 @@ and C<_plugin_ns> will be returned. Example
 sub _role_from_plugin{
     my ($self, $plugin) = @_;
 
-    return $1 if $plugin =~ /^\+(.*)/;
+    return $1 if( $plugin =~ /^\+(.*)/ );
 
-    return join '::', ( $self->_original_class_name, 
-                       $self->_plugin_ns, $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;
+
+    @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
+
+    return shift @roles;
 }
 
 =head2 _load_and_apply_role $role
@@ -222,25 +281,45 @@ sub _load_and_apply_role{
     my ($self, $role) = @_;
     die("You must provide a role name") unless $role;
 
-    #Throw exception if plugin is not installed
-    die("$role is not available on this system") 
-       unless Class::Inspector->installed($role);
+    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 };
 
+    $role->meta->apply( $self );
+    return 1;
+}
 
-    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 };   
+=head2 _build_plugin_app_ns
 
-    #apply the plugin to the anon subclass
-    die("Failed to apply plugin: $role") 
-       unless $role->meta->apply( $self );
+Automatically builds the _plugin_app_ns attribute with the classes in the
+class presedence list that are not part of Moose.
 
-    return 1;
+=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<Module::Pluggable::Object> 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