From: Stevan Little <stevan.little@iinteractive.com>
Date: Thu, 13 Apr 2006 14:57:21 +0000 (+0000)
Subject: much-better
X-Git-Tag: 0_05~38
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=805722334b7a25a50b3ddf1aa24065b539e92302;p=gitmo%2FMoose.git

much-better
---

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index fca8c81..c4b32b8 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -9,31 +9,54 @@ use Carp 'confess';
 
 our $VERSION = '0.02';
 
+## the meta for the role package
+
 __PACKAGE__->meta->add_attribute('role_meta' => (
-    reader => 'role_meta'
+    reader   => 'role_meta'
+));
+
+## roles
+
+__PACKAGE__->meta->add_attribute('roles' => (
+    reader  => 'get_roles',
+    default => sub { [] }
 ));
 
+## attributes
+
 __PACKAGE__->meta->add_attribute('attribute_map' => (
     reader   => 'get_attribute_map',
     default  => sub { {} }
 ));
 
-__PACKAGE__->meta->add_attribute('method_modifier_map' => (
-    reader  => 'get_method_modifier_map',
-    default => sub { 
-        return {
-            before   => {},
-            after    => {},
-            around   => {},
-            override => {}                                        
-        };
-    }
+## method modifiers
+
+__PACKAGE__->meta->add_attribute('before_method_modifiers' => (
+    reader  => 'get_before_method_modifiers_map',
+    default => sub { {} } # keyed by method name, then arrays of method-modifiers
 ));
 
+__PACKAGE__->meta->add_attribute('after_method_modifiers' => (
+    reader  => 'get_after_method_modifiers_map',
+    default => sub { {} } # keyed by method name, then arrays of method-modifiers
+));
+
+__PACKAGE__->meta->add_attribute('around_method_modifiers' => (
+    reader  => 'get_around_method_modifiers_map',
+    default => sub { {} } # keyed by method name, then arrays of method-modifiers
+));
+
+__PACKAGE__->meta->add_attribute('override_method_modifiers' => (
+    reader  => 'get_override_method_modifiers_map',
+    default => sub { {} } # (<name> => CODE) 
+));
+
+## methods ...
+
 sub new {
     my $class   = shift;
     my %options = @_;
-    $options{role_meta} = Class::MOP::Class->initialize(
+    $options{'role_meta'} = Class::MOP::Class->initialize(
         $options{role_name},
         ':method_metaclass' => 'Moose::Meta::Role::Method'
     );
@@ -70,30 +93,30 @@ sub apply {
         # add it, although it could be overriden 
         $other->add_override_method_modifier(
             $method_name,
-            $_,
+            $self->get_override_method_modifier($method_name),
             $self->name
-        ) foreach $self->get_method_modifiers('override' => $method_name);
+        );
     }    
     
     foreach my $method_name ($self->get_method_modifier_list('before')) {
         $other->add_before_method_modifier(
             $method_name,
             $_
-        ) foreach $self->get_method_modifiers('before' => $method_name);
+        ) foreach $self->get_before_method_modifiers($method_name);
     }    
     
     foreach my $method_name ($self->get_method_modifier_list('after')) {
         $other->add_after_method_modifier(
             $method_name,
             $_
-        ) foreach $self->get_method_modifiers('after' => $method_name);
+        ) foreach $self->get_after_method_modifiers($method_name);
     }    
     
     foreach my $method_name ($self->get_method_modifier_list('around')) {
         $other->add_around_method_modifier(
             $method_name,
             $_
-        ) foreach $self->get_method_modifiers('around' => $method_name);
+        ) foreach $self->get_around_method_modifiers($method_name);
     }    
     
     ## add the roles and set does()
@@ -123,6 +146,27 @@ sub apply {
     }) unless $other->has_method('does');
 }
 
+## subroles
+
+sub add_role {
+    my ($self, $role) = @_;
+    (blessed($role) && $role->isa('Moose::Meta::Role'))
+        || confess "Roles must be instances of Moose::Meta::Role";
+    push @{$self->get_roles} => $role;
+}
+
+sub does_role {
+    my ($self, $role_name) = @_;
+    (defined $role_name)
+        || confess "You must supply a role name to look for";
+    foreach my $role (@{$self->get_roles}) {
+        return 1 if $role->name eq $role_name;
+    }
+    return 0;
+}
+
+## methods
+
 # NOTE:
 # we delegate to some role_meta methods for convience here
 # the Moose::Meta::Role is meant to be a read-only interface
