We don't need to do both eval and Module::Name -> Module/Name.pm munging
[gitmo/Mouse.git] / lib / Mouse / Object.pm
CommitLineData
c3398f5b 1#!/usr/bin/env perl
2package Mouse::Object;
3use strict;
4use warnings;
c3398f5b 5
626cd940 6use Mouse::Util qw/weaken/;
c3398f5b 7use Carp 'confess';
8
9sub new {
10 my $class = shift;
d574882a 11
12 my $args = $class->BUILDARGS(@_);
da4cb913 13
c3398f5b 14 my $instance = bless {}, $class;
15
28d26949 16 for my $attribute ($class->meta->compute_all_applicable_attributes) {
384072a3 17 my $from = $attribute->init_arg;
18 my $key = $attribute->name;
c3398f5b 19 my $default;
20
d574882a 21 if (defined($from) && exists($args->{$from})) {
a08e715f 22 $attribute->verify_type_constraint($args->{$from})
23 if $attribute->has_type_constraint;
491e5923 24
a08e715f 25 $instance->{$key} = $args->{$from};
fe5fe061 26
a08e715f 27 weaken($instance->{$key})
28 if ref($instance->{$key}) && $attribute->is_weak_ref;
491e5923 29
a08e715f 30 if ($attribute->has_trigger) {
31 $attribute->trigger->($instance, $args->{$from}, $attribute);
491e5923 32 }
33 }
34 else {
de9a434a 35 if ($attribute->has_default || $attribute->has_builder) {
2434d21b 36 unless ($attribute->is_lazy) {
fb706f5c 37 my $default = $attribute->default;
de9a434a 38 my $builder = $attribute->builder;
39 my $value = $attribute->has_builder
40 ? $instance->$builder
41 : ref($default) eq 'CODE'
42 ? $default->()
43 : $default;
44
45 $attribute->verify_type_constraint($value)
5aa30ced 46 if $attribute->has_type_constraint;
47
de9a434a 48 $instance->{$key} = $value;
5aa30ced 49
b17094ce 50 weaken($instance->{$key})
3645b316 51 if ref($instance->{$key}) && $attribute->is_weak_ref;
c3398f5b 52 }
53 }
54 else {
2434d21b 55 if ($attribute->is_required) {
398327c3 56 confess "Attribute (".$attribute->name.") is required";
c3398f5b 57 }
58 }
59 }
c3398f5b 60 }
61
d574882a 62 $instance->BUILDALL($args);
c3398f5b 63
64 return $instance;
65}
66
d574882a 67sub BUILDARGS {
68 my $class = shift;
69
70 if (scalar @_ == 1) {
71 if (defined $_[0]) {
72 (ref($_[0]) eq 'HASH')
73 || confess "Single parameters to new() must be a HASH ref";
74 return {%{$_[0]}};
75 } else {
76 return {};
77 }
78 }
79 else {
80 return {@_};
81 }
82}
83
c3398f5b 84sub DESTROY { shift->DEMOLISHALL }
85
86sub BUILDALL {
87 my $self = shift;
88
89 # short circuit
90 return unless $self->can('BUILD');
91
2230a6a3 92 for my $class (reverse $self->meta->linearized_isa) {
cbe29bd9 93 no strict 'refs';
94 no warnings 'once';
c3398f5b 95 my $code = *{ $class . '::BUILD' }{CODE}
96 or next;
97 $code->($self, @_);
98 }
99}
100
101sub DEMOLISHALL {
102 my $self = shift;
103
104 # short circuit
105 return unless $self->can('DEMOLISH');
106
107 no strict 'refs';
108
109 for my $class ($self->meta->linearized_isa) {
110 my $code = *{ $class . '::DEMOLISH' }{CODE}
111 or next;
112 $code->($self, @_);
113 }
114}
115
1161;
117
118__END__
119
120=head1 NAME
121
122Mouse::Object - we don't need to steenkin' constructor
123
124=head1 METHODS
125
126=head2 new arguments -> object
127
128Instantiates a new Mouse::Object. This is obviously intended for subclasses.
129
130=head2 BUILDALL \%args
131
132Calls L</BUILD> on each class in the class hierarchy. This is called at the
133end of L</new>.
134
135=head2 BUILD \%args
136
137You may put any business logic initialization in BUILD methods. You don't
138need to redispatch or return any specific value.
139
442125dc 140=head2 BUILDARGS
141
142Lets you override the arguments that C<new> takes. Return a hashref of
143parameters.
144
c3398f5b 145=head2 DEMOLISHALL
146
147Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
148L</DESTROY> time.
149
150=head2 DEMOLISH
151
152You may put any business logic deinitialization in DEMOLISH methods. You don't
153need to redispatch or return any specific value.
154
155=cut
156