From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 17 Mar 2006 03:49:53 +0000 (+0000)
Subject: mixin stuff
X-Git-Tag: 0_05~97
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef1d5f4b21ea3e924985390f8ab6b70984377ac7;p=gitmo%2FMoose.git

mixin stuff
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 08cefe3..01564eb 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -10,6 +10,8 @@ use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 use Sub::Name    'subname';
 
+use Class::MOP;
+
 use Moose::Meta::Class;
 use Moose::Meta::SafeMixin;
 use Moose::Meta::Attribute;
@@ -95,15 +97,6 @@ sub import {
 		$meta->add_around_method_modifier($_, $code) for @_;	
 	});	
 	
-	# next methods ...
-	$meta->alias_method('next_method' => subname 'Moose::next_method' => sub { 
-	    my $method_name = (split '::' => (caller(1))[3])[-1];
-        my $next_method = $meta->find_next_method_by_name($method_name);
-        (defined $next_method)
-            || confess "Could not find next-method for '$method_name'";
-        $next_method->(@_);
-	});
-	
 	# make sure they inherit from Moose::Object
 	$meta->superclasses('Moose::Object') 
 		unless $meta->superclasses();
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 76fcbea..b5c8692 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -53,6 +53,8 @@ extensions.
 
 =item B<construct_instance>
 
+=item B<mixed_in>
+
 =back
 
 =head1 BUGS
diff --git a/lib/Moose/Meta/SafeMixin.pm b/lib/Moose/Meta/SafeMixin.pm
index c02604d..949d3a4 100644
--- a/lib/Moose/Meta/SafeMixin.pm
+++ b/lib/Moose/Meta/SafeMixin.pm
@@ -11,6 +11,11 @@ our $VERSION = '0.01';
 
 use base 'Class::MOP::Class';
 
+Moose::Meta::SafeMixin->meta->add_attribute('mixed_in' => (
+    accessor => 'mixed_in',
+    default  => sub { [] }
+));
+
 sub mixin {
     # fetch the metaclass for the 
     # caller and the mixin arg
@@ -59,7 +64,10 @@ sub mixin {
         # attributes take care of that
         next if blessed($method) && $method->isa('Class::MOP::Attribute::Accessor');
         $metaclass->alias_method($method_name => $method);
-    }    
+    }   
+    
+    push @{$metaclass->mixed_in} => $mixin 
+        unless $metaclass->name eq 'Moose::Meta::Class';
 }
 
 1;
@@ -173,6 +181,10 @@ gives us (what I hope is) a better, safer and saner system.
 
 =item B<mixin ($mixin)>
 
+=item B<mixed_in>
+
+Accessor for the cache of mixed-in classes
+
 =back
 
 =head1 AUTHOR
diff --git a/t/011_next_method.t b/t/011_next_method.t
deleted file mode 100644
index 83f32e5..0000000
--- a/t/011_next_method.t
+++ /dev/null
@@ -1,52 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 4;
-use Test::Exception;
-
-BEGIN {
-    use_ok('Moose');           
-}
-
-{
-    package Foo;
-    use Moose;
-    
-    sub hello {
-        return 'Foo::hello';
-    }
-    
-    package Bar;
-    use Moose;
-    
-    extends 'Foo';
-    
-    sub hello {
-        return 'Bar::hello -> ' . next_method();
-    }
-    
-    package Baz;
-    use Moose;
-    
-    extends 'Bar';
-    
-    sub hello {
-        return 'Baz::hello -> ' . next_method();
-    }  
-    
-    sub goodbye {
-        return 'Baz::goodbye -> ' . next_method();
-    }      
-}
-
-my $baz = Baz->new;
-isa_ok($baz, 'Baz');
-
-is($baz->hello, 'Baz::hello -> Bar::hello -> Foo::hello', '... next_method did the right thing');
-
-dies_ok {
-    $baz->goodbye
-} '... no next method found, so we die';
-
diff --git a/t/030_basic_safe_mixin.t b/t/030_basic_safe_mixin.t
index 8b4e742..c2df61e 100644
--- a/t/030_basic_safe_mixin.t
+++ b/t/030_basic_safe_mixin.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 16;
+use Test::More tests => 21;
 
 BEGIN {
     use_ok('Moose');
@@ -13,15 +13,11 @@ BEGIN {
 {
     package FooMixin;   
     use Moose;
-    
     sub foo { 'FooMixin::foo' }    
 
     package Foo;
     use Moose;
-    
     with 'FooMixin';
-    
-    sub new { (shift)->meta->new_object(@_) }
 }
 
 my $foo = Foo->new();
@@ -30,6 +26,11 @@ isa_ok($foo, 'Foo');
 can_ok($foo, 'foo');
 is($foo->foo, 'FooMixin::foo', '... got the right value from the mixin method');
 
+is_deeply(
+    [ sort map { $_->name } @{Foo->meta->mixed_in} ],
+    [ 'FooMixin' ],
+    '... got the right mixin list');
+
 ## Mixin a class who shares a common ancestor
 {   
     package Baz;
@@ -57,6 +58,21 @@ isa_ok($foo_baz, 'Foo');
 can_ok($foo_baz, 'baz');
 is($foo_baz->baz(), 'Baz::baz', '... got the right value from the mixin method');
 
+is_deeply(
+    [ sort map { $_->name } @{Baz->meta->mixed_in} ],
+    [],
+    '... got the right mixin list');
+    
+is_deeply(
+    [ sort map { $_->name } @{Bar->meta->mixed_in} ],
+    [],
+    '... got the right mixin list');    
+
+is_deeply(
+    [ sort map { $_->name } @{Foo::Baz->meta->mixed_in} ],
+    [ 'Baz' ],
+    '... got the right mixin list');
+
 {
 	package Foo::Bar;
 	use Moose;
@@ -78,3 +94,8 @@ isa_ok($foo_bar_baz, 'Bar');
 can_ok($foo_bar_baz, 'baz');
 is($foo_bar_baz->baz(), 'Baz::baz', '... got the right value from the mixin method');
 
+is_deeply(
+    [ sort map { $_->name } @{Foo::Bar::Baz->meta->mixed_in} ],
+    [ 'Baz' ],
+    '... got the right mixin list');
+    
\ No newline at end of file
diff --git a/t/031_mixin_example.t b/t/031_mixin_example.t
index 5651086..7594960 100644
--- a/t/031_mixin_example.t
+++ b/t/031_mixin_example.t
@@ -73,7 +73,7 @@ code above is well-formed.
     
     sub to_string {
         my $self = shift;
-        $self->SUPER() . ', col = ' . $self->color;
+        $self->SUPER . ', col = ' . $self->color;
     }
     
     package Point3D;
@@ -85,7 +85,7 @@ code above is well-formed.
 
     sub to_string {
         my $self = shift;
-        $self->SUPER() . ', z = ' . $self->z;
+        $self->SUPER . ', z = ' . $self->z;
     }
     
     package ColoredPoint3D;