X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FObject.pm;h=d729261699bd632ac19fa2850f4822ec307f0866;hb=df963a63491f0c26a26592d51534d5d440bc6f26;hp=f813fd523035fceb3b845b6d0502f05bd35009f5;hpb=fe5fe0612f027da06fda45ecf27d031e345895c8;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index f813fd5..d729261 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -1,10 +1,8 @@ -#!/usr/bin/env perl package Mouse::Object; use strict; use warnings; -use MRO::Compat; -use Scalar::Util qw/blessed weaken/; +use Scalar::Util 'weaken'; use Carp 'confess'; sub new { @@ -17,38 +15,19 @@ sub new { for my $attribute ($class->meta->compute_all_applicable_attributes) { my $from = $attribute->init_arg; my $key = $attribute->name; - my $default; if (defined($from) && exists($args->{$from})) { - if ($attribute->has_trigger && $attribute->trigger->{before}) { - $attribute->trigger->{before}->($instance, $args->{$from}, $attribute); - } - - if ($attribute->has_trigger && $attribute->trigger->{around}) { - $attribute->trigger->{around}->(sub { - $args->{$from} = $_[1]; + $args->{$from} = $attribute->coerce_constraint($args->{$from}) + if $attribute->should_coerce; + $attribute->verify_against_type_constraint($args->{$from}); - $attribute->verify_type_constraint($args->{$from}) - if $attribute->has_type_constraint; + $instance->{$key} = $args->{$from}; - $instance->{$key} = $args->{$from}; + weaken($instance->{$key}) + if ref($instance->{$key}) && $attribute->is_weak_ref; - 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); + if ($attribute->has_trigger) { + $attribute->trigger->($instance, $args->{$from}, $attribute); } } else { @@ -59,11 +38,12 @@ sub new { my $value = $attribute->has_builder ? $instance->$builder : ref($default) eq 'CODE' - ? $default->() + ? $default->($instance) : $default; - $attribute->verify_type_constraint($value) - if $attribute->has_type_constraint; + $value = $attribute->coerce_constraint($value) + if $attribute->should_coerce; + $attribute->verify_against_type_constraint($value); $instance->{$key} = $value; @@ -133,6 +113,13 @@ sub DEMOLISHALL { } } +sub dump { + my $self = shift; + require Data::Dumper; + local $Data::Dumper::Maxdepth = shift if @_; + Data::Dumper::Dumper $self; +} + 1; __END__ @@ -172,5 +159,20 @@ L time. You may put any business logic deinitialization in DEMOLISH methods. You don't need to redispatch or return any specific value. + +=head2 B + +From the Moose POD: + + C'mon, how many times have you written the following code while debugging: + + use Data::Dumper; + warn Dumper $obj; + + It can get seriously annoying, so why not just use this. + +The implementation was lifted directly from Moose::Object. + =cut +