Refactor pp method generators
[gitmo/Mouse.git] / lib / Mouse / Meta / Method / Constructor.pm
CommitLineData
fc1d8369 1package Mouse::Meta::Method::Constructor;
3821b191 2use Mouse::Util qw(:meta); # enables strict and warnings
fc1d8369 3
3db78d2a 4sub _inline_create_instance {
5 my(undef, $class_expr) = @_;
6 return "bless {}, $class_expr";
7}
8
9sub _inline_slot {
f8cbb121 10 my(undef, $self_var, $attr_name) = @_;
11 return sprintf '%s->{q{%s}}', $self_var, $attr_name;
12}
13
3db78d2a 14sub _inline_has_slot {
15 my($class, $self_var, $attr_name) = @_;
16
17 return sprintf 'exists(%s)', $class->_inline_slot($self_var, $attr_name);
18}
19
20sub _inline_get_slot {
21 my($class, $self_var, $attr_name) = @_;
22
23 return $class->_inline_slot($self_var, $attr_name);
24}
25
26sub _inline_set_slot {
27 my($class, $self_var, $attr_name, $rvalue) = @_;
28
29 return $class->_inline_slot($self_var, $attr_name) . " = $rvalue";
30}
31
32sub _inline_weaken_slot {
33 my($class, $self_var, $attr_name) = @_;
34
35 return sprintf 'Scalar::Util::weaken(%s)', $class->_inline_slot($self_var, $attr_name);
36}
37
380e1cd7 38sub _generate_constructor {
2a464664 39 my ($class, $metaclass, $args) = @_;
24ad3f66 40
7ca5c5fb 41 my @attrs = $metaclass->get_all_attributes;
42
3db78d2a 43 my $init_attrs = $class->_generate_processattrs($metaclass, \@attrs);
7ca5c5fb 44 my $buildargs = $class->_generate_BUILDARGS($metaclass);
3db78d2a 45 my $buildall = $class->_generate_BUILDALL($metaclass);
7ca5c5fb 46
0bfc7290 47 my @checks = map { $_ && $_->_compiled_type_constraint }
48 map { $_->type_constraint } @attrs;
ad087d11 49
3db78d2a 50 my $class_name = $metaclass->name;
51 my $source = sprintf(<<'END_CONSTRUCTOR', $class_name, __LINE__, __FILE__, $class_name, $buildargs, $class->_inline_create_instance('$class'), $init_attrs, $buildall);
52package %s;
53#line %d "constructor of %s (%s)"
54 sub {
55 my $class = shift;
56 return $class->Mouse::Object::new(@_)
57 if $class ne __PACKAGE__;
0bfc7290 58 # BUILDARGS
3db78d2a 59 %s;
60 # create instance
61 my $instance = %s;
0bfc7290 62 # process attributes
3db78d2a 63 %s;
0bfc7290 64 # BUILDALL
3db78d2a 65 %s;
66 return $instance;
2a464664 67 }
3db78d2a 68END_CONSTRUCTOR
0bfc7290 69 #warn $source;
ad087d11 70 my $code;
71 my $e = do{
72 local $@;
73 $code = eval $source;
74 $@;
75 };
76 die $e if $e;
380e1cd7 77 return $code;
fc1d8369 78}
79
80sub _generate_processattrs {
f8cbb121 81 my ($method_class, $metaclass, $attrs) = @_;
fc1d8369 82 my @res;
9df6f0cd 83
2efc0af1 84 my $has_triggers;
8801a6e6 85 my $strict = $metaclass->__strict_constructor;
e128626c 86
8801a6e6 87 if($strict){
e128626c 88 push @res, 'my $used = 0;';
89 }
2efc0af1 90
9df6f0cd 91 for my $index (0 .. @$attrs - 1) {
0bfc7290 92 my $code = '';
93
c12edd9a 94 my $attr = $attrs->[$index];
fc1d8369 95 my $key = $attr->name;
9df6f0cd 96
0bfc7290 97 my $init_arg = $attr->init_arg;
98 my $type_constraint = $attr->type_constraint;
8aba926d 99 my $is_weak_ref = $attr->is_weak_ref;
0bfc7290 100 my $need_coercion;
c91862e8 101
3db78d2a 102 my $instance = '$instance';
103 my $instance_slot = $method_class->_inline_get_slot($instance, $key);
0bfc7290 104 my $attr_var = "\$attrs[$index]";
105 my $constraint_var;
c91862e8 106
0bfc7290 107 if(defined $type_constraint){
108 $constraint_var = "$attr_var\->{type_constraint}";
109 $need_coercion = ($attr->should_coerce && $type_constraint->has_coercion);
110 }
c91862e8 111
0bfc7290 112 $code .= "# initialize $key\n";
113
114 my $post_process = '';
115 if(defined $type_constraint){
116 $post_process .= "\$checks[$index]->($instance_slot)";
da23cd4a 117 $post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n";
0bfc7290 118 }
8aba926d 119 if($is_weak_ref){
3db78d2a 120 $post_process .= $method_class->_inline_weaken_slot($instance, $key) . " if ref $instance_slot;\n";
0bfc7290 121 }
c91862e8 122
0bfc7290 123 if (defined $init_arg) {
124 my $value = "\$args->{q{$init_arg}}";
c91862e8 125
0bfc7290 126 $code .= "if (exists $value) {\n";
127
128 if($need_coercion){
620c3203 129 $value = "$constraint_var->coerce($value)";
41cdacce 130 }
c91862e8 131
3db78d2a 132 $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n";
0bfc7290 133 $code .= $post_process;
134
9df6f0cd 135 if ($attr->has_trigger) {
2efc0af1 136 $has_triggers++;
620c3203 137 $code .= "push \@triggers, [$attr_var\->{trigger}, $instance_slot];\n";
fc1d8369 138 }
c91862e8 139
8801a6e6 140 if ($strict){
141 $code .= '++$used;' . "\n";
e128626c 142 }
143
144 $code .= "\n} else {\n"; # $value exists
9df6f0cd 145 }
c91862e8 146
9df6f0cd 147 if ($attr->has_default || $attr->has_builder) {
148 unless ($attr->is_lazy) {
149 my $default = $attr->default;
150 my $builder = $attr->builder;
e8ba7b26 151
0bfc7290 152 my $value;
153 if (defined($builder)) {
154 $value = "\$instance->$builder()";
ffbbf459 155 }
156 elsif (ref($default) eq 'CODE') {
0bfc7290 157 $value = "$attr_var\->{default}->(\$instance)";
ffbbf459 158 }
0bfc7290 159 elsif (defined($default)) {
160 $value = "$attr_var\->{default}";
ffbbf459 161 }
162 else {
0bfc7290 163 $value = 'undef';
ffbbf459 164 }
e8ba7b26 165
0bfc7290 166 if($need_coercion){
167 $value = "$constraint_var->coerce($value)";
9df6f0cd 168 }
9df6f0cd 169
3db78d2a 170 $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n";
8aba926d 171 if($is_weak_ref){
3db78d2a 172 $code .= $method_class->_inline_weaken_slot($instance, $key) . ";\n";
8aba926d 173 }
fc1d8369 174 }
713a2a05 175 }
9df6f0cd 176 elsif ($attr->is_required) {
7756897f 177 $code .= "Carp::confess('Attribute ($key) is required');";
9df6f0cd 178 }
179
0bfc7290 180 $code .= "}\n" if defined $init_arg;
9df6f0cd 181
fc1d8369 182 push @res, $code;
183 }
9df6f0cd 184
8801a6e6 185 if($strict){
e128626c 186 push @res, q{if($used < keys %{$args})}
8801a6e6 187 . sprintf q{{ %s->_report_unknown_args($metaclass, \@attrs, $args) }}, $method_class;
e128626c 188 }
189
2efc0af1 190 if($metaclass->is_anon_class){
a8391b11 191 push @res, q{$instance->{__METACLASS__} = $metaclass;};
2efc0af1 192 }
193
194 if($has_triggers){
195 unshift @res, q{my @triggers;};
e128626c 196 push @res, q{$_->[0]->($instance, $_->[1]) for @triggers;};
2efc0af1 197 }
198
199 return join "\n", @res;
fc1d8369 200}
201
202sub _generate_BUILDARGS {
0bfc7290 203 my(undef, $metaclass) = @_;
9dcd7d23 204
0bfc7290 205 my $class = $metaclass->name;
206 if ( $class->can('BUILDARGS') && $class->can('BUILDARGS') != \&Mouse::Object::BUILDARGS ) {
53d4053e 207 return 'my $args = $class->BUILDARGS(@_)';
9dcd7d23 208 }
209
210 return <<'...';
53d4053e 211 my $args;
fc1d8369 212 if ( scalar @_ == 1 ) {
c9aefe26 213 ( ref( $_[0] ) eq 'HASH' )
fc1d8369 214 || Carp::confess "Single parameters to new() must be a HASH ref";
53d4053e 215 $args = +{ %{ $_[0] } };
fc1d8369 216 }
217 else {
53d4053e 218 $args = +{@_};
fc1d8369 219 }
fc1d8369 220...
221}
222
223sub _generate_BUILDALL {
0bfc7290 224 my (undef, $metaclass) = @_;
7ca5c5fb 225
2efc0af1 226 return '' unless $metaclass->name->can('BUILD');
fc1d8369 227
7ca5c5fb 228 my @code;
229 for my $class ($metaclass->linearized_isa) {
a5c683f6 230 if (Mouse::Util::get_code_ref($class, 'BUILD')) {
7ca5c5fb 231 unshift @code, qq{${class}::BUILD(\$instance, \$args);};
fc1d8369 232 }
233 }
234 return join "\n", @code;
235}
236
e128626c 237sub _report_unknown_args {
8801a6e6 238 my(undef, $metaclass, $attrs, $args) = @_;
e128626c 239
240 my @unknowns;
241 my %init_args;
242 foreach my $attr(@{$attrs}){
243 my $init_arg = $attr->init_arg;
244 if(defined $init_arg){
245 $init_args{$init_arg}++;
246 }
247 }
248
249 while(my $key = each %{$args}){
250 if(!exists $init_args{$key}){
251 push @unknowns, $key;
252 }
253 }
254
255 $metaclass->throw_error( sprintf
256 "Unknown attribute passed to the constructor of %s: %s",
8801a6e6 257 $metaclass->name, Mouse::Util::english_list(@unknowns),
e128626c 258 );
259}
260
fc1d8369 2611;
0126c27c 262__END__
a25ca8d6 263
264=head1 NAME
265
266Mouse::Meta::Method::Constructor - A Mouse method generator for constructors
267
268=head1 VERSION
269
c2168931 270This document describes Mouse version 0.50_04
a25ca8d6 271
272=head1 SEE ALSO
273
274L<Moose::Meta::Method::Constructor>
275
276=cut