use Carp 'confess';
use Sub::Name 'subname';
+use Class::MOP;
+
use Moose::Meta::Class;
use Moose::Meta::SafeMixin;
use Moose::Meta::Attribute;
$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();
=item B<construct_instance>
+=item B<mixed_in>
+
=back
=head1 BUGS
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
# 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;
=item B<mixin ($mixin)>
+=item B<mixed_in>
+
+Accessor for the cache of mixed-in classes
+
=back
=head1 AUTHOR
+++ /dev/null
-#!/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';
-
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 21;
BEGIN {
use_ok('Moose');
{
package FooMixin;
use Moose;
-
sub foo { 'FooMixin::foo' }
package Foo;
use Moose;
-
with 'FooMixin';
-
- sub new { (shift)->meta->new_object(@_) }
}
my $foo = Foo->new();
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;
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;
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
sub to_string {
my $self = shift;
- $self->SUPER() . ', col = ' . $self->color;
+ $self->SUPER . ', col = ' . $self->color;
}
package Point3D;
sub to_string {
my $self = shift;
- $self->SUPER() . ', z = ' . $self->z;
+ $self->SUPER . ', z = ' . $self->z;
}
package ColoredPoint3D;