@@ -173,31 +217,60 @@ sub get_attribute_list {
 
 # method modifiers
 
-sub add_method_modifier {
+# mimic the metaclass API
+sub add_before_method_modifier { (shift)->_add_method_modifier('before', @_) }
+sub add_around_method_modifier { (shift)->_add_method_modifier('around', @_) }
+sub add_after_method_modifier  { (shift)->_add_method_modifier('after',  @_) }
+
+sub _add_method_modifier {
     my ($self, $modifier_type, $method_name, $method) = @_;
-    $self->get_method_modifier_map->{$modifier_type}->{$method_name} = [] 
-        unless exists $self->get_method_modifier_map->{$modifier_type}->{$method_name};
-    push @{$self->get_method_modifier_map->{$modifier_type}->{$method_name}} => $method;
+    my $accessor = "get_${modifier_type}_method_modifiers_map";
+    $self->$accessor->{$method_name} = [] 
+        unless exists $self->$accessor->{$method_name};
+    push @{$self->$accessor->{$method_name}} => $method;
 }
 
-sub has_method_modifiers {
-    my ($self, $modifier_type, $method_name) = @_;
-    exists $self->get_method_modifier_map->{$modifier_type}->{$method_name} ? 1 : 0
+sub add_override_method_modifier {
+    my ($self, $method_name, $method) = @_;
+    $self->get_override_method_modifiers_map->{$method_name} = $method;    
 }
 
-sub get_method_modifiers {
+sub has_before_method_modifiers { (shift)->_has_method_modifiers('before', @_) }
+sub has_around_method_modifiers { (shift)->_has_method_modifiers('around', @_) }
+sub has_after_method_modifiers  { (shift)->_has_method_modifiers('after',  @_) }
+
+# override just checks for one,.. 
+# but we can still re-use stuff
+sub has_override_method_modifier { (shift)->_has_method_modifiers('override',  @_) }
+
+sub _has_method_modifiers {
     my ($self, $modifier_type, $method_name) = @_;
-    @{$self->get_method_modifier_map->{$modifier_type}->{$method_name}};
+    my $accessor = "get_${modifier_type}_method_modifiers_map";   
+    # NOTE:
+    # for now we assume that if it exists,.. 
+    # it has at least one modifier in it
+    (exists $self->$accessor->{$method_name}) ? 1 : 0;
 }
 
-sub remove_method_modifiers {
+sub get_before_method_modifiers { (shift)->_get_method_modifiers('before', @_) }
+sub get_around_method_modifiers { (shift)->_get_method_modifiers('around', @_) }
+sub get_after_method_modifiers  { (shift)->_get_method_modifiers('after',  @_) }
+
+sub _get_method_modifiers {
     my ($self, $modifier_type, $method_name) = @_;
-    delete $self->get_method_modifier_map->{$modifier_type}->{$method_name};
+    my $accessor = "get_${modifier_type}_method_modifiers_map";
+    @{$self->$accessor->{$method_name}};
+}
+
+sub get_override_method_modifier {
+    my ($self, $method_name) = @_;
+    $self->get_override_method_modifiers_map->{$method_name};    
 }
 
 sub get_method_modifier_list {
     my ($self, $modifier_type) = @_;
-    keys %{$self->get_method_modifier_map->{$modifier_type}};
+    my $accessor = "get_${modifier_type}_method_modifiers_map";    
+    keys %{$self->$accessor};
 }
 
 package Moose::Meta::Role::Method;
@@ -248,6 +321,16 @@ for more information.
 
 =over 4
 
+=item B<get_roles>
+
+=item B<add_role>
+
+=item B<does_role>
+
+=back
+
+=over 4
+
 =item B<get_method>
 
 =item B<has_method>
@@ -274,17 +357,51 @@ for more information.
 
 =over 4
 
-=item B<add_method_modifier>
+=item B<add_after_method_modifier>
+
+=item B<add_around_method_modifier>
+
+=item B<add_before_method_modifier>
+
+=item B<add_override_method_modifier>
+
+=over 4
+
+=back
+
+=item B<has_after_method_modifiers>
+
+=item B<has_around_method_modifiers>
+
+=item B<has_before_method_modifiers>
+
+=item B<has_override_method_modifier>
+
+=over 4
+
+=back
+
+=item B<get_after_method_modifiers>
 
-=item B<get_method_modifiers>
+=item B<get_around_method_modifiers>
 
-=item B<has_method_modifiers>
+=item B<get_before_method_modifiers>
 
 =item B<get_method_modifier_list>
 
-=item B<get_method_modifier_map>
+=over 4
+
+=back
+
+=item B<get_override_method_modifier>
+
+=item B<get_after_method_modifiers_map>
+
+=item B<get_around_method_modifiers_map>
+
+=item B<get_before_method_modifiers_map>
 
-=item B<remove_method_modifiers>
+=item B<get_override_method_modifiers_map>
 
 =back
 
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 0fd67a1..229c6f9 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -50,21 +50,21 @@ sub import {
 	# handle method modifers
 	$meta->role_meta->alias_method('before' => subname 'Moose::Role::before' => sub { 
 		my $code = pop @_;
-		$meta->add_method_modifier('before' => $_, $code) for @_;
+		$meta->add_before_method_modifier($_, $code) for @_;
 	});
 	$meta->role_meta->alias_method('after'  => subname 'Moose::Role::after' => sub { 
 		my $code = pop @_;
-		$meta->add_method_modifier('after' => $_, $code) for @_;
+		$meta->add_after_method_modifier($_, $code) for @_;
 	});	
 	$meta->role_meta->alias_method('around' => subname 'Moose::Role::around' => sub { 
 		my $code = pop @_;
-		$meta->add_method_modifier('around' => $_, $code) for @_;
+		$meta->add_around_method_modifier($_, $code) for @_;
 	});	
 	
 	$meta->role_meta->alias_method('super' => subname 'Moose::Role::super' => sub {});
 	$meta->role_meta->alias_method('override' => subname 'Moose::Role::override' => sub {
         my ($name, $code) = @_;
-		$meta->add_method_modifier('override' => $name, $code);
+		$meta->add_override_method_modifier($name, $code);
 	});		
 	
 	$meta->role_meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {
diff --git a/t/040_meta_role.t b/t/040_meta_role.t
index 89403a7..05b54a9 100644
--- a/t/040_meta_role.t
+++ b/t/040_meta_role.t
@@ -95,17 +95,15 @@ ok($foo_role->has_attribute('baz'), '... FooRole does still have the baz attribu
 
 # method modifiers
 
-ok(!$foo_role->has_method_modifiers('before' => 'boo'), '... no boo:before modifier');
+ok(!$foo_role->has_before_method_modifiers('boo'), '... no boo:before modifier');
 
 my $method = sub { "FooRole::boo:before" };
 lives_ok {
-    $foo_role->add_method_modifier('before' => (
-        'boo' => $method
-    ));
+    $foo_role->add_before_method_modifier('boo' => $method);
 } '... added a method modifier okay';
 
-ok($foo_role->has_method_modifiers('before' => 'boo'), '... now we have a boo:before modifier');
-is(($foo_role->get_method_modifiers('before' => 'boo'))[0], $method, '... got the right method back');
+ok($foo_role->has_before_method_modifiers('boo'), '... now we have a boo:before modifier');
+is(($foo_role->get_before_method_modifiers('boo'))[0], $method, '... got the right method back');
 
 is_deeply(
     [ $foo_role->get_method_modifier_list('before') ],
diff --git a/t/041_role.t b/t/041_role.t
index 76d0263..a8d81b1 100644
--- a/t/041_role.t
+++ b/t/041_role.t
@@ -70,8 +70,8 @@ is_deeply(
 
 # method modifiers
 
-ok($foo_role->has_method_modifiers('before' => 'boo'), '... now we have a boo:before modifier');
-is(($foo_role->get_method_modifiers('before' => 'boo'))[0]->(), 
+ok($foo_role->has_before_method_modifiers('boo'), '... now we have a boo:before modifier');
+is(($foo_role->get_before_method_modifiers('boo'))[0]->(), 
     "FooRole::boo:before", 
     '... got the right method back');