7 use Scalar::Util qw/blessed weaken/;
13 my $args = $class->BUILDARGS(@_);
15 my $instance = bless {}, $class;
17 for my $attribute ($class->meta->compute_all_applicable_attributes) {
18 my $from = $attribute->init_arg;
19 my $key = $attribute->name;
22 if (defined($from) && exists($args->{$from})) {
23 if ($attribute->has_trigger && $attribute->trigger->{before}) {
24 $attribute->trigger->{before}->($instance, $args->{$from}, $attribute);
27 if ($attribute->has_trigger && $attribute->trigger->{around}) {
28 $attribute->trigger->{around}->(sub {
29 $args->{$from} = $_[1];
31 $attribute->verify_type_constraint($args->{$from})
32 if $attribute->has_type_constraint;
34 $instance->{$key} = $args->{$from};
36 weaken($instance->{$key})
37 if ref($instance->{$key}) && $attribute->is_weak_ref;
38 }, $instance, $args->{$from}, $attribute);
41 $attribute->verify_type_constraint($args->{$from})
42 if $attribute->has_type_constraint;
44 $instance->{$key} = $args->{$from};
46 weaken($instance->{$key})
47 if ref($instance->{$key}) && $attribute->is_weak_ref;
50 if ($attribute->has_trigger && $attribute->trigger->{after}) {
51 $attribute->trigger->{after}->($instance, $args->{$from}, $attribute);
55 if ($attribute->has_default || $attribute->has_builder) {
56 unless ($attribute->is_lazy) {
57 my $default = $attribute->default;
58 my $builder = $attribute->builder;
59 my $value = $attribute->has_builder
61 : ref($default) eq 'CODE'
65 $attribute->verify_type_constraint($value)
66 if $attribute->has_type_constraint;
68 $instance->{$key} = $value;
70 weaken($instance->{$key})
71 if ref($instance->{$key}) && $attribute->is_weak_ref;
75 if ($attribute->is_required) {
76 confess "Attribute (".$attribute->name.") is required";
82 $instance->BUILDALL($args);
92 (ref($_[0]) eq 'HASH')
93 || confess "Single parameters to new() must be a HASH ref";
104 sub DESTROY { shift->DEMOLISHALL }
110 return unless $self->can('BUILD');
112 for my $class (reverse $self->meta->linearized_isa) {
115 my $code = *{ $class . '::BUILD' }{CODE}
125 return unless $self->can('DEMOLISH');
129 for my $class ($self->meta->linearized_isa) {
130 my $code = *{ $class . '::DEMOLISH' }{CODE}
142 Mouse::Object - we don't need to steenkin' constructor
146 =head2 new arguments -> object
148 Instantiates a new Mouse::Object. This is obviously intended for subclasses.
150 =head2 BUILDALL \%args
152 Calls L</BUILD> on each class in the class hierarchy. This is called at the
157 You may put any business logic initialization in BUILD methods. You don't
158 need to redispatch or return any specific value.
162 Lets you override the arguments that C<new> takes. Return a hashref of
167 Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
172 You may put any business logic deinitialization in DEMOLISH methods. You don't
173 need to redispatch or return any specific value.