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=af9e737602b1377a6048b6c5003d361bf42da1e3;hpb=f7b11a21869769d2b49bba4fa72d33fa54ad0c2e;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index af9e737..4bdb9f8 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -17,23 +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 !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}); - } - } - bless \%args, $class; } @@ -73,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;'; @@ -85,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);'; } - $accessor .= '$self->{$key} = $_;'; + if ($around) { + $accessor .= '$around->(sub { + my $self = shift; + $_ = $_[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->(); + };' + } + + $accessor .= '$self->{$key} = $_;'; - if ($attribute->is_weak_ref) { - $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($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 .= '}'; @@ -184,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}; @@ -224,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; } @@ -403,6 +446,16 @@ 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.