},
has => sub {
+ my $caller = $CALLER;
+
return sub {
- my $package = caller;
+ my $meta = $caller->meta;
+
my $names = shift;
$names = [$names] if !ref($names);
for my $name (@$names) {
if ($name =~ s/^\+//) {
- Mouse::Meta::Attribute->clone_parent($package, $name, @_);
+ Mouse::Meta::Attribute->clone_parent($meta, $name, @_);
}
else {
- Mouse::Meta::Attribute->create($package, $name, @_);
+ Mouse::Meta::Attribute->create($meta, $name, @_);
}
}
};
use warnings;
use Carp 'confess';
-use Scalar::Util 'blessed';
+use Scalar::Util qw/blessed weaken/;
sub new {
my $class = shift;
if exists $args{isa};
my $attribute = $self->new(%args);
- $attribute->_create_args(\%args);
- my $meta = $class->meta;
+ $attribute->_create_args(\%args);
- $meta->add_attribute($attribute);
+ $class->add_attribute($attribute);
# install an accessor
if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') {
my $accessor = $attribute->generate_accessor;
- no strict 'refs';
- *{ $class . '::' . $name } = $accessor;
+ $class->add_method($name => $accessor);
}
for my $method (qw/predicate clearer/) {
if ($attribute->$predicate) {
my $generator = "generate_$method";
my $coderef = $attribute->$generator;
- no strict 'refs';
- *{ $class . '::' . $attribute->$method } = $coderef;
+ $class->add_method($attribute->$method => $coderef);
}
}
if ($attribute->has_handles) {
my $method_map = $attribute->generate_handles;
for my $method_name (keys %$method_map) {
- no strict 'refs';
- *{ $class . '::' . $method_name } = $method_map->{$method_name};
+ $class->add_method($method_name => $method_map->{$method_name});
}
}
my $class = shift;
my $name = shift;
- for my $super ($class->meta->linearized_isa) {
+ for my $super ($class->linearized_isa) {
my $super_attr = $super->can("meta") && $super->meta->get_attribute($name)
or next;
return %{ $super_attr->_create_args };
sub apply {
my $self = shift;
my $class = shift;
- my $pkg = $class->name;
for my $name ($self->get_attribute_list) {
next if $class->has_attribute($name);
my $spec = $self->get_attribute($name);
- Mouse::Meta::Attribute->create($pkg, $name, %$spec);
+ Mouse::Meta::Attribute->create($class, $name, %$spec);
}
}
can_ok($attr, qw(name associated_class predicate clearer));
is($attr->name, 'pawn', 'attribute name');
-is($attr->associated_class, 'Class', 'associated_class');
+is($attr->associated_class, Class->meta, 'associated_class');
is($attr->predicate, 'has_pawn', 'predicate');
is($attr->clearer, 'clear_pawn', 'clearer');
ok(!$attr->is_lazy_build, "not lazy_build");