X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=9176bd0848abae1244aae137316a4e6b03d4096b;hb=bb73340585512b0e09519eea54480ea3729ebf0b;hp=2e626b0162f36ff143514d258665b9a52badf281;hpb=306290e864ac23e5f1692c8495b0c173081a1ebb;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 2e626b0..9176bd0 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -12,25 +12,32 @@ sub new { $args{init_arg} = $args{name} unless exists $args{init_arg}; + $args{is} ||= ''; + if ( $args{lazy_build} ) { + $args{lazy} = 1; + $args{builder} ||= "_build_$args{name}"; + } + bless \%args, $class; } -sub name { $_[0]->{name} } -sub class { $_[0]->{class} } -sub _is_metadata { $_[0]->{is} } -sub is_required { $_[0]->{required} } -sub default { $_[0]->{default} } -sub is_lazy { $_[0]->{lazy} } -sub predicate { $_[0]->{predicate} } -sub clearer { $_[0]->{clearer} } -sub handles { $_[0]->{handles} } -sub is_weak_ref { $_[0]->{weak_ref} } -sub init_arg { $_[0]->{init_arg} } -sub type_constraint { $_[0]->{type_constraint} } -sub trigger { $_[0]->{trigger} } -sub builder { $_[0]->{builder} } +sub name { $_[0]->{name} } +sub class { $_[0]->{class} } +sub _is_metadata { $_[0]->{is} } +sub is_required { $_[0]->{required} } +sub default { $_[0]->{default} } +sub is_lazy { $_[0]->{lazy} } +sub predicate { $_[0]->{predicate} } +sub clearer { $_[0]->{clearer} } +sub handles { $_[0]->{handles} } +sub is_weak_ref { $_[0]->{weak_ref} } +sub init_arg { $_[0]->{init_arg} } +sub type_constraint { $_[0]->{type_constraint} } +sub trigger { $_[0]->{trigger} } +sub builder { $_[0]->{builder} } +sub should_auto_deref { $_[0]->{auto_deref} } sub has_default { exists $_[0]->{default} } sub has_predicate { exists $_[0]->{predicate} } @@ -40,6 +47,11 @@ sub has_type_constraint { exists $_[0]->{type_constraint} } sub has_trigger { exists $_[0]->{trigger} } sub has_builder { exists $_[0]->{builder} } +sub _create_args { + $_[0]->{_create_args} = $_[1] if @_ > 1; + $_[0]->{_create_args} +} + sub generate_accessor { my $attribute = shift; @@ -93,7 +105,20 @@ sub generate_accessor { $accessor .= ' if !exists($self->{$key});'; } - $accessor .= 'return $self->{$key} + if ($attribute->should_auto_deref) { + if ($attribute->type_constraint eq 'ArrayRef') { + $accessor .= 'if (wantarray) { + return @{ $self->{$key} || [] }; + }'; + } + else { + $accessor .= 'if (wantarray) { + return %{ $self->{$key} || {} }; + }'; + } + } + + $accessor .= 'return $self->{$key}; }'; return eval $accessor; @@ -141,17 +166,17 @@ sub generate_handles { sub create { my ($self, $class, $name, %args) = @_; - confess "You cannot have lazy attribute ($name) without specifying a default value for it" - if $args{lazy} && !exists($args{default}) && !exists($args{builder}); + $args{name} = $name; + $args{class} = $class; - confess "References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])" - if ref($args{default}) - && ref($args{default}) ne 'CODE'; + $self->validate_args($name, %args); $args{type_constraint} = delete $args{isa} if exists $args{isa}; - my $attribute = $self->new(%args, name => $name, class => $class); + my $attribute = $self->new(%args); + $attribute->_create_args(\%args); + my $meta = $class->meta; $meta->add_attribute($attribute); @@ -184,6 +209,29 @@ sub create { return $attribute; } +sub validate_args { + my $self = shift; + my $name = shift; + my %args = @_; + + confess "You cannot have lazy attribute ($name) without specifying a default value for it" + if $args{lazy} && !exists($args{default}) && !exists($args{builder}); + + confess "References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])" + if ref($args{default}) + && ref($args{default}) ne 'CODE'; + + confess "You cannot auto-dereference without specifying a type constraint on attribute $name" + if $args{auto_deref} && !exists($args{isa}); + + confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name" + if $args{auto_deref} + && $args{isa} ne 'ArrayRef' + && $args{isa} ne 'HashRef'; + + return 1; +} + sub find_type_constraint { my $self = shift; my $type = $self->type_constraint; @@ -226,6 +274,29 @@ sub _canonicalize_handles { } } +sub clone_parent { + my $self = shift; + my $class = shift; + my $name = shift; + my %args = ($self->get_parent_args($class, $name), @_); + + $self->create($class, $name, %args); +} + +sub get_parent_args { + my $self = shift; + my $class = shift; + my $name = shift; + + for my $super ($class->meta->linearized_isa) { + my $super_attr = $super->can("meta") && $super->meta->get_attribute($name) + or next; + return %{ $super_attr->_create_args }; + } + + confess "Could not find an attribute by the name of '$name' to inherit from"; +} + 1; __END__ @@ -285,6 +356,8 @@ installed. Some error checking is done. =head2 has_builder -> Bool +=head2 should_auto_deref -> Bool + Informational methods. =head2 generate_accessor -> CODE