use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.72';
+our $VERSION = '0.75_01';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
my ( @init, @non_init );
- foreach my $attr ( grep { $_->has_value($self) } $self->meta->compute_all_applicable_attributes ) {
+ foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) {
push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
}
return unless $value_is_set;
- if ($self->has_type_constraint) {
- my $type_constraint = $self->type_constraint;
- if ($self->should_coerce && $type_constraint->has_coercion) {
- $val = $type_constraint->coerce($val);
- }
- $self->verify_against_type_constraint($val, instance => $instance);
- }
+ $val = $self->_coerce_and_verify( $val, $instance );
$self->set_initial_value($instance, $val);
$meta_instance->weaken_slot_value($instance, $self->name)
}
my $callback = sub {
- my $val = shift;
- if ($type_constraint) {
- $val = $type_constraint->coerce($val)
- if $can_coerce;
- $self->verify_against_type_constraint($val, object => $instance);
- }
+ my $val = $self->_coerce_and_verify( shift, $instance );;
+
$meta_instance->set_slot_value($instance, $slot_name, $val);
};
$self->throw_error("Attribute ($attr_name) is required", object => $instance);
}
- if ($self->has_type_constraint) {
-
- my $type_constraint = $self->type_constraint;
-
- if ($self->should_coerce) {
- $value = $type_constraint->coerce($value);
- }
- $type_constraint->_compiled_type_constraint->($value)
- || $self->throw_error("Attribute ("
- . $self->name
- . ") does not pass the type constraint because "
- . $type_constraint->get_message($value), object => $instance, data => $value);
- }
+ $value = $self->_coerce_and_verify( $value, $instance );
my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
->get_meta_instance;
} elsif ( $self->has_builder ) {
$value = $self->_call_builder($instance);
}
- if ($self->has_type_constraint) {
- my $type_constraint = $self->type_constraint;
- $value = $type_constraint->coerce($value)
- if ($self->should_coerce);
- $self->verify_against_type_constraint($value);
- }
+
+ $value = $self->_coerce_and_verify( $value, $instance );
+
$self->set_initial_value($instance, $value);
}
}
}
}
else {
- Class::MOP::load_class($handles)
- unless Class::MOP::is_class_loaded($handles);
-
- my $role_meta = eval { $handles->meta };
- if ($@) {
- $self->throw_error("Unable to canonicalize the 'handles' option with $handles because : $@", data => $handles, error => $@);
- }
+ my $role_meta = Class::MOP::load_class($handles);
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
- || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role", data => $handles);
+ || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles);
return map { $_ => $_ } (
$role_meta->get_method_list,
sub _find_delegate_metaclass {
my $self = shift;
if (my $class = $self->_isa_metadata) {
- # if the class does have
- # a meta method, use it
- return $class->meta if $class->can('meta');
- # otherwise we might be
- # dealing with a non-Moose
- # class, and need to make
- # our own metaclass
+ # we might be dealing with a non-Moose class,
+ # and need to make our own metaclass. if there's
+ # already a metaclass, it will be returned
return Moose::Meta::Class->initialize($class);
}
elsif (my $role = $self->_does_metadata) {
- # our role will always have
- # a meta method
- return $role->meta;
+ return Class::MOP::class_of($role);
}
else {
$self->throw_error("Cannot find delegate metaclass for attribute " . $self->name);
);
}
+sub _coerce_and_verify {
+ my $self = shift;
+ my $val = shift;
+ my $instance = shift;
+
+ return $val unless $self->has_type_constraint;
+
+ my $type_constraint = $self->type_constraint;
+ if ($self->should_coerce && $type_constraint->has_coercion) {
+ $val = $type_constraint->coerce($val);
+ }
+
+ $self->verify_against_type_constraint($val, instance => $instance);
+
+ return $val;
+}
+
sub verify_against_type_constraint {
my $self = shift;
my $val = shift;
This class is a subclass of L<Class::MOP::Attribute> that provides
additional Moose-specific functionality.
-To really understand this class, you will probably need to start with
-the L<Class::MOP::Attribute> documentation. This class can be
-understood as a set of additional features on top of the basic feature
-provided by that parent class.
+To really understand this class, you will need to start with the
+L<Class::MOP::Attribute> documentation. This class can be understood
+as a set of additional features on top of the basic feature provided
+by that parent class.
+
+=head1 INHERITANCE
+
+C<Moose::Meta::Attribute> is a subclass of L<Class::MOP::Attribute>.
=head1 METHODS
An attribute which is required must be provided to the constructor. An
attribute which is required can also have a C<default> or C<builder>,
-which will satisy its required-ness.
+which will satisfy its required-ness.
A required attribute must have a C<default>, C<builder> or a
non-C<undef> C<init_arg>
The C<%options> can only specify options handled by
L<Class::MOP::Attribute>.
+=back
+
=head2 Value management
+=over 4
+
=item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
This method is used internally to initialize the attribute's slot in
This method overrides the parent to also install delegation methods.
-=item B<< $attr->remove_accessors>>
+=item B<< $attr->remove_accessors >>
This method overrides the parent to also remove delegation methods.
These methods are not found in the superclass. They support features
provided by Moose.
+=over 4
+
=item B<< $attr->does($role) >>
This indicates whether the I<attribute itself> does the given
-role. The role can be given as a full class name, or as a resolveable
+role. The role can be given as a full class name, or as a resolvable
trait name.
Note that this checks the attribute itself, not its type constraint,
C<traits> options.
Effectively, this method is a factory that finds or creates the
-appropriate class for the given C<metaclass> and/or C<traits.
+appropriate class for the given C<metaclass> and/or C<traits>.
Once it has the appropriate class, it will call C<< $class->new($name,
%options) >> on that class.
This is the subroutine reference that was in the C<trigger> option
passed to the constructor, if any.
-=item B<< $attr->has_trigger>>
+=item B<< $attr->has_trigger >>
Returns true if this attribute has a trigger set.
projects / gitmo/Moose.git / blobdiff