{ package Foo::Meta::Attr::Trait; use Mouse::Role;
has value_slot => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub { shift->name },
);
has count_slot => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub { '<<COUNT>>' . shift->name },
);
sub slots {
my $self = shift;
return ($self->value_slot, $self->count_slot);
}
sub _set_count {
my $self = shift;
my ($instance) = @_;
my $mi = $self->associated_class->get_meta_instance;
$mi->set_slot_value(
$instance,
$self->count_slot,
($mi->get_slot_value($instance, $self->count_slot) || 0) + 1,
);
}
sub _clear_count {
my $self = shift;
my ($instance) = @_;
$self->associated_class->get_meta_instance->deinitialize_slot(
$instance, $self->count_slot
);
}
sub has_count {
my $self = shift;
my ($instance) = @_;
$self->associated_class->get_meta_instance->has_slot_value(
$instance, $self->count_slot
);
}
sub count {
my $self = shift;
my ($instance) = @_;
$self->associated_class->get_meta_instance->get_slot_value(
$instance, $self->count_slot
);
}
after set_initial_value => sub {
shift->_set_count(@_);
};
after set_value => sub {
shift->_set_count(@_);
};
around _inline_instance_set => sub {
my $orig = shift;
my $self = shift;
my ($instance) = @_;
my $mi = $self->associated_class->get_meta_instance;
return 'do { '
. $mi->inline_set_slot_value(
$instance,
$self->count_slot,
$mi->inline_get_slot_value(
$instance, $self->count_slot
) . ' + 1'
) . ';'
. $self->$orig(@_)
. '}';
};
after clear_value => sub {
shift->_clear_count(@_);
};
}
{ package Bar; use Mouse; Mouse::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Foo::Meta::Attr::Trait'], }, );
has baz => ( is => 'rw' );
}
{ my $attr = Bar->meta->find_attribute_by_name('baz');
my $bar = Bar->new(baz => 1);
is($attr->count($bar), 1, "right count");
$bar->baz(2);
is($attr->count($bar), 2, "right count");
my $clone = $bar->meta->clone_object($bar);
is($attr->count($clone), $attr->count($bar), "right count");
}