package Mouse::Object;
use strict;
use warnings;
-use MRO::Compat;
-use Scalar::Util 'blessed';
+use Scalar::Util qw/weaken/;
use Carp 'confess';
sub new {
my $class = shift;
- my %args = @_;
+
+ my $args = $class->BUILDARGS(@_);
+
my $instance = bless {}, $class;
- for my $attribute ($class->meta->attributes) {
- my $key = $attribute->init_arg;
- my $default;
+ for my $attribute ($class->meta->compute_all_applicable_attributes) {
+ my $from = $attribute->init_arg;
+ my $key = $attribute->name;
- if (!exists($args{$key})) {
- if ($attribute->has_default || $attribute->has_builder) {
- my $default = $attribute->default;
+ if (defined($from) && exists($args->{$from})) {
+ $args->{$from} = $attribute->coerce_constraint($args->{$from})
+ if $attribute->should_coerce;
+ $attribute->verify_type_constraint($args->{$from})
+ if $attribute->has_type_constraint;
- unless ($attribute->lazy) {
+ $instance->{$key} = $args->{$from};
+
+ weaken($instance->{$key})
+ if ref($instance->{$key}) && $attribute->is_weak_ref;
+
+ if ($attribute->has_trigger) {
+ $attribute->trigger->($instance, $args->{$from}, $attribute);
+ }
+ }
+ else {
+ if ($attribute->has_default || $attribute->has_builder) {
+ unless ($attribute->is_lazy) {
+ my $default = $attribute->default;
my $builder = $attribute->builder;
my $value = $attribute->has_builder
? $instance->$builder
: ref($default) eq 'CODE'
- ? $default->()
+ ? $default->($instance)
: $default;
+ $value = $attribute->coerce_constraint($value)
+ if $attribute->should_coerce;
$attribute->verify_type_constraint($value)
if $attribute->has_type_constraint;
$instance->{$key} = $value;
- Scalar::Util::weaken($instance->{$key})
- if $attribute->weak_ref;
+ weaken($instance->{$key})
+ if ref($instance->{$key}) && $attribute->is_weak_ref;
}
}
else {
- if ($attribute->required) {
- confess "Attribute '".$attribute->name."' is required";
+ if ($attribute->is_required) {
+ confess "Attribute (".$attribute->name.") is required";
}
}
}
+ }
- if (exists($args{$key})) {
- $attribute->verify_type_constraint($args{$key})
- if $attribute->has_type_constraint;
+ $instance->BUILDALL($args);
- $instance->{$key} = $args{$key};
+ return $instance;
+}
- Scalar::Util::weaken($instance->{$key})
- if $attribute->weak_ref;
+sub BUILDARGS {
+ my $class = shift;
- if ($attribute->has_trigger) {
- $attribute->trigger->($instance, $args{$key}, $attribute);
- }
+ if (scalar @_ == 1) {
+ if (defined $_[0]) {
+ (ref($_[0]) eq 'HASH')
+ || confess "Single parameters to new() must be a HASH ref";
+ return {%{$_[0]}};
+ } else {
+ return {};
}
}
-
- $instance->BUILDALL(\%args);
-
- return $instance;
+ else {
+ return {@_};
+ }
}
sub DESTROY { shift->DEMOLISHALL }
# short circuit
return unless $self->can('BUILD');
- no strict 'refs';
-
- for my $class ($self->meta->linearized_isa) {
+ for my $class (reverse $self->meta->linearized_isa) {
+ no strict 'refs';
+ no warnings 'once';
my $code = *{ $class . '::BUILD' }{CODE}
or next;
$code->($self, @_);
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<new> takes. Return a hashref of
+parameters.
+
=head2 DEMOLISHALL
Calls L</DEMOLISH> on each class in the class hierarchy. This is called at