next-method

diff --git a/Changes b/Changes
index fe98b30..9ec9a68 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,11 @@
 Revision history for Perl extension Moose
 
+0.02 
+    * Moose
+      - added &with keyword to support class mixins
+      
+    * Moose::Meta::SafeMixin
+      - added support for mixins, see docs for info
+
 0.01 Wed. March 15, 2006
     - Moooooooooooooooooose!!!
\ No newline at end of file

diff --git a/README b/README
index ababf8a..d4656db 100644 (file)
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Moose version 0.01
+Moose version 0.02
 ===========================
 
 See the individual module documentation for more information

diff --git a/lib/Moose.pm b/lib/Moose.pm
index bda04b7..08cefe3 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -24,6 +24,9 @@ sub import {
        shift;
        my $pkg = caller();
        
+       # we should never export to main
+       return if $pkg eq 'main';
+       
        Moose::Util::TypeConstraints->import($pkg);
        
        my $meta;
@@ -85,13 +88,22 @@ sub import {
        });
        $meta->alias_method('after'  => subname 'Moose::after' => sub { 
                my $code = pop @_;
-               $meta->add_after_method_modifier($_, $code)  for @_;
+               $meta->add_after_method_modifier($_, $code) for @_;
        });     
        $meta->alias_method('around' => subname 'Moose::around' => sub { 
                my $code = pop @_;
-               $meta->add_around_method_modifier($_, $code)  for @_;   
+               $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/SafeMixin.pm b/lib/Moose/Meta/SafeMixin.pm
index f042d6c..c02604d 100644 (file)
--- a/lib/Moose/Meta/SafeMixin.pm
+++ b/lib/Moose/Meta/SafeMixin.pm
@@ -24,39 +24,41 @@ sub mixin {
     my ($super_meta)  = $metaclass->superclasses();
     my ($super_mixin) = $mixin->superclasses();  
     ($super_meta->isa($super_mixin))
-        || confess "The superclass ($super_meta) must extend a subclass of the superclass of the mixin ($super_mixin)"
+        || confess "The superclass ($super_meta) must extend a subclass of the " . 
+                   "superclass of the mixin ($super_mixin)"
                        if defined $super_mixin && defined $super_meta;
     
+    # check for conflicts here ...
+    
+    $metaclass->has_attribute($_) 
+        && confess "Attribute conflict ($_)"
+            foreach $mixin->get_attribute_list;
+
+    foreach my $method_name ($mixin->get_method_list) {
+        # skip meta, cause everyone has that :)
+        next if $method_name =~ /meta/;
+        $metaclass->has_method($method_name) && confess "Method conflict ($method_name)";
+    }    
+    
     # collect all the attributes
     # and clone them so they can 
-    # associate with the new class
-    my @attributes = map { 
-        $mixin->get_attribute($_)->clone() 
-    } $mixin->get_attribute_list;                     
-    
-    my %methods = map  { 
-        my $method = $mixin->get_method($_);
-        # we want to ignore accessors since
-        # they will be created with the attrs
-        (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'))
-            ? () : ($_ => $method)
-    } $mixin->get_method_list;    
-
-    # NOTE:
-    # I assume that locally defined methods 
-    # and attributes get precedence over those
-    # from the mixin.
-
+    # associate with the new class                  
     # add all the attributes in ....
-    foreach my $attr (@attributes) {
-        $metaclass->add_attribute($attr) 
-            unless $metaclass->has_attribute($attr->name);
-    }
+    foreach my $attr ($mixin->get_attribute_list) {
+        $metaclass->add_attribute(
+            $mixin->get_attribute($attr)->clone()
+        );
+    }     
 
     # add all the methods in ....    
-    foreach my $method_name (keys %methods) {
-        $metaclass->alias_method($method_name => $methods{$method_name}) 
-            unless $metaclass->has_method($method_name);
+    foreach my $method_name ($mixin->get_method_list) {
+        # no need to mess with meta
+        next if $method_name eq 'meta';
+        my $method = $mixin->get_method($method_name);
+        # and ignore accessors, the 
+        # attributes take care of that
+        next if blessed($method) && $method->isa('Class::MOP::Attribute::Accessor');
+        $metaclass->alias_method($method_name => $method);
     }    
 }
 

diff --git a/t/011_next_method.t b/t/011_next_method.t
new file mode 100644 (file)
index 0000000..83f32e5
--- /dev/null
+++ b/t/011_next_method.t
@@ -0,0 +1,52 @@
+#!/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 44b81a9..8b4e742 100644 (file)
--- a/t/030_basic_safe_mixin.t
+++ b/t/030_basic_safe_mixin.t
@@ -13,6 +13,7 @@ BEGIN {
 {
     package FooMixin;   
     use Moose;
+    
     sub foo { 'FooMixin::foo' }    
 
     package Foo;