use Try::Tiny;
use overload ();
-our $VERSION = '0.93_01';
+our $VERSION = '1.12';
our $AUTHORITY = 'cpan:STEVAN';
+use Moose::Deprecated;
use Moose::Meta::Method::Accessor;
use Moose::Meta::Method::Delegation;
use Moose::Util ();
# ...
-my @legal_options_for_inheritance = qw(
- default coerce required
- documentation lazy handles
- builder type_constraint
- definition_context
- lazy_build weak_ref
-);
-
-sub legal_options_for_inheritance { @legal_options_for_inheritance }
+# method-generating options shouldn't be overridden
+sub illegal_options_for_inheritance {
+ qw(reader writer accessor clearer predicate)
+}
# NOTE/TODO
# This method *must* be able to handle
sub clone_and_inherit_options {
my ($self, %options) = @_;
- my %copy = %options;
-
- my %actual_options;
-
# NOTE:
# we may want to extends a Class::MOP::Attribute
# in which case we need to be able to use the
# been here. But we allows Moose::Meta::Attribute
# instances to changes them.
# - SL
- my @legal_options = $self->can('legal_options_for_inheritance')
- ? $self->legal_options_for_inheritance
- : @legal_options_for_inheritance;
-
- foreach my $legal_option (@legal_options) {
- if (exists $options{$legal_option}) {
- $actual_options{$legal_option} = $options{$legal_option};
- delete $options{$legal_option};
- }
- }
+ my @illegal_options = $self->can('illegal_options_for_inheritance')
+ ? $self->illegal_options_for_inheritance
+ : ();
+
+ my @found_illegal_options = grep { exists $options{$_} && exists $self->{$_} ? $_ : undef } @illegal_options;
+ (scalar @found_illegal_options == 0)
+ || $self->throw_error("Illegal inherited options => (" . (join ', ' => @found_illegal_options) . ")", data => \%options);
if ($options{isa}) {
my $type_constraint;
|| $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa});
}
- $actual_options{type_constraint} = $type_constraint;
- delete $options{isa};
+ $options{type_constraint} = $type_constraint;
}
if ($options{does}) {
|| $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does});
}
- $actual_options{type_constraint} = $type_constraint;
- delete $options{does};
+ $options{type_constraint} = $type_constraint;
}
# NOTE:
# so we can ignore it for them.
# - SL
if ($self->can('interpolate_class')) {
- ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(\%options);
+ ( $options{metaclass}, my @traits ) = $self->interpolate_class(\%options);
my %seen;
my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
- $actual_options{traits} = \@all_traits if @all_traits;
-
- delete @options{qw(metaclass traits)};
+ $options{traits} = \@all_traits if @all_traits;
}
- (scalar keys %options == 0)
- || $self->throw_error("Illegal inherited options => (" . (join ', ' => keys %options) . ")", data => \%options);
-
-
- $self->clone(%actual_options);
+ $self->clone(%options);
}
sub clone {
|| $class->throw_error("You cannot have coercion without specifying a type constraint on attribute ($name)", data => $options);
$class->throw_error("You cannot have a weak reference to a coerced value on attribute ($name)", data => $options)
if $options->{weak_ref};
+
+ unless ( $options->{type_constraint}->has_coercion ) {
+ my $type = $options->{type_constraint}->name;
+
+ Moose::Deprecated::deprecated(
+ feature => 'coerce without coercion',
+ message =>
+ "You cannot coerce an attribute ($name) unless its type ($type) has a coercion"
+ );
+ }
}
if (exists $options->{trigger}) {
return $meta_instance->set_slot_value($instance, $slot_name, $value)
unless $self->has_initializer;
- my ($type_constraint, $can_coerce);
- if ($self->has_type_constraint) {
- $type_constraint = $self->type_constraint;
- $can_coerce = ($self->should_coerce && $type_constraint->has_coercion);
- }
-
my $callback = sub {
my $val = $self->_coerce_and_verify( shift, $instance );;
. "an accessor"
);
}
+ if (!$self->associated_class->has_method($accessor)
+ && $self->associated_class->has_package_symbol('&' . $accessor)) {
+ Carp::cluck(
+ "You are overwriting a locally defined function ($accessor) with "
+ . "an accessor"
+ );
+ }
$self->SUPER::_process_accessors(@_);
}
elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::DuckType')) {
return map { $_ => $_ } @{ $handles->methods };
}
+ elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::Role')) {
+ $handles = $handles->role;
+ }
else {
$self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles);
}
}
- else {
- Class::MOP::load_class($handles);
- my $role_meta = Class::MOP::class_of($handles);
- (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);
+ Class::MOP::load_class($handles);
+ my $role_meta = Class::MOP::class_of($handles);
- return map { $_ => $_ }
- grep { $_ ne 'meta' } (
- $role_meta->get_method_list,
- map { $_->name } $role_meta->get_required_method_list,
- );
- }
+ (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 { $_ => $_ }
+ grep { $_ ne 'meta' } (
+ $role_meta->get_method_list,
+ map { $_->name } $role_meta->get_required_method_list,
+ );
}
sub _find_delegate_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);
+ return Class::MOP::Class->initialize($class);
}
elsif (my $role = $self->_does_metadata) {
return Class::MOP::class_of($role);
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);
- }
+ $val = $self->type_constraint->coerce($val)
+ if $self->should_coerce && $self->type_constraint->has_coercion;
$self->verify_against_type_constraint($val, instance => $instance);
=item * coerce => $bool
This option is only valid for objects with a type constraint
-(C<isa>). If this is true, then coercions will be applied whenever
+(C<isa>) that defined a coercion. If this is true, then coercions will be applied whenever
this attribute is set.
You can make both this and the C<weak_ref> option true.
Before setting the value, a check is made on the type constraint of
the attribute, if it has one, to see if the value passes it. If the
-value fails to pass, the set operation dies with a L<throw_error>.
+value fails to pass, the set operation dies with a L</throw_error>.
Any coercion to convert values is done before checking the type constraint.
the C<clone> method.
One of its main tasks is to make sure that the C<%options> provided
-only includes the options returned by the
-C<legal_options_for_inheritance> method.
+does not include the options returned by the
+C<illegal_options_for_inheritance> method.
-=item B<< $attr->legal_options_for_inheritance >>
+=item B<< $attr->illegal_options_for_inheritance >>
-This returns a whitelist of options that can be overridden in a
+This returns a blacklist of options that can not be overridden in a
subclass's attribute definition.
This exists to allow a custom metaclass to change or add to the list
-of options which can be changed.
+of options which can not be changed.
=item B<< $attr->type_constraint >>
projects / gitmo/Moose.git / blobdiff