X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=640d1cc0caccb9be88138635f40fad4a19239901;hb=e06951bb83e29645bd9186e3180a6af480929050;hp=137d139c7dc39fd71e77c498bc921f94fc30a7f1;hpb=ae7820b1b884344a7ee90d94b484ca46459eb7b1;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 137d139..640d1cc 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -9,9 +9,10 @@ use List::MoreUtils 'any'; use Try::Tiny; use overload (); -our $VERSION = '1.06'; +our $VERSION = '1.14'; our $AUTHORITY = 'cpan:STEVAN'; +use Moose::Deprecated; use Moose::Meta::Method::Accessor; use Moose::Meta::Method::Delegation; use Moose::Util (); @@ -131,15 +132,10 @@ sub interpolate_class { # ... -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 @@ -158,10 +154,6 @@ sub legal_options_for_inheritance { @legal_options_for_inheritance } 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 @@ -169,16 +161,13 @@ sub clone_and_inherit_options { # 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; @@ -191,8 +180,7 @@ sub clone_and_inherit_options { || $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}) { @@ -206,8 +194,7 @@ sub clone_and_inherit_options { || $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: @@ -215,20 +202,14 @@ sub clone_and_inherit_options { # 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 { @@ -322,6 +303,16 @@ sub _process_options { || $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}) { @@ -437,12 +428,6 @@ sub _set_initial_slot_value { 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 );; @@ -575,6 +560,13 @@ sub _process_accessors { . "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(@_); } @@ -585,6 +577,22 @@ sub remove_accessors { return; } +sub inline_set { + my $self = shift; + my ( $instance, $value ) = @_; + + my $mi = $self->associated_class->get_meta_instance; + + my $code + = $mi->inline_set_slot_value( $instance, $self->slots, $value ) . ";"; + $code + .= $mi->inline_weaken_slot_value( $instance, $self->slots, $value ) + . ";" + if $self->is_weak_ref; + + return $code; +} + sub install_delegation { my $self = shift; @@ -738,10 +746,8 @@ sub _coerce_and_verify { 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); @@ -846,7 +852,7 @@ object which does the named role. =item * coerce => $bool This option is only valid for objects with a type constraint -(C). If this is true, then coercions will be applied whenever +(C) 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 option true. @@ -973,6 +979,12 @@ methods is almost always an error.) This method overrides the parent to also remove delegation methods. +=item B<< $attr->inline_set($instance_var, $value_var) >> + +This method return a code snippet suitable for inlining the relevant +operation. It expect strings containing variable names to be used in the +inlining, like C<'$self'> or C<'$_[1]'>. + =item B<< $attr->install_delegation >> This method adds its delegation methods to the attribute's associated @@ -1030,16 +1042,16 @@ of processing on the supplied C<%options> before ultimately calling the C method. One of its main tasks is to make sure that the C<%options> provided -only includes the options returned by the -C method. +does not include the options returned by the +C 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 >>