From: Stevan Little Date: Thu, 16 Mar 2006 22:45:55 +0000 (+0000) Subject: next-method X-Git-Tag: 0_05~98 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fc5609d2e60a1fbff4b6e3176df4dc89b402cce6;p=gitmo%2FMoose.git next-method --- diff --git a/Changes b/Changes index fe98b30..9ec9a68 100644 --- 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 --- 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 --- 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 --- 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 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 --- 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;