Commit | Line | Data |
fc1d8369 |
1 | package Mouse::Meta::Method::Constructor; |
2 | use strict; |
3 | use warnings; |
4 | |
5 | sub generate_constructor_method_inline { |
41cdacce |
6 | my ($class, $meta) = @_; |
24ad3f66 |
7 | |
a4d5249c |
8 | my @attrs = $meta->compute_all_applicable_attributes; |
fc1d8369 |
9 | my $buildall = $class->_generate_BUILDALL($meta); |
9dcd7d23 |
10 | my $buildargs = $class->_generate_BUILDARGS($meta); |
c12edd9a |
11 | my $processattrs = $class->_generate_processattrs($meta, \@attrs); |
fc1d8369 |
12 | |
24ad3f66 |
13 | my $code = <<"..."; |
fc1d8369 |
14 | sub { |
15 | my \$class = shift; |
16 | my \$args = $buildargs; |
24ad3f66 |
17 | my \$instance = bless {}, \$class; |
fc1d8369 |
18 | $processattrs; |
19 | $buildall; |
20 | return \$instance; |
21 | } |
22 | ... |
24ad3f66 |
23 | |
24ad3f66 |
24 | local $@; |
25 | my $res = eval $code; |
26 | die $@ if $@; |
27 | $res; |
fc1d8369 |
28 | } |
29 | |
30 | sub _generate_processattrs { |
c12edd9a |
31 | my ($class, $meta, $attrs) = @_; |
fc1d8369 |
32 | my @res; |
9df6f0cd |
33 | |
34 | for my $index (0 .. @$attrs - 1) { |
c12edd9a |
35 | my $attr = $attrs->[$index]; |
fc1d8369 |
36 | my $key = $attr->name; |
9df6f0cd |
37 | my $code = ''; |
38 | |
39 | if (defined $attr->init_arg) { |
40 | my $from = $attr->init_arg; |
c91862e8 |
41 | |
9df6f0cd |
42 | $code .= "if (exists \$args->{'$from'}) {\n"; |
c91862e8 |
43 | |
b3b74cc6 |
44 | if ($attr->should_coerce && $attr->type_constraint) { |
684db121 |
45 | $code .= "my \$value = Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});\n"; |
7bf66a9b |
46 | } |
47 | else { |
7756897f |
48 | $code .= "my \$value = \$args->{'$from'};\n"; |
fc1d8369 |
49 | } |
c91862e8 |
50 | |
fc1d8369 |
51 | if ($attr->has_type_constraint) { |
7756897f |
52 | $code .= "{ |
684db121 |
53 | unless (\$attrs[$index]->{type_constraint}->check(\$value)) { |
7756897f |
54 | \$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint) |
55 | } |
56 | }"; |
fc1d8369 |
57 | } |
c91862e8 |
58 | |
7756897f |
59 | $code .= "\$instance->{'$key'} = \$value;\n"; |
c91862e8 |
60 | |
41cdacce |
61 | if ($attr->is_weak_ref) { |
7756897f |
62 | $code .= "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );\n"; |
41cdacce |
63 | } |
c91862e8 |
64 | |
9df6f0cd |
65 | if ($attr->has_trigger) { |
88b6c018 |
66 | $code .= "\$attrs[$index]->{trigger}->( \$instance, \$value );\n"; |
fc1d8369 |
67 | } |
c91862e8 |
68 | |
7756897f |
69 | $code .= "\n} else {\n"; |
9df6f0cd |
70 | } |
c91862e8 |
71 | |
9df6f0cd |
72 | if ($attr->has_default || $attr->has_builder) { |
73 | unless ($attr->is_lazy) { |
74 | my $default = $attr->default; |
75 | my $builder = $attr->builder; |
e8ba7b26 |
76 | |
9df6f0cd |
77 | $code .= "my \$value = "; |
e8ba7b26 |
78 | |
9df6f0cd |
79 | if ($attr->should_coerce && $attr->type_constraint) { |
684db121 |
80 | $code .= "Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$attrs[$index]->{type_constraint}, "; |
9df6f0cd |
81 | } |
e8ba7b26 |
82 | |
9df6f0cd |
83 | if ($attr->has_builder) { |
84 | $code .= "\$instance->$builder"; |
fc1d8369 |
85 | } |
9df6f0cd |
86 | elsif (ref($default) eq 'CODE') { |
87 | $code .= "\$attrs[$index]->{default}->(\$instance)"; |
e8ba7b26 |
88 | } |
9df6f0cd |
89 | elsif (!defined($default)) { |
90 | $code .= 'undef'; |
fc1d8369 |
91 | } |
9df6f0cd |
92 | elsif ($default =~ /^\-?[0-9]+(?:\.[0-9]+)$/) { |
93 | $code .= $default; |
94 | } |
95 | else { |
96 | $code .= "'$default'"; |
fc1d8369 |
97 | } |
e8ba7b26 |
98 | |
9df6f0cd |
99 | if ($attr->should_coerce) { |
7756897f |
100 | $code .= ");\n"; |
9df6f0cd |
101 | } |
102 | else { |
7756897f |
103 | $code .= ";\n"; |
9df6f0cd |
104 | } |
e8ba7b26 |
105 | |
9df6f0cd |
106 | if ($attr->has_type_constraint) { |
7756897f |
107 | $code .= "{ |
684db121 |
108 | unless (\$attrs[$index]->{type_constraint}->check(\$value)) { |
7756897f |
109 | \$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint) |
110 | } |
111 | }"; |
fc1d8369 |
112 | } |
9df6f0cd |
113 | |
7756897f |
114 | $code .= "\$instance->{'$key'} = \$value;\n"; |
9df6f0cd |
115 | |
116 | if ($attr->is_weak_ref) { |
7756897f |
117 | $code .= "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );\n"; |
fc1d8369 |
118 | } |
119 | } |
713a2a05 |
120 | } |
9df6f0cd |
121 | elsif ($attr->is_required) { |
7756897f |
122 | $code .= "Carp::confess('Attribute ($key) is required');"; |
9df6f0cd |
123 | } |
124 | |
7756897f |
125 | $code .= "}\n" if defined $attr->init_arg; |
9df6f0cd |
126 | |
fc1d8369 |
127 | push @res, $code; |
128 | } |
9df6f0cd |
129 | |
fc1d8369 |
130 | return join "\n", @res; |
131 | } |
132 | |
133 | sub _generate_BUILDARGS { |
9dcd7d23 |
134 | my $self = shift; |
135 | my $meta = shift; |
136 | |
58600853 |
137 | if ($meta->name->can('BUILDARGS') && $meta->name->can('BUILDARGS') != Mouse::Object->can('BUILDARGS')) { |
9dcd7d23 |
138 | return '$class->BUILDARGS(@_)'; |
139 | } |
140 | |
141 | return <<'...'; |
fc1d8369 |
142 | do { |
143 | if ( scalar @_ == 1 ) { |
c9aefe26 |
144 | ( ref( $_[0] ) eq 'HASH' ) |
fc1d8369 |
145 | || Carp::confess "Single parameters to new() must be a HASH ref"; |
c9aefe26 |
146 | +{ %{ $_[0] } }; |
fc1d8369 |
147 | } |
148 | else { |
149 | +{@_}; |
150 | } |
151 | }; |
152 | ... |
153 | } |
154 | |
155 | sub _generate_BUILDALL { |
156 | my ($class, $meta) = @_; |
157 | return '' unless $meta->name->can('BUILD'); |
158 | |
159 | my @code = (); |
160 | push @code, q{no strict 'refs';}; |
161 | push @code, q{no warnings 'once';}; |
162 | no strict 'refs'; |
f2becec7 |
163 | no warnings 'once'; |
ca3bebbd |
164 | for my $klass ($meta->linearized_isa) { |
165 | if (*{ $klass . '::BUILD' }{CODE}) { |
63d74d7a |
166 | push @code, qq{${klass}::BUILD(\$instance, \$args);}; |
fc1d8369 |
167 | } |
168 | } |
169 | return join "\n", @code; |
170 | } |
171 | |
172 | 1; |