From: Guillermo Roditi <groditi@gmail.com>
Date: Sat, 14 Apr 2007 18:07:37 +0000 (+0000)
Subject: irc is bad for productivity
X-Git-Tag: 0.0005~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=208f7b2702330c0187b265df3d20ef1702de0640;p=gitmo%2FMooseX-Object-Pluggable.git

irc is bad for productivity
---

diff --git a/Changes b/Changes
index b59aa87..5bf16c8 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
 Revision history for MooseX-Object-Pluggable
+0.0005    Apr 13, 2007
+          Goodbye Class::Inspector, hello Module::Object::Pluggable
+          More Tests
+	  App namespaces functionality.
 0.0004    Jan 23, 2007
 	  PODFixes
 0.0003    Jan 19, 2007
diff --git a/MANIFEST b/MANIFEST
index 7538120..6761dbf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -17,6 +17,7 @@ META.yml
 README
 t/00-load.t
 t/01-basic.t
+t/02-basic2.t
 t/boilerplate.t
 t/lib/TestApp.pm
 t/lib/TestApp/Plugin/Bar.pm
@@ -27,5 +28,9 @@ t/lib/TestApp/Plugin/Bor/ExtensionFor/Foo.pm
 t/lib/TestApp/Plugin/Foo.pm
 t/lib/TestApp/Plugin/Foo/ExtensionFor/Bar.pm
 t/lib/TestApp/Plugin/Foo/ExtensionFor/Baz.pm
+t/lib/TestApp2.pm
+t/lib/TestApp2/Plugin/Foo.pm
+t/lib/TestApp2/Plugin/Foo/ExtensionFor/Bar.pm
+t/lib/TestApp2/Plugin/Foo/ExtensionFor/Baz.pm
 t/pod-coverage.t
 t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
index 2ead1f5..f3feb7a 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,8 +9,8 @@ abstract 'Add plugin support to your Moose classes via roles.';
 all_from 'lib/MooseX/Object/Pluggable.pm';
 
 # Specific dependencies
-requires 'Moose'              => 0.17;
-requires 'Class::Inspector'   => 1.04;
+requires 'Moose'                      => 0.17;
+requires 'Module::Pluggable::Object'  => 0;
 
 build_requires 'Test::More'   => 0;
 
diff --git a/lib/MooseX/Object/Pluggable.pm b/lib/MooseX/Object/Pluggable.pm
index 0347b3d..f4d6013 100644
--- a/lib/MooseX/Object/Pluggable.pm
+++ b/lib/MooseX/Object/Pluggable.pm
@@ -4,9 +4,10 @@ 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.0005';
 
 =head1 NAME
 
@@ -93,24 +94,39 @@ 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_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
+
+An automatically built instance of L<Module::Pluggable::Object> 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_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 });
+has _plugin_locator => (is => 'rw', required => 1, lazy => 1, 
+                        isa => 'Module::Pluggable::Object', 
+		        default => sub{ shift->_build_plugin_locator });
 
 #--------#---------#---------#---------#---------#---------#---------#---------#
 
@@ -129,7 +145,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);
@@ -153,15 +169,19 @@ 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);
 
+	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 ) 
@@ -194,8 +214,8 @@ becomes an issue (which I doubt).
 
 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
+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
@@ -205,10 +225,22 @@ and C<_plugin_ns> will be returned. Example
 sub _role_from_plugin{
     my ($self, $plugin) = @_;
 
-    return $1 if $plugin =~ /^\+(.*)/;
+    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;
+    
+    die("Unable to locate plugin") unless @roles;
+    return $roles[0] if @roles == 1;
+    
+    my @names = (grep {$_ !~ /^Moose::/} $self->meta->class_precedence_list);
+    my $i = 0;
+    my %presedence_list = map{ $i++; "${_}::${o}", $i } @names;
+    
+    @roles = sort{ $presedence_list{$a} <=> $presedence_list{$b}} @roles;
 
-    return join '::', ( $self->_original_class_name, 
-			$self->_plugin_ns, $plugin );
+    return shift @roles;    
 }
 
 =head2 _load_and_apply_role $role
@@ -222,16 +254,11 @@ 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);
-
     #don't re-require...
