X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=4bdb9f8167b0077ac8a323b9b883fc8c2d2d34f0;hb=cbdd0fa406d4f9d23a0d6a17891daf995e4c84c5;hp=a6b5f03516f2313f260e932030a77db16bad02c5;hpb=2e7e86c63f956238494249295af0ea8b4489392e;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index a6b5f03..4bdb9f8 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -17,22 +17,6 @@ sub new { $args{is} ||= ''; - if ($args{lazy_build}) { - confess("You can not use lazy_build and default for the same attribute $name") - if exists $args{default}; - $args{lazy} = 1; - $args{required} = 1; - $args{builder} ||= "_build_${name}"; - if ($name =~ /^_/) { - $args{clearer} ||= "_clear${name}"; - $args{predicate} ||= "_has${name}"; - } - else { - $args{clearer} ||= "clear_${name}"; - $args{predicate} ||= "has_${name}"; - } - } - bless \%args, $class; } @@ -42,6 +26,7 @@ sub _is_metadata { $_[0]->{is} } sub is_required { $_[0]->{required} } sub default { $_[0]->{default} } sub is_lazy { $_[0]->{lazy} } +sub is_lazy_build { $_[0]->{lazy_build} } sub predicate { $_[0]->{predicate} } sub clearer { $_[0]->{clearer} } sub handles { $_[0]->{handles} } @@ -71,11 +56,15 @@ sub generate_accessor { my $name = $attribute->name; my $key = $name; my $default = $attribute->default; - my $trigger = $attribute->trigger; my $type = $attribute->type_constraint; my $constraint = $attribute->find_type_constraint; my $builder = $attribute->builder; + my $trigger = $attribute->trigger; + my $before = $trigger->{before}; + my $after = $trigger->{after}; + my $around = $trigger->{around}; + my $accessor = 'sub { my $self = shift;'; @@ -83,21 +72,36 @@ sub generate_accessor { $accessor .= 'if (@_) { local $_ = $_[0];'; - if ($constraint) { - $accessor .= 'do { - my $display = defined($_) ? overload::StrVal($_) : "undef"; - Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display") unless $constraint->(); - };' + if ($before) { + $accessor .= '$before->($self, $_, $attribute);'; + } + + if ($around) { + $accessor .= '$around->(sub { + my $self = shift; + $_ = $_[0]; + '; } - $accessor .= '$self->{$key} = $_;'; + if ($constraint) { + $accessor .= 'do { + my $display = defined($_) ? overload::StrVal($_) : "undef"; + Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display") unless $constraint->(); + };' + } - if ($attribute->is_weak_ref) { - $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});'; + $accessor .= '$self->{$key} = $_;'; + + if ($attribute->is_weak_ref) { + $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});'; + } + + if ($around) { + $accessor .= '}, $self, $_, $attribute);'; } - if ($trigger) { - $accessor .= '$trigger->($self, $_, $attribute);'; + if ($after) { + $accessor .= '$after->($self, $_, $attribute);'; } $accessor .= '}'; @@ -182,7 +186,8 @@ sub create { $args{name} = $name; $args{class} = $class; - $self->validate_args($name, %args); + %args = $self->canonicalize_args($name, %args); + $self->validate_args($name, \%args); $args{type_constraint} = delete $args{isa} if exists $args{isa}; @@ -222,25 +227,65 @@ sub create { return $attribute; } -sub validate_args { +sub canonicalize_args { my $self = shift; my $name = shift; my %args = @_; + if ($args{lazy_build}) { + $args{lazy} = 1; + $args{required} = 1; + $args{builder} = "_build_${name}" + if !exists($args{builder}); + if ($name =~ /^_/) { + $args{clearer} = "_clear${name}" if !exists($args{clearer}); + $args{predicate} = "_has${name}" if !exists($args{predicate}); + } + else { + $args{clearer} = "clear_${name}" if !exists($args{clearer}); + $args{predicate} = "has_${name}" if !exists($args{predicate}); + } + } + + return %args; +} + +sub validate_args { + my $self = shift; + my $name = shift; + my $args = shift; + + confess "You can not use lazy_build and default for the same attribute ($name)" + if $args->{lazy_build} && exists $args->{default}; + confess "You cannot have lazy attribute ($name) without specifying a default value for it" - if $args{lazy} && !exists($args{default}) && !exists($args{builder}); + 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'; + 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}); + 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'; + if $args->{auto_deref} + && $args->{isa} ne 'ArrayRef' + && $args->{isa} ne 'HashRef'; + + if ($args->{trigger}) { + if (ref($args->{trigger}) eq 'CODE') { + $args->{trigger} = { + after => $args->{trigger}, + }; + } + + confess "Trigger must be a CODE or HASH ref on attribute ($name)" + if $args->{trigger} + && ref($args->{trigger}) ne 'HASH'; + } return 1; } @@ -369,6 +414,8 @@ installed. Some error checking is done. =head2 has_builder -> Bool +=head2 is_lazy_build => Bool + =head2 should_auto_deref -> Bool Informational methods. @@ -399,5 +446,25 @@ this attribute's type constraint; Checks that the given value passes this attribute's type constraint. Returns 1 on success, otherwise Ces. +=head2 canonicalize_args Name, %args -> %args + +Canonicalizes some arguments to create. In particular, C is +canonicalized into C, C, etc. + +=head2 validate_args Name, \%args -> 1 | ERROR + +Checks that the arguments to create the attribute (ie those specified by +C) are valid. + +=head2 clone_parent OwnerClass, AttributeName, %args -> Mouse::Meta::Attribute + +Creates a new attribute in OwnerClass, inheriting options from parent classes. +Accessors and helper methods are installed. Some error checking is done. + +=head2 get_parent_args OwnerClass, AttributeName -> Hash + +Returns the options that the parent class of C used for attribute +C. + =cut