X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FObject.pm;h=1511d2836f75650c749b790699b57460919c5823;hb=84e9b28560b15545a21b389885b0c9514fa93165;hp=f615ac9839340c03e39a461b50baaf83e85accb8;hpb=d574882a10a05f5e8c515a87358460f7ae0ed247;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index f615ac9..1511d28 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -2,8 +2,8 @@ package Mouse::Object; use strict; use warnings; -use MRO::Compat; +use MRO::Compat; use Scalar::Util qw/blessed weaken/; use Carp 'confess'; @@ -20,16 +20,35 @@ sub new { my $default; if (defined($from) && exists($args->{$from})) { - $attribute->verify_type_constraint($args->{$from}) - if $attribute->has_type_constraint; + if ($attribute->has_trigger && $attribute->trigger->{before}) { + $attribute->trigger->{before}->($instance, $args->{$from}, $attribute); + } - $instance->{$key} = $args->{$from}; + if ($attribute->has_trigger && $attribute->trigger->{around}) { + $attribute->trigger->{around}->(sub { + $args->{$from} = $_[1]; + + $attribute->verify_type_constraint($args->{$from}) + if $attribute->has_type_constraint; - weaken($instance->{$key}) - if ref($instance->{$key}) && $attribute->is_weak_ref; + $instance->{$key} = $args->{$from}; - if ($attribute->has_trigger) { - $attribute->trigger->($instance, $args->{$from}, $attribute); + weaken($instance->{$key}) + if ref($instance->{$key}) && $attribute->is_weak_ref; + }, $instance, $args->{$from}, $attribute); + } + else { + $attribute->verify_type_constraint($args->{$from}) + if $attribute->has_type_constraint; + + $instance->{$key} = $args->{$from}; + + weaken($instance->{$key}) + if ref($instance->{$key}) && $attribute->is_weak_ref; + } + + if ($attribute->has_trigger && $attribute->trigger->{after}) { + $attribute->trigger->{after}->($instance, $args->{$from}, $attribute); } } else { @@ -90,9 +109,9 @@ sub BUILDALL { # short circuit return unless $self->can('BUILD'); - no strict 'refs'; - for my $class (reverse $self->meta->linearized_isa) { + no strict 'refs'; + no warnings 'once'; my $code = *{ $class . '::BUILD' }{CODE} or next; $code->($self, @_); @@ -138,6 +157,11 @@ end of L. You may put any business logic initialization in BUILD methods. You don't need to redispatch or return any specific value. +=head2 BUILDARGS + +Lets you override the arguments that C takes. Return a hashref of +parameters. + =head2 DEMOLISHALL Calls L on each class in the class hierarchy. This is called at