-    unless( Class::Inspector->loaded($role) ){
-	eval "require $role" || die("Failed to load role: $role");
+    unless( Class::MOP::is_class_loaded($role) ){
+	eval Class::MOP::load_class($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 };   
@@ -243,6 +270,36 @@ sub _load_and_apply_role{
     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<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
 
 Keep tests happy. See L<Moose>
diff --git a/t/01-basic.t b/t/01-basic.t
index 1701d6a..4687e91 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -5,7 +5,7 @@ use warnings;
 use Test::More;
 use lib 't/lib';
 
-plan tests => 20;
+plan tests => 19;
 
 use_ok('TestApp');
 
@@ -15,7 +15,7 @@ is($app->_role_from_plugin('+'.$_), $_)
     for(qw/MyPrettyPlugin My::Pretty::Plugin/);
 
 is($app->_role_from_plugin($_), 'TestApp::Plugin::'.$_)
-    for(qw/MyPrettyPlugin My::Pretty::Plugin/);
+    for(qw/Foo/);
 
 is( $app->foo, "original foo", 'original foo value');
 is( $app->bar, "original bar", 'original bar value');
diff --git a/t/02-basic2.t b/t/02-basic2.t
new file mode 100644
index 0000000..639d20f
--- /dev/null
+++ b/t/02-basic2.t
@@ -0,0 +1,38 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+plan tests => 19;
+
+use_ok('TestApp2');
+
+my $app = TestApp2->new;
+
+is($app->_role_from_plugin('+'.$_), $_)
+    for(qw/MyPrettyPlugin My::Pretty::Plugin/);
+
+is($app->_role_from_plugin($_), 'TestApp2::Plugin::'.$_)
+    for(qw/Foo/);
+
+is( $app->foo, "original foo", 'original foo value');
+is( $app->bar, "original bar", 'original bar value');
+is( $app->bor, "original bor", 'original bor value');
+
+ok($app->load_plugin('Bar'), "Loaded Bar");
+is( $app->bar, "override bar", 'overridden bar via plugin');
+
+ok($app->load_plugin('Baz'), "Loaded Baz");
+is( $app->baz, "plugin baz", 'added baz via plugin');
+is( $app->bar, "baz'd bar  override bar", 'baz extension for bar using around');
+
+ok($app->load_plugin('Foo'), "Loaded Foo");
+is( $app->foo, "around foo 2", 'around foo via plugin');
+is( $app->bar, "foo'd bar 2 baz'd bar  override bar", 'foo extension around baz extension for bar');
+is( $app->baz, "foo'd baz 2 plugin baz", 'foo extension override for baz');
+
+ok($app->load_plugin('+TestApp::Plugin::Bor'), "Loaded Bor");
+is( $app->foo, "bor'd foo  around foo 2", 'bor extension override for foo');
+is( $app->bor, "plugin bor", 'override bor via plugin');
diff --git a/t/lib/TestApp2/Plugin/Foo.pm b/t/lib/TestApp2/Plugin/Foo.pm
new file mode 100644
index 0000000..61b4c0a
--- /dev/null
+++ b/t/lib/TestApp2/Plugin/Foo.pm
@@ -0,0 +1,9 @@
+package TestApp2::Plugin::Foo;
+
+use strict;
+use warnings;
+use Moose::Role;
+
+around foo => sub{ 'around foo 2' };
+
+1;
diff --git a/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Bar.pm b/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Bar.pm
new file mode 100644
index 0000000..ad67d21
--- /dev/null
+++ b/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Bar.pm
@@ -0,0 +1,12 @@
+package TestApp2::Plugin::Foo::ExtensionFor::Bar;
+
+use strict;
+use warnings;
+use Moose::Role;
+
+around bar => sub {
+    my ($super, $self) = @_;
+    "foo'd bar 2 " . $super->($self);
+};
+
+1;
diff --git a/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Baz.pm b/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Baz.pm
new file mode 100644
index 0000000..7934fd6
--- /dev/null
+++ b/t/lib/TestApp2/Plugin/Foo/ExtensionFor/Baz.pm
@@ -0,0 +1,13 @@
+package TestApp2::Plugin::Foo::ExtensionFor::Baz;
+
+use strict;
+use warnings;
+use Moose::Role;
+
+around baz => sub{ 
+    my $super = shift;
+    my $self = shift;
+    "foo'd baz 2 " . $super->($self);
+};
+
+1;