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 | |
c12edd9a |
8 | my @attrs = $meta->compute_all_applicable_attributes; # this one is using by evaled code |
fc1d8369 |
9 | my $buildall = $class->_generate_BUILDALL($meta); |
10 | my $buildargs = $class->_generate_BUILDARGS(); |
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 | |
24 | warn $code if $ENV{DEBUG}; |
25 | |
26 | local $@; |
27 | my $res = eval $code; |
28 | die $@ if $@; |
29 | $res; |
fc1d8369 |
30 | } |
31 | |
32 | sub _generate_processattrs { |
c12edd9a |
33 | my ($class, $meta, $attrs) = @_; |
fc1d8369 |
34 | my @res; |
c12edd9a |
35 | for my $index (0..scalar(@$attrs)-1) { |
36 | my $attr = $attrs->[$index]; |
fc1d8369 |
37 | my $from = $attr->init_arg; |
38 | my $key = $attr->name; |
c91862e8 |
39 | |
f262f14e |
40 | my $set_value = do { |
fc1d8369 |
41 | my @code; |
c91862e8 |
42 | |
b3b74cc6 |
43 | if ($attr->should_coerce && $attr->type_constraint) { |
44 | push @code, "my \$value = Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});"; |
7bf66a9b |
45 | } |
46 | else { |
47 | push @code, "my \$value = \$args->{'$from'};"; |
fc1d8369 |
48 | } |
c91862e8 |
49 | |
fc1d8369 |
50 | if ($attr->has_type_constraint) { |
b3b74cc6 |
51 | push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; |
52 | push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; |
fc1d8369 |
53 | } |
c91862e8 |
54 | |
55 | push @code, "\$instance->{'$key'} = \$value;"; |
56 | |
41cdacce |
57 | if ($attr->is_weak_ref) { |
c91862e8 |
58 | push @code, "weaken( \$instance->{'$key'} ) if ref( \$value );"; |
41cdacce |
59 | } |
c91862e8 |
60 | |
fc1d8369 |
61 | if ( $attr->has_trigger ) { |
b3b74cc6 |
62 | push @code, "\$attrs[$index]->{trigger}->( \$instance, \$value, \$attrs[$index] );"; |
fc1d8369 |
63 | } |
c91862e8 |
64 | |
fc1d8369 |
65 | join "\n", @code; |
66 | }; |
c91862e8 |
67 | |
f262f14e |
68 | my $make_default_value = do { |
fc1d8369 |
69 | my @code; |
e8ba7b26 |
70 | |
fc1d8369 |
71 | if ( $attr->has_default || $attr->has_builder ) { |
72 | unless ( $attr->is_lazy ) { |
73 | my $default = $attr->default; |
74 | my $builder = $attr->builder; |
e8ba7b26 |
75 | |
76 | push @code, "my \$value = "; |
77 | |
b3b74cc6 |
78 | if ($attr->should_coerce && $attr->type_constraint) { |
79 | push @code, "Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, "; |
fc1d8369 |
80 | } |
e8ba7b26 |
81 | if ($attr->has_builder) { |
82 | push @code, "\$instance->$builder"; |
83 | } |
84 | elsif (ref($default) eq 'CODE') { |
b3b74cc6 |
85 | push @code, "\$attrs[$index]->{default}->(\$instance)"; |
e8ba7b26 |
86 | } |
713a2a05 |
87 | elsif (!defined($default)) { |
88 | push @code, 'undef'; |
89 | } |
90 | elsif ($default =~ /^\-?[0-9]+(?:\.[0-9]+)$/) { |
91 | push @code, $default; |
92 | } |
e8ba7b26 |
93 | else { |
713a2a05 |
94 | push @code, "'$default'"; |
e8ba7b26 |
95 | } |
96 | |
fc1d8369 |
97 | if ($attr->should_coerce) { |
e8ba7b26 |
98 | push @code, ");"; |
99 | } |
100 | else { |
101 | push @code, ";"; |
fc1d8369 |
102 | } |
e8ba7b26 |
103 | |
fc1d8369 |
104 | if ($attr->has_type_constraint) { |
b3b74cc6 |
105 | push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; |
106 | push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; |
fc1d8369 |
107 | } |
e8ba7b26 |
108 | |
8dcbf65d |
109 | push @code, "\$instance->{'$key'} = \$value;"; |
e8ba7b26 |
110 | |
fc1d8369 |
111 | if ($attr->is_weak_ref) { |
e8ba7b26 |
112 | push @code, "weaken( \$instance->{'$key'} ) if ref( \$value );"; |
fc1d8369 |
113 | } |
114 | } |
115 | join "\n", @code; |
116 | } |
117 | else { |
118 | if ( $attr->is_required ) { |
95e0838c |
119 | qq{Carp::confess("Attribute ($key) is required");}; |
fc1d8369 |
120 | } else { |
121 | "" |
122 | } |
123 | } |
124 | }; |
125 | my $code = <<"..."; |
126 | { |
95e0838c |
127 | if (exists(\$args->{'$from'})) { |
f262f14e |
128 | $set_value; |
713a2a05 |
129 | ... |
130 | if ($make_default_value) { |
131 | $code .= <<"..."; |
fc1d8369 |
132 | } else { |
f262f14e |
133 | $make_default_value; |
713a2a05 |
134 | ... |
135 | } |
136 | $code .= <<"..."; |
fc1d8369 |
137 | } |
138 | } |
139 | ... |
140 | push @res, $code; |
141 | } |
142 | return join "\n", @res; |
143 | } |
144 | |
145 | sub _generate_BUILDARGS { |
146 | <<'...'; |
147 | do { |
148 | if ( scalar @_ == 1 ) { |
149 | if ( defined $_[0] ) { |
150 | ( ref( $_[0] ) eq 'HASH' ) |
151 | || Carp::confess "Single parameters to new() must be a HASH ref"; |
152 | +{ %{ $_[0] } }; |
153 | } |
154 | else { |
155 | +{}; |
156 | } |
157 | } |
158 | else { |
159 | +{@_}; |
160 | } |
161 | }; |
162 | ... |
163 | } |
164 | |
165 | sub _generate_BUILDALL { |
166 | my ($class, $meta) = @_; |
167 | return '' unless $meta->name->can('BUILD'); |
168 | |
169 | my @code = (); |
170 | push @code, q{no strict 'refs';}; |
171 | push @code, q{no warnings 'once';}; |
172 | no strict 'refs'; |
ca3bebbd |
173 | for my $klass ($meta->linearized_isa) { |
174 | if (*{ $klass . '::BUILD' }{CODE}) { |
63d74d7a |
175 | push @code, qq{${klass}::BUILD(\$instance, \$args);}; |
fc1d8369 |
176 | } |
177 | } |
178 | return join "\n", @code; |
179 | } |
180 | |
181 | 1; |