use warnings;
use Scalar::Util 'blessed', 'weaken';
+use List::MoreUtils 'any';
+use Try::Tiny;
use overload ();
-our $VERSION = '0.86';
+our $VERSION = '0.93';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
use Moose::Util ();
use Moose::Util::TypeConstraints ();
-use base 'Class::MOP::Attribute';
-
-# options which are not directly used
-# but we store them for metadata purposes
-__PACKAGE__->meta->add_attribute('isa' => (reader => '_isa_metadata'));
-__PACKAGE__->meta->add_attribute('does' => (reader => '_does_metadata'));
-__PACKAGE__->meta->add_attribute('is' => (reader => '_is_metadata'));
-
-# these are actual options for the attrs
-__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' ));
-__PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' ));
-__PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build' ));
-__PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' ));
-__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
-__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
-__PACKAGE__->meta->add_attribute('type_constraint' => (
- reader => 'type_constraint',
- predicate => 'has_type_constraint',
-));
-__PACKAGE__->meta->add_attribute('trigger' => (
- reader => 'trigger',
- predicate => 'has_trigger',
-));
-__PACKAGE__->meta->add_attribute('handles' => (
- reader => 'handles',
- predicate => 'has_handles',
-));
-__PACKAGE__->meta->add_attribute('documentation' => (
- reader => 'documentation',
- predicate => 'has_documentation',
-));
+use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore';
+
__PACKAGE__->meta->add_attribute('traits' => (
reader => 'applied_traits',
predicate => 'has_applied_traits',
# for metatrait aliases.
sub does {
my ($self, $role_name) = @_;
- my $name = eval {
+ my $name = try {
Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
};
return 0 if !defined($name); # failed to load class
documentation lazy handles
builder type_constraint
definition_context
- lazy_build
+ lazy_build weak_ref
);
sub legal_options_for_inheritance { @legal_options_for_inheritance }
if (exists $options->{isa}) {
if (exists $options->{does}) {
- if (eval { $options->{isa}->can('does') }) {
+ if (try { $options->{isa}->can('does') }) {
($options->{isa}->does($options->{does}))
|| $class->throw_error("Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)", data => $options);
}
$val = $self->_coerce_and_verify( $val, $instance );
$self->set_initial_value($instance, $val);
- $meta_instance->weaken_slot_value($instance, $self->name)
- if ref $val && $self->is_weak_ref;
+
+ if ( ref $val && $self->is_weak_ref ) {
+ $self->_weaken_value($instance);
+ }
}
sub _call_builder {
$value = $self->_coerce_and_verify( $value, $instance );
- my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
- ->get_meta_instance;
+ my @old;
+ if ( $self->has_trigger && $self->has_value($instance) ) {
+ @old = $self->get_value($instance, 'for trigger');
+ }
- $meta_instance->set_slot_value($instance, $attr_name, $value);
+ $self->SUPER::set_value($instance, $value);
- if (ref $value && $self->is_weak_ref) {
- $meta_instance->weaken_slot_value($instance, $attr_name);
+ if ( ref $value && $self->is_weak_ref ) {
+ $self->_weaken_value($instance);
}
if ($self->has_trigger) {
- $self->trigger->($instance, $value);
+ $self->trigger->($instance, $value, @old);
}
}
+sub _weaken_value {
+ my ( $self, $instance ) = @_;
+
+ my $meta_instance = Class::MOP::Class->initialize( blessed($instance) )
+ ->get_meta_instance;
+
+ $meta_instance->weaken_slot_value( $instance, $self->name );
+}
+
sub get_value {
- my ($self, $instance) = @_;
+ my ($self, $instance, $for_trigger) = @_;
if ($self->is_lazy) {
unless ($self->has_value($instance)) {
}
}
- if ($self->should_auto_deref) {
+ if ( $self->should_auto_deref && ! $for_trigger ) {
my $type_constraint = $self->type_constraint;
my %handles = $self->_canonicalize_handles;
my $associated_class = $self->associated_class;
foreach my $handle (keys %handles) {
+ next unless any { $handle eq $_ }
+ map { $_->name }
+ @{ $self->associated_methods };
$self->associated_class->remove_method($handle);
}
}
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
|| $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles);
- return map { $_ => $_ } (
+ return map { $_ => $_ }
+ grep { $_ ne 'meta' } (
$role_meta->get_method_list,
map { $_->name } $role_meta->get_required_method_list,
- );
+ );
}
}
sub _make_delegation_method {
my ( $self, $handle_name, $method_to_call ) = @_;
- my $method_body;
+ my @curried_arguments;
- $method_body = $method_to_call
- if 'CODE' eq ref($method_to_call);
+ ($method_to_call, @curried_arguments) = @$method_to_call
+ if 'ARRAY' eq ref($method_to_call);
return $self->delegation_metaclass->new(
name => $handle_name,
package_name => $self->associated_class->name,
attribute => $self,
delegate_to_method => $method_to_call,
+ curried_arguments => \@curried_arguments,
);
}
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>