X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=9110900f6a4fa9457529cfd24010732780f2a694;hb=823419c540f9e77090f31f11e04b14477c0372c4;hp=98c2cd52d20a6aa43f87376a91a0f419d7e2ba5d;hpb=6cd9dfb6937859d76137cf492b4d2b8c3797c050;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 98c2cd5..9110900 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -16,6 +16,7 @@ my %valid_options = map { $_ => undef } ( 'does', 'handles', 'init_arg', + 'insertion_order', 'is', 'isa', 'lazy', @@ -37,7 +38,6 @@ my %valid_options = map { $_ => undef } ( # Moose defines, but Mouse doesn't #'definition_context', #'initializer', - #'insertion_order', # special case for AttributeHelpers 'provides', @@ -52,11 +52,6 @@ sub new { my $args = $class->Mouse::Object::BUILDARGS(@_); - # XXX: for backward compatibility (with method modifiers) - if($class->can('canonicalize_args') != \&canonicalize_args){ - %{$args} = $class->canonicalize_args($name, %{$args}); - } - $class->_process_options($name, $args); $args->{name} = $name; @@ -96,11 +91,6 @@ sub new { sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor } sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor } -sub _create_args { # DEPRECATED - $_[0]->{_create_args} = $_[1] if @_ > 1; - $_[0]->{_create_args} -} - sub interpolate_class{ my($class, $args) = @_; @@ -135,27 +125,6 @@ sub interpolate_class{ return( $class, @traits ); } -sub canonicalize_args{ # DEPRECATED - #my($self, $name, %args) = @_; - my($self, undef, %args) = @_; - - Carp::cluck("$self->canonicalize_args has been deprecated." - . "Use \$self->_process_options instead."); - - return %args; -} - -sub create { # DEPRECATED - #my($self, $class, $name, %args) = @_; - my($self) = @_; - - Carp::cluck("$self->create has been deprecated." - . "Use \$meta->add_attribute and \$attr->install_accessors instead."); - - # noop - return $self; -} - sub _coerce_and_verify { #my($self, $value, $instance) = @_; my($self, $value) = @_; @@ -192,20 +161,29 @@ sub _throw_type_constraint_error { ); } +sub illegal_options_for_inheritance { + return qw(reader writer accessor clearer predicate); +} + sub clone_and_inherit_options{ my $self = shift; my $args = $self->Mouse::Object::BUILDARGS(@_); - my($attribute_class, @traits) = ref($self)->interpolate_class($args); + foreach my $illegal($self->illegal_options_for_inheritance) { + if(exists $args->{$illegal} and exists $self->{$illegal}) { + $self->throw_error("Illegal inherited option: $illegal"); + } + } - $args->{traits} = \@traits if @traits; - # do not inherit the 'handles' attribute foreach my $name(keys %{$self}){ - if(!exists $args->{$name} && $name ne 'handles'){ - $args->{$name} = $self->{$name}; + if(!exists $args->{$name}){ + $args->{$name} = $self->{$name}; # inherit from self } } + my($attribute_class, @traits) = ref($self)->interpolate_class($args); + $args->{traits} = \@traits if @traits; + # remove temporary caches foreach my $attr(keys %{$args}){ if($attr =~ /\A _/xms){ @@ -213,36 +191,14 @@ sub clone_and_inherit_options{ } } - return $attribute_class->new($self->name, $args); -} - -sub clone_parent { # DEPRECATED - my $self = shift; - my $class = shift; - my $name = shift; - my %args = ($self->get_parent_args($class, $name), @_); - - Carp::cluck("$self->clone_parent has been deprecated." - . "Use \$meta->add_attribute and \$attr->install_accessors instead."); - - $self->clone_and_inherited_args($class, $name, %args); -} - -sub get_parent_args { # DEPRECATED - my $self = shift; - my $class = shift; - my $name = shift; - - for my $super ($class->linearized_isa) { - my $super_attr = $super->can("meta") && $super->meta->get_attribute($name) - or next; - return %{ $super_attr->_create_args }; + # remove default if lazy_build => 1 + if($args->{lazy_build}) { + delete $args->{default}; } - $self->throw_error("Could not find an attribute by the name of '$name' to inherit from"); + return $attribute_class->new($self->name, $args); } - sub get_read_method { return $_[0]->reader || $_[0]->accessor } @@ -329,6 +285,10 @@ sub install_accessors{ my %handles = $attribute->_canonicalize_handles($attribute->{handles}); while(my($handle, $method_to_call) = each %handles){ + if($metaclass->has_method($handle)) { + $attribute->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation"); + } + $metaclass->add_method($handle => $attribute->_make_delegation_method( $handle, $method_to_call)); @@ -337,11 +297,6 @@ sub install_accessors{ } } - if($attribute->can('create') != \&create){ - # backword compatibility - $attribute->create($metaclass, $attribute->name, %{$attribute}); - } - return; } @@ -385,13 +340,6 @@ sub _make_delegation_method { ->_generate_delegation($self, $handle, $method_to_call); } -sub throw_error{ - my $self = shift; - - my $metaclass = (ref $self && $self->associated_class) || 'Mouse::Meta::Class'; - $metaclass->throw_error(@_, depth => 1); -} - 1; __END__ @@ -401,7 +349,12 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass =head1 VERSION -This document describes Mouse version 0.53 +This document describes Mouse version 0.70 + +=head1 DESCRIPTION + +This is a meta object protocol for Mouse attributes, +which is a subset of Moose::Meta::Attribute. =head1 METHODS