use strict;
use warnings;
use Carp 'confess';
+use Mouse::Util;
do {
my %METACLASS_CACHE;
for my $name ($self->get_attribute_list) {
next if $class->has_attribute($name);
my $spec = $self->get_attribute($name);
- Mouse::Meta::Attribute->create($class, $name, %$spec);
+
+ my $metaclass = 'Mouse::Meta::Attribute';
+ if ( my $metaclass_name = $spec->{metaclass} ) {
+ my $new_class = Mouse::Util::resolve_metaclass_alias(
+ 'Attribute',
+ $metaclass_name
+ );
+ if ( $metaclass ne $new_class ) {
+ $metaclass = $new_class;
+ }
+ }
+
+ $metaclass->create($class, $name, %$spec);
}
} else {
# apply role to role
for my $name ($self->get_attribute_list) {
next if $class->has_attribute($name);
my $spec = $self->get_attribute($name);
- Mouse::Meta::Attribute->create($class, $name, %$spec);
+
+ my $metaclass = 'Mouse::Meta::Attribute';
+ if ( my $metaclass_name = $spec->{metaclass} ) {
+ my $new_class = Mouse::Util::resolve_metaclass_alias(
+ 'Attribute',
+ $metaclass_name
+ );
+ if ( $metaclass ne $new_class ) {
+ $metaclass = $new_class;
+ }
+ }
+
+ $metaclass->create($class, $name, %$spec);
}
}
} else {
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 7;
+use lib 't/lib';
+
+do {
+ package MouseX::AttributeHelpers::Number;
+ use Mouse;
+ extends 'Mouse::Meta::Attribute';
+
+ around 'create' => sub {
+ my ($next, @args) = @_;
+ my $attr = $next->(@args);
+ my %provides = %{$attr->{provides}};
+ my $method_constructors = {
+ add => sub {
+ my ($attr, $name) = @_;
+ return sub {
+ $_[0]->$name( $_[0]->$name() + $_[1])
+ };
+ },
+ };
+ while (my ($name, $aliased) = each %provides) {
+ $attr->associated_class->add_method(
+ $aliased => $method_constructors->{$name}->($attr, $attr->name)
+ );
+ }
+ return $attr;
+ };
+
+ package # hide me from search.cpan.org
+ Mouse::Meta::Attribute::Custom::Number;
+ sub register_implementation { 'MouseX::AttributeHelpers::Number' }
+
+ 1;
+
+ package Foo;
+ use Mouse::Role;
+
+ has 'i' => (
+ metaclass => 'Number',
+ is => 'rw',
+ isa => 'Int',
+ provides => {
+ 'add' => 'add_number'
+ },
+ );
+ sub f_m {}
+
+ package Bar;
+ use Mouse::Role;
+
+ has 'j' => (
+ metaclass => 'Number',
+ is => 'rw',
+ isa => 'Int',
+ provides => {
+ 'add' => 'add_number_j'
+ },
+ );
+ sub b_m {}
+
+ package Klass1;
+ use Mouse;
+ with 'Foo';
+
+ package Klass2;
+ use Mouse;
+ with 'Foo', 'Bar';
+
+};
+
+{
+ # normal
+ can_ok 'Klass1', 'add_number';
+ my $k = Klass1->new(i=>3);
+ $k->add_number(4);
+ is $k->i, 7;
+}
+
+{
+ # combine
+ can_ok 'Klass2', 'f_m';
+ can_ok 'Klass2', 'b_m';
+ can_ok 'Klass2', 'add_number';
+ can_ok 'Klass2', 'add_number_j';
+ my $k = Klass2->new(i=>3);
+ $k->add_number(4);
+ is $k->i, 7;
+}